-- | Stuff gutted from Translate.Select
module Hasura.Backends.Postgres.Translate.Select.Internal.JoinTree
  ( withWriteJoinTree,
    withWriteObjectRelation,
    withWriteArrayRelation,
    withWriteArrayConnection,
    withWriteComputedFieldTableSet,
  )
where

import Control.Monad.Writer.Strict
import Data.HashMap.Strict qualified as HashMap
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.Translate.Types
import Hasura.Prelude

-- | This is the lowest level function which deals with @MonadWriter SelectWriter@, which contains @JoinTree@ whose
-- purpose is to essentially create the selection tree across relationships.
--
-- Each type of relationship uses a different kind of update function; see
-- 'withWriteObjectRelation', 'withWriteArrayRelation', 'withWriteArrayConnection',
-- and 'withWriteComputedFieldTableSet'.
--
-- See the definition of 'JoinTree' for details before diving further
-- (particularly its components and Monoid instance).
withWriteJoinTree ::
  (MonadWriter SelectWriter m) =>
  (JoinTree -> b -> JoinTree) ->
  m (a, b) ->
  m a
withWriteJoinTree :: forall (m :: * -> *) b a.
MonadWriter SelectWriter m =>
(JoinTree -> b -> JoinTree) -> m (a, b) -> m a
withWriteJoinTree JoinTree -> b -> JoinTree
joinTreeUpdater m (a, b)
action =
  m (a, SelectWriter -> SelectWriter) -> m a
forall a. m (a, SelectWriter -> SelectWriter) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m (a, SelectWriter -> SelectWriter) -> m a)
-> m (a, SelectWriter -> SelectWriter) -> m a
forall a b. (a -> b) -> a -> b
$ do
    (a
out, b
result) <- m (a, b)
action
    let fromSelectWriter :: SelectWriter -> SelectWriter
fromSelectWriter =
          (JoinTree -> JoinTree) -> SelectWriter -> SelectWriter
mapJoinTree (JoinTree -> b -> JoinTree
`joinTreeUpdater` b
result)
    (a, SelectWriter -> SelectWriter)
-> m (a, SelectWriter -> SelectWriter)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
out, SelectWriter -> SelectWriter
fromSelectWriter)

-- | change the `JoinTree` inside a `SelectWriter`
mapJoinTree :: (JoinTree -> JoinTree) -> SelectWriter -> SelectWriter
mapJoinTree :: (JoinTree -> JoinTree) -> SelectWriter -> SelectWriter
mapJoinTree JoinTree -> JoinTree
f SelectWriter
sw = SelectWriter
sw {_swJoinTree :: JoinTree
_swJoinTree = JoinTree -> JoinTree
f (SelectWriter -> JoinTree
_swJoinTree SelectWriter
sw)}

withWriteObjectRelation ::
  (MonadWriter SelectWriter m) =>
  m
    ( ObjectRelationSource,
      InsOrdHashMap S.ColumnAlias S.SQLExp,
      a
    ) ->
  m a
withWriteObjectRelation :: forall (m :: * -> *) a.
MonadWriter SelectWriter m =>
m (ObjectRelationSource, InsOrdHashMap ColumnAlias SQLExp, a)
-> m a
withWriteObjectRelation m (ObjectRelationSource, InsOrdHashMap ColumnAlias SQLExp, a)
action =
  (JoinTree
 -> (ObjectRelationSource, InsOrdHashMap ColumnAlias SQLExp)
 -> JoinTree)
-> m (a, (ObjectRelationSource, InsOrdHashMap ColumnAlias SQLExp))
-> m a
forall (m :: * -> *) b a.
MonadWriter SelectWriter m =>
(JoinTree -> b -> JoinTree) -> m (a, b) -> m a
withWriteJoinTree JoinTree
-> (ObjectRelationSource, InsOrdHashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree (m (a, (ObjectRelationSource, InsOrdHashMap ColumnAlias SQLExp))
 -> m a)
-> m (a, (ObjectRelationSource, InsOrdHashMap ColumnAlias SQLExp))
-> m a
forall a b. (a -> b) -> a -> b
$ do
    (ObjectRelationSource
source, InsOrdHashMap ColumnAlias SQLExp
nodeExtractors, a
out) <- m (ObjectRelationSource, InsOrdHashMap ColumnAlias SQLExp, a)
action
    (a, (ObjectRelationSource, InsOrdHashMap ColumnAlias SQLExp))
-> m (a, (ObjectRelationSource, InsOrdHashMap ColumnAlias SQLExp))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
out, (ObjectRelationSource
source, InsOrdHashMap ColumnAlias SQLExp
nodeExtractors))
  where
    updateJoinTree :: JoinTree
-> (ObjectRelationSource, InsOrdHashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree JoinTree
joinTree (ObjectRelationSource
source, InsOrdHashMap ColumnAlias SQLExp
nodeExtractors) =
      let selectNode :: SelectNode
selectNode = InsOrdHashMap ColumnAlias SQLExp -> JoinTree -> SelectNode
SelectNode InsOrdHashMap ColumnAlias SQLExp
nodeExtractors JoinTree
joinTree
       in JoinTree
forall a. Monoid a => a
mempty {_jtObjectRelations :: HashMap ObjectRelationSource SelectNode
_jtObjectRelations = ObjectRelationSource
-> SelectNode -> HashMap ObjectRelationSource SelectNode
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton ObjectRelationSource
source SelectNode
selectNode}

withWriteArrayRelation ::
  (MonadWriter SelectWriter m) =>
  m
    ( ArrayRelationSource,
      S.Extractor,
      InsOrdHashMap S.ColumnAlias S.SQLExp,
      a
    ) ->
  m a
withWriteArrayRelation :: forall (m :: * -> *) a.
MonadWriter SelectWriter m =>
m (ArrayRelationSource, Extractor,
   InsOrdHashMap ColumnAlias SQLExp, a)
-> m a
withWriteArrayRelation m (ArrayRelationSource, Extractor,
   InsOrdHashMap ColumnAlias SQLExp, a)
action =
  (JoinTree
 -> (ArrayRelationSource, Extractor,
     InsOrdHashMap ColumnAlias SQLExp)
 -> JoinTree)
-> m (a,
      (ArrayRelationSource, Extractor, InsOrdHashMap ColumnAlias SQLExp))
-> m a
forall (m :: * -> *) b a.
MonadWriter SelectWriter m =>
(JoinTree -> b -> JoinTree) -> m (a, b) -> m a
withWriteJoinTree JoinTree
-> (ArrayRelationSource, Extractor,
    InsOrdHashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree (m (a,
    (ArrayRelationSource, Extractor, InsOrdHashMap ColumnAlias SQLExp))
 -> m a)
-> m (a,
      (ArrayRelationSource, Extractor, InsOrdHashMap ColumnAlias SQLExp))
-> m a
forall a b. (a -> b) -> a -> b
$ do
    (ArrayRelationSource
source, Extractor
topExtractor, InsOrdHashMap ColumnAlias SQLExp
nodeExtractors, a
out) <- m (ArrayRelationSource, Extractor,
   InsOrdHashMap ColumnAlias SQLExp, a)
action
    (a,
 (ArrayRelationSource, Extractor, InsOrdHashMap ColumnAlias SQLExp))
-> m (a,
      (ArrayRelationSource, Extractor, InsOrdHashMap ColumnAlias SQLExp))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
out, (ArrayRelationSource
source, Extractor
topExtractor, InsOrdHashMap ColumnAlias SQLExp
nodeExtractors))
  where
    updateJoinTree :: JoinTree
-> (ArrayRelationSource, Extractor,
    InsOrdHashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree JoinTree
joinTree (ArrayRelationSource
source, Extractor
topExtractor, InsOrdHashMap ColumnAlias SQLExp
nodeExtractors) =
      let arraySelectNode :: MultiRowSelectNode
arraySelectNode =
            [Extractor] -> SelectNode -> MultiRowSelectNode
MultiRowSelectNode [Extractor
topExtractor]
              (SelectNode -> MultiRowSelectNode)
-> SelectNode -> MultiRowSelectNode
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap ColumnAlias SQLExp -> JoinTree -> SelectNode
SelectNode InsOrdHashMap ColumnAlias SQLExp
nodeExtractors JoinTree
joinTree
       in JoinTree
forall a. Monoid a => a
mempty {_jtArrayRelations :: HashMap ArrayRelationSource MultiRowSelectNode
_jtArrayRelations = ArrayRelationSource
-> MultiRowSelectNode
-> HashMap ArrayRelationSource MultiRowSelectNode
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton ArrayRelationSource
source MultiRowSelectNode
arraySelectNode}

withWriteArrayConnection ::
  (MonadWriter SelectWriter m) =>
  m
    ( ArrayConnectionSource,
      S.Extractor,
      InsOrdHashMap S.ColumnAlias S.SQLExp,
      a
    ) ->
  m a
withWriteArrayConnection :: forall (m :: * -> *) a.
MonadWriter SelectWriter m =>
m (ArrayConnectionSource, Extractor,
   InsOrdHashMap ColumnAlias SQLExp, a)
-> m a
withWriteArrayConnection m (ArrayConnectionSource, Extractor,
   InsOrdHashMap ColumnAlias SQLExp, a)
action =
  (JoinTree
 -> (ArrayConnectionSource, Extractor,
     InsOrdHashMap ColumnAlias SQLExp)
 -> JoinTree)
-> m (a,
      (ArrayConnectionSource, Extractor,
       InsOrdHashMap ColumnAlias SQLExp))
-> m a
forall (m :: * -> *) b a.
MonadWriter SelectWriter m =>
(JoinTree -> b -> JoinTree) -> m (a, b) -> m a
withWriteJoinTree JoinTree
-> (ArrayConnectionSource, Extractor,
    InsOrdHashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree (m (a,
    (ArrayConnectionSource, Extractor,
     InsOrdHashMap ColumnAlias SQLExp))
 -> m a)
-> m (a,
      (ArrayConnectionSource, Extractor,
       InsOrdHashMap ColumnAlias SQLExp))
-> m a
forall a b. (a -> b) -> a -> b
$ do
    (ArrayConnectionSource
source, Extractor
topExtractor, InsOrdHashMap ColumnAlias SQLExp
nodeExtractors, a
out) <- m (ArrayConnectionSource, Extractor,
   InsOrdHashMap ColumnAlias SQLExp, a)
action
    (a,
 (ArrayConnectionSource, Extractor,
  InsOrdHashMap ColumnAlias SQLExp))
-> m (a,
      (ArrayConnectionSource, Extractor,
       InsOrdHashMap ColumnAlias SQLExp))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
out, (ArrayConnectionSource
source, Extractor
topExtractor, InsOrdHashMap ColumnAlias SQLExp
nodeExtractors))
  where
    updateJoinTree :: JoinTree
-> (ArrayConnectionSource, Extractor,
    InsOrdHashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree JoinTree
joinTree (ArrayConnectionSource
source, Extractor
topExtractor, InsOrdHashMap ColumnAlias SQLExp
nodeExtractors) =
      let arraySelectNode :: MultiRowSelectNode
arraySelectNode =
            [Extractor] -> SelectNode -> MultiRowSelectNode
MultiRowSelectNode [Extractor
topExtractor]
              (SelectNode -> MultiRowSelectNode)
-> SelectNode -> MultiRowSelectNode
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap ColumnAlias SQLExp -> JoinTree -> SelectNode
SelectNode InsOrdHashMap ColumnAlias SQLExp
nodeExtractors JoinTree
joinTree
       in JoinTree
forall a. Monoid a => a
mempty {_jtArrayConnections :: HashMap ArrayConnectionSource MultiRowSelectNode
_jtArrayConnections = ArrayConnectionSource
-> MultiRowSelectNode
-> HashMap ArrayConnectionSource MultiRowSelectNode
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton ArrayConnectionSource
source MultiRowSelectNode
arraySelectNode}

withWriteComputedFieldTableSet ::
  (MonadWriter SelectWriter m) =>
  m
    ( ComputedFieldTableSetSource,
      S.Extractor,
      InsOrdHashMap S.ColumnAlias S.SQLExp,
      a
    ) ->
  m a
withWriteComputedFieldTableSet :: forall (m :: * -> *) a.
MonadWriter SelectWriter m =>
m (ComputedFieldTableSetSource, Extractor,
   InsOrdHashMap ColumnAlias SQLExp, a)
-> m a
withWriteComputedFieldTableSet m (ComputedFieldTableSetSource, Extractor,
   InsOrdHashMap ColumnAlias SQLExp, a)
action =
  (JoinTree
 -> (ComputedFieldTableSetSource, Extractor,
     InsOrdHashMap ColumnAlias SQLExp)
 -> JoinTree)
-> m (a,
      (ComputedFieldTableSetSource, Extractor,
       InsOrdHashMap ColumnAlias SQLExp))
-> m a
forall (m :: * -> *) b a.
MonadWriter SelectWriter m =>
(JoinTree -> b -> JoinTree) -> m (a, b) -> m a
withWriteJoinTree JoinTree
-> (ComputedFieldTableSetSource, Extractor,
    InsOrdHashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree (m (a,
    (ComputedFieldTableSetSource, Extractor,
     InsOrdHashMap ColumnAlias SQLExp))
 -> m a)
-> m (a,
      (ComputedFieldTableSetSource, Extractor,
       InsOrdHashMap ColumnAlias SQLExp))
-> m a
forall a b. (a -> b) -> a -> b
$ do
    (ComputedFieldTableSetSource
source, Extractor
topExtractor, InsOrdHashMap ColumnAlias SQLExp
nodeExtractors, a
out) <- m (ComputedFieldTableSetSource, Extractor,
   InsOrdHashMap ColumnAlias SQLExp, a)
action
    (a,
 (ComputedFieldTableSetSource, Extractor,
  InsOrdHashMap ColumnAlias SQLExp))
-> m (a,
      (ComputedFieldTableSetSource, Extractor,
       InsOrdHashMap ColumnAlias SQLExp))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
out, (ComputedFieldTableSetSource
source, Extractor
topExtractor, InsOrdHashMap ColumnAlias SQLExp
nodeExtractors))
  where
    updateJoinTree :: JoinTree
-> (ComputedFieldTableSetSource, Extractor,
    InsOrdHashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree JoinTree
joinTree (ComputedFieldTableSetSource
source, Extractor
topExtractor, InsOrdHashMap ColumnAlias SQLExp
nodeExtractors) =
      let selectNode :: MultiRowSelectNode
selectNode = [Extractor] -> SelectNode -> MultiRowSelectNode
MultiRowSelectNode [Extractor
topExtractor] (SelectNode -> MultiRowSelectNode)
-> SelectNode -> MultiRowSelectNode
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap ColumnAlias SQLExp -> JoinTree -> SelectNode
SelectNode InsOrdHashMap ColumnAlias SQLExp
nodeExtractors JoinTree
joinTree
       in JoinTree
forall a. Monoid a => a
mempty {_jtComputedFieldTableSets :: HashMap ComputedFieldTableSetSource MultiRowSelectNode
_jtComputedFieldTableSets = ComputedFieldTableSetSource
-> MultiRowSelectNode
-> HashMap ComputedFieldTableSetSource MultiRowSelectNode
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton ComputedFieldTableSetSource
source MultiRowSelectNode
selectNode}