-- | 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 HM
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 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 JoinTree m) =>
  (JoinTree -> b -> JoinTree) ->
  m (a, b) ->
  m a
withWriteJoinTree :: (JoinTree -> b -> JoinTree) -> m (a, b) -> m a
withWriteJoinTree JoinTree -> b -> JoinTree
joinTreeUpdater m (a, b)
action =
  m (a, JoinTree -> JoinTree) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m (a, JoinTree -> JoinTree) -> m a)
-> m (a, JoinTree -> JoinTree) -> m a
forall a b. (a -> b) -> a -> b
$ do
    (a
out, b
result) <- m (a, b)
action
    let fromJoinTree :: JoinTree -> JoinTree
fromJoinTree JoinTree
joinTree =
          JoinTree -> b -> JoinTree
joinTreeUpdater JoinTree
joinTree b
result
    (a, JoinTree -> JoinTree) -> m (a, JoinTree -> JoinTree)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
out, JoinTree -> JoinTree
fromJoinTree)

withWriteObjectRelation ::
  (MonadWriter JoinTree m) =>
  m
    ( ObjectRelationSource,
      HM.HashMap S.ColumnAlias S.SQLExp,
      a
    ) ->
  m a
withWriteObjectRelation :: m (ObjectRelationSource, HashMap ColumnAlias SQLExp, a) -> m a
withWriteObjectRelation m (ObjectRelationSource, HashMap ColumnAlias SQLExp, a)
action =
  (JoinTree
 -> (ObjectRelationSource, HashMap ColumnAlias SQLExp) -> JoinTree)
-> m (a, (ObjectRelationSource, HashMap ColumnAlias SQLExp)) -> m a
forall (m :: * -> *) b a.
MonadWriter JoinTree m =>
(JoinTree -> b -> JoinTree) -> m (a, b) -> m a
withWriteJoinTree JoinTree
-> (ObjectRelationSource, HashMap ColumnAlias SQLExp) -> JoinTree
updateJoinTree (m (a, (ObjectRelationSource, HashMap ColumnAlias SQLExp)) -> m a)
-> m (a, (ObjectRelationSource, HashMap ColumnAlias SQLExp)) -> m a
forall a b. (a -> b) -> a -> b
$ do
    (ObjectRelationSource
source, HashMap ColumnAlias SQLExp
nodeExtractors, a
out) <- m (ObjectRelationSource, HashMap ColumnAlias SQLExp, a)
action
    (a, (ObjectRelationSource, HashMap ColumnAlias SQLExp))
-> m (a, (ObjectRelationSource, HashMap ColumnAlias SQLExp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
out, (ObjectRelationSource
source, HashMap ColumnAlias SQLExp
nodeExtractors))
  where
    updateJoinTree :: JoinTree
-> (ObjectRelationSource, HashMap ColumnAlias SQLExp) -> JoinTree
updateJoinTree JoinTree
joinTree (ObjectRelationSource
source, HashMap ColumnAlias SQLExp
nodeExtractors) =
      let selectNode :: SelectNode
selectNode = HashMap ColumnAlias SQLExp -> JoinTree -> SelectNode
SelectNode HashMap 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
HM.singleton ObjectRelationSource
source SelectNode
selectNode}

withWriteArrayRelation ::
  (MonadWriter JoinTree m) =>
  m
    ( ArrayRelationSource,
      S.Extractor,
      HM.HashMap S.ColumnAlias S.SQLExp,
      a
    ) ->
  m a
withWriteArrayRelation :: m (ArrayRelationSource, Extractor, HashMap ColumnAlias SQLExp, a)
-> m a
withWriteArrayRelation m (ArrayRelationSource, Extractor, HashMap ColumnAlias SQLExp, a)
action =
  (JoinTree
 -> (ArrayRelationSource, Extractor, HashMap ColumnAlias SQLExp)
 -> JoinTree)
-> m (a,
      (ArrayRelationSource, Extractor, HashMap ColumnAlias SQLExp))
-> m a
forall (m :: * -> *) b a.
MonadWriter JoinTree m =>
(JoinTree -> b -> JoinTree) -> m (a, b) -> m a
withWriteJoinTree JoinTree
-> (ArrayRelationSource, Extractor, HashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree (m (a,
    (ArrayRelationSource, Extractor, HashMap ColumnAlias SQLExp))
 -> m a)
-> m (a,
      (ArrayRelationSource, Extractor, HashMap ColumnAlias SQLExp))
-> m a
forall a b. (a -> b) -> a -> b
$ do
    (ArrayRelationSource
source, Extractor
topExtractor, HashMap ColumnAlias SQLExp
nodeExtractors, a
out) <- m (ArrayRelationSource, Extractor, HashMap ColumnAlias SQLExp, a)
action
    (a, (ArrayRelationSource, Extractor, HashMap ColumnAlias SQLExp))
-> m (a,
      (ArrayRelationSource, Extractor, HashMap ColumnAlias SQLExp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
out, (ArrayRelationSource
source, Extractor
topExtractor, HashMap ColumnAlias SQLExp
nodeExtractors))
  where
    updateJoinTree :: JoinTree
-> (ArrayRelationSource, Extractor, HashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree JoinTree
joinTree (ArrayRelationSource
source, Extractor
topExtractor, HashMap ColumnAlias SQLExp
nodeExtractors) =
      let arraySelectNode :: MultiRowSelectNode
arraySelectNode =
            [Extractor] -> SelectNode -> MultiRowSelectNode
MultiRowSelectNode [Extractor
topExtractor] (SelectNode -> MultiRowSelectNode)
-> SelectNode -> MultiRowSelectNode
forall a b. (a -> b) -> a -> b
$
              HashMap ColumnAlias SQLExp -> JoinTree -> SelectNode
SelectNode HashMap 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
HM.singleton ArrayRelationSource
source MultiRowSelectNode
arraySelectNode}

withWriteArrayConnection ::
  (MonadWriter JoinTree m) =>
  m
    ( ArrayConnectionSource,
      S.Extractor,
      HM.HashMap S.ColumnAlias S.SQLExp,
      a
    ) ->
  m a
withWriteArrayConnection :: m (ArrayConnectionSource, Extractor, HashMap ColumnAlias SQLExp, a)
-> m a
withWriteArrayConnection m (ArrayConnectionSource, Extractor, HashMap ColumnAlias SQLExp, a)
action =
  (JoinTree
 -> (ArrayConnectionSource, Extractor, HashMap ColumnAlias SQLExp)
 -> JoinTree)
-> m (a,
      (ArrayConnectionSource, Extractor, HashMap ColumnAlias SQLExp))
-> m a
forall (m :: * -> *) b a.
MonadWriter JoinTree m =>
(JoinTree -> b -> JoinTree) -> m (a, b) -> m a
withWriteJoinTree JoinTree
-> (ArrayConnectionSource, Extractor, HashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree (m (a,
    (ArrayConnectionSource, Extractor, HashMap ColumnAlias SQLExp))
 -> m a)
-> m (a,
      (ArrayConnectionSource, Extractor, HashMap ColumnAlias SQLExp))
-> m a
forall a b. (a -> b) -> a -> b
$ do
    (ArrayConnectionSource
source, Extractor
topExtractor, HashMap ColumnAlias SQLExp
nodeExtractors, a
out) <- m (ArrayConnectionSource, Extractor, HashMap ColumnAlias SQLExp, a)
action
    (a, (ArrayConnectionSource, Extractor, HashMap ColumnAlias SQLExp))
-> m (a,
      (ArrayConnectionSource, Extractor, HashMap ColumnAlias SQLExp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
out, (ArrayConnectionSource
source, Extractor
topExtractor, HashMap ColumnAlias SQLExp
nodeExtractors))
  where
    updateJoinTree :: JoinTree
-> (ArrayConnectionSource, Extractor, HashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree JoinTree
joinTree (ArrayConnectionSource
source, Extractor
topExtractor, HashMap ColumnAlias SQLExp
nodeExtractors) =
      let arraySelectNode :: MultiRowSelectNode
arraySelectNode =
            [Extractor] -> SelectNode -> MultiRowSelectNode
MultiRowSelectNode [Extractor
topExtractor] (SelectNode -> MultiRowSelectNode)
-> SelectNode -> MultiRowSelectNode
forall a b. (a -> b) -> a -> b
$
              HashMap ColumnAlias SQLExp -> JoinTree -> SelectNode
SelectNode HashMap 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
HM.singleton ArrayConnectionSource
source MultiRowSelectNode
arraySelectNode}

withWriteComputedFieldTableSet ::
  (MonadWriter JoinTree m) =>
  m
    ( ComputedFieldTableSetSource,
      S.Extractor,
      HM.HashMap S.ColumnAlias S.SQLExp,
      a
    ) ->
  m a
withWriteComputedFieldTableSet :: m (ComputedFieldTableSetSource, Extractor,
   HashMap ColumnAlias SQLExp, a)
-> m a
withWriteComputedFieldTableSet m (ComputedFieldTableSetSource, Extractor,
   HashMap ColumnAlias SQLExp, a)
action =
  (JoinTree
 -> (ComputedFieldTableSetSource, Extractor,
     HashMap ColumnAlias SQLExp)
 -> JoinTree)
-> m (a,
      (ComputedFieldTableSetSource, Extractor,
       HashMap ColumnAlias SQLExp))
-> m a
forall (m :: * -> *) b a.
MonadWriter JoinTree m =>
(JoinTree -> b -> JoinTree) -> m (a, b) -> m a
withWriteJoinTree JoinTree
-> (ComputedFieldTableSetSource, Extractor,
    HashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree (m (a,
    (ComputedFieldTableSetSource, Extractor,
     HashMap ColumnAlias SQLExp))
 -> m a)
-> m (a,
      (ComputedFieldTableSetSource, Extractor,
       HashMap ColumnAlias SQLExp))
-> m a
forall a b. (a -> b) -> a -> b
$ do
    (ComputedFieldTableSetSource
source, Extractor
topExtractor, HashMap ColumnAlias SQLExp
nodeExtractors, a
out) <- m (ComputedFieldTableSetSource, Extractor,
   HashMap ColumnAlias SQLExp, a)
action
    (a,
 (ComputedFieldTableSetSource, Extractor,
  HashMap ColumnAlias SQLExp))
-> m (a,
      (ComputedFieldTableSetSource, Extractor,
       HashMap ColumnAlias SQLExp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
out, (ComputedFieldTableSetSource
source, Extractor
topExtractor, HashMap ColumnAlias SQLExp
nodeExtractors))
  where
    updateJoinTree :: JoinTree
-> (ComputedFieldTableSetSource, Extractor,
    HashMap ColumnAlias SQLExp)
-> JoinTree
updateJoinTree JoinTree
joinTree (ComputedFieldTableSetSource
source, Extractor
topExtractor, HashMap ColumnAlias SQLExp
nodeExtractors) =
      let selectNode :: MultiRowSelectNode
selectNode = [Extractor] -> SelectNode -> MultiRowSelectNode
MultiRowSelectNode [Extractor
topExtractor] (SelectNode -> MultiRowSelectNode)
-> SelectNode -> MultiRowSelectNode
forall a b. (a -> b) -> a -> b
$ HashMap ColumnAlias SQLExp -> JoinTree -> SelectNode
SelectNode HashMap 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
HM.singleton ComputedFieldTableSetSource
source MultiRowSelectNode
selectNode}