{-# LANGUAGE UndecidableInstances #-}

-- | Postgres Translate Types
--
-- Intermediary / helper types used for translating IR to Postgres SQL.
module Hasura.Backends.Postgres.Translate.Types
  ( ApplySortingAndSlicing (ApplySortingAndSlicing),
    ArrayConnectionSource (ArrayConnectionSource, _acsSource),
    ArrayRelationSource (ArrayRelationSource),
    ComputedFieldTableSetSource (ComputedFieldTableSetSource),
    CustomSQLCTEs (..),
    NativeQueryFreshIdStore (..),
    initialNativeQueryFreshIdStore,
    DistinctAndOrderByExpr (ASorting),
    JoinTree (..),
    MultiRowSelectNode (..),
    ObjectRelationSource (..),
    ObjectSelectSource (ObjectSelectSource, _ossPrefix),
    PermissionLimitSubQuery (..),
    SelectNode (SelectNode),
    SelectSlicing (SelectSlicing, _ssLimit, _ssOffset),
    SelectSorting (..),
    SelectSource (SelectSource, _ssPrefix),
    SortingAndSlicing (SortingAndSlicing),
    SourcePrefixes (..),
    SimilarArrayFields,
    SelectWriter (..),
    applySortingAndSlicing,
    noSortingAndSlicing,
    objectSelectSourceToSelectSource,
    orderByForJsonAgg,
  )
where

import Data.HashMap.Strict qualified as HashMap
import Data.Int (Int64)
import Hasura.Backends.Postgres.SQL.DML qualified as Postgres
import Hasura.Backends.Postgres.SQL.Types qualified as Postgres
import Hasura.NativeQuery.Metadata (InterpolatedQuery)
import Hasura.Prelude
import Hasura.RQL.IR.Select
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Relationships.Local (Nullable)

data SourcePrefixes = SourcePrefixes
  { -- | Current source prefix
    SourcePrefixes -> Identifier
_pfThis :: Postgres.Identifier,
    -- | Base table source row identifier to generate
    -- the table's column identifiers for computed field
    -- function input parameters
    SourcePrefixes -> Identifier
_pfBase :: Postgres.Identifier
  }
  deriving (Int -> SourcePrefixes -> ShowS
[SourcePrefixes] -> ShowS
SourcePrefixes -> String
(Int -> SourcePrefixes -> ShowS)
-> (SourcePrefixes -> String)
-> ([SourcePrefixes] -> ShowS)
-> Show SourcePrefixes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourcePrefixes -> ShowS
showsPrec :: Int -> SourcePrefixes -> ShowS
$cshow :: SourcePrefixes -> String
show :: SourcePrefixes -> String
$cshowList :: [SourcePrefixes] -> ShowS
showList :: [SourcePrefixes] -> ShowS
Show, SourcePrefixes -> SourcePrefixes -> Bool
(SourcePrefixes -> SourcePrefixes -> Bool)
-> (SourcePrefixes -> SourcePrefixes -> Bool) -> Eq SourcePrefixes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourcePrefixes -> SourcePrefixes -> Bool
== :: SourcePrefixes -> SourcePrefixes -> Bool
$c/= :: SourcePrefixes -> SourcePrefixes -> Bool
/= :: SourcePrefixes -> SourcePrefixes -> Bool
Eq, (forall x. SourcePrefixes -> Rep SourcePrefixes x)
-> (forall x. Rep SourcePrefixes x -> SourcePrefixes)
-> Generic SourcePrefixes
forall x. Rep SourcePrefixes x -> SourcePrefixes
forall x. SourcePrefixes -> Rep SourcePrefixes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourcePrefixes -> Rep SourcePrefixes x
from :: forall x. SourcePrefixes -> Rep SourcePrefixes x
$cto :: forall x. Rep SourcePrefixes x -> SourcePrefixes
to :: forall x. Rep SourcePrefixes x -> SourcePrefixes
Generic)

instance Hashable SourcePrefixes

-- | Select portion of rows generated by the query using limit and offset
data SelectSlicing = SelectSlicing
  { SelectSlicing -> Maybe Int
_ssLimit :: Maybe Int,
    SelectSlicing -> Maybe Int64
_ssOffset :: Maybe Int64
  }
  deriving (Int -> SelectSlicing -> ShowS
[SelectSlicing] -> ShowS
SelectSlicing -> String
(Int -> SelectSlicing -> ShowS)
-> (SelectSlicing -> String)
-> ([SelectSlicing] -> ShowS)
-> Show SelectSlicing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectSlicing -> ShowS
showsPrec :: Int -> SelectSlicing -> ShowS
$cshow :: SelectSlicing -> String
show :: SelectSlicing -> String
$cshowList :: [SelectSlicing] -> ShowS
showList :: [SelectSlicing] -> ShowS
Show, SelectSlicing -> SelectSlicing -> Bool
(SelectSlicing -> SelectSlicing -> Bool)
-> (SelectSlicing -> SelectSlicing -> Bool) -> Eq SelectSlicing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectSlicing -> SelectSlicing -> Bool
== :: SelectSlicing -> SelectSlicing -> Bool
$c/= :: SelectSlicing -> SelectSlicing -> Bool
/= :: SelectSlicing -> SelectSlicing -> Bool
Eq, (forall x. SelectSlicing -> Rep SelectSlicing x)
-> (forall x. Rep SelectSlicing x -> SelectSlicing)
-> Generic SelectSlicing
forall x. Rep SelectSlicing x -> SelectSlicing
forall x. SelectSlicing -> Rep SelectSlicing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SelectSlicing -> Rep SelectSlicing x
from :: forall x. SelectSlicing -> Rep SelectSlicing x
$cto :: forall x. Rep SelectSlicing x -> SelectSlicing
to :: forall x. Rep SelectSlicing x -> SelectSlicing
Generic)

instance Hashable SelectSlicing

data DistinctAndOrderByExpr = ASorting
  { DistinctAndOrderByExpr -> (OrderByExp, Maybe DistinctExpr)
_sortAtNode :: (Postgres.OrderByExp, Maybe Postgres.DistinctExpr),
    DistinctAndOrderByExpr -> Maybe (OrderByExp, Maybe DistinctExpr)
_sortAtBase :: Maybe (Postgres.OrderByExp, Maybe Postgres.DistinctExpr)
  }
  deriving (Int -> DistinctAndOrderByExpr -> ShowS
[DistinctAndOrderByExpr] -> ShowS
DistinctAndOrderByExpr -> String
(Int -> DistinctAndOrderByExpr -> ShowS)
-> (DistinctAndOrderByExpr -> String)
-> ([DistinctAndOrderByExpr] -> ShowS)
-> Show DistinctAndOrderByExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DistinctAndOrderByExpr -> ShowS
showsPrec :: Int -> DistinctAndOrderByExpr -> ShowS
$cshow :: DistinctAndOrderByExpr -> String
show :: DistinctAndOrderByExpr -> String
$cshowList :: [DistinctAndOrderByExpr] -> ShowS
showList :: [DistinctAndOrderByExpr] -> ShowS
Show, DistinctAndOrderByExpr -> DistinctAndOrderByExpr -> Bool
(DistinctAndOrderByExpr -> DistinctAndOrderByExpr -> Bool)
-> (DistinctAndOrderByExpr -> DistinctAndOrderByExpr -> Bool)
-> Eq DistinctAndOrderByExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DistinctAndOrderByExpr -> DistinctAndOrderByExpr -> Bool
== :: DistinctAndOrderByExpr -> DistinctAndOrderByExpr -> Bool
$c/= :: DistinctAndOrderByExpr -> DistinctAndOrderByExpr -> Bool
/= :: DistinctAndOrderByExpr -> DistinctAndOrderByExpr -> Bool
Eq, (forall x. DistinctAndOrderByExpr -> Rep DistinctAndOrderByExpr x)
-> (forall x.
    Rep DistinctAndOrderByExpr x -> DistinctAndOrderByExpr)
-> Generic DistinctAndOrderByExpr
forall x. Rep DistinctAndOrderByExpr x -> DistinctAndOrderByExpr
forall x. DistinctAndOrderByExpr -> Rep DistinctAndOrderByExpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DistinctAndOrderByExpr -> Rep DistinctAndOrderByExpr x
from :: forall x. DistinctAndOrderByExpr -> Rep DistinctAndOrderByExpr x
$cto :: forall x. Rep DistinctAndOrderByExpr x -> DistinctAndOrderByExpr
to :: forall x. Rep DistinctAndOrderByExpr x -> DistinctAndOrderByExpr
Generic)

instance Hashable DistinctAndOrderByExpr

-- | Sorting with -- Note [Optimizing queries using limit/offset])
data SelectSorting
  = NoSorting (Maybe Postgres.DistinctExpr)
  | Sorting DistinctAndOrderByExpr
  deriving (Int -> SelectSorting -> ShowS
[SelectSorting] -> ShowS
SelectSorting -> String
(Int -> SelectSorting -> ShowS)
-> (SelectSorting -> String)
-> ([SelectSorting] -> ShowS)
-> Show SelectSorting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectSorting -> ShowS
showsPrec :: Int -> SelectSorting -> ShowS
$cshow :: SelectSorting -> String
show :: SelectSorting -> String
$cshowList :: [SelectSorting] -> ShowS
showList :: [SelectSorting] -> ShowS
Show, SelectSorting -> SelectSorting -> Bool
(SelectSorting -> SelectSorting -> Bool)
-> (SelectSorting -> SelectSorting -> Bool) -> Eq SelectSorting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectSorting -> SelectSorting -> Bool
== :: SelectSorting -> SelectSorting -> Bool
$c/= :: SelectSorting -> SelectSorting -> Bool
/= :: SelectSorting -> SelectSorting -> Bool
Eq, (forall x. SelectSorting -> Rep SelectSorting x)
-> (forall x. Rep SelectSorting x -> SelectSorting)
-> Generic SelectSorting
forall x. Rep SelectSorting x -> SelectSorting
forall x. SelectSorting -> Rep SelectSorting x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SelectSorting -> Rep SelectSorting x
from :: forall x. SelectSorting -> Rep SelectSorting x
$cto :: forall x. Rep SelectSorting x -> SelectSorting
to :: forall x. Rep SelectSorting x -> SelectSorting
Generic)

instance Hashable SelectSorting

data SortingAndSlicing = SortingAndSlicing
  { SortingAndSlicing -> SelectSorting
_sasSorting :: SelectSorting,
    SortingAndSlicing -> SelectSlicing
_sasSlicing :: SelectSlicing
  }
  deriving (Int -> SortingAndSlicing -> ShowS
[SortingAndSlicing] -> ShowS
SortingAndSlicing -> String
(Int -> SortingAndSlicing -> ShowS)
-> (SortingAndSlicing -> String)
-> ([SortingAndSlicing] -> ShowS)
-> Show SortingAndSlicing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortingAndSlicing -> ShowS
showsPrec :: Int -> SortingAndSlicing -> ShowS
$cshow :: SortingAndSlicing -> String
show :: SortingAndSlicing -> String
$cshowList :: [SortingAndSlicing] -> ShowS
showList :: [SortingAndSlicing] -> ShowS
Show, SortingAndSlicing -> SortingAndSlicing -> Bool
(SortingAndSlicing -> SortingAndSlicing -> Bool)
-> (SortingAndSlicing -> SortingAndSlicing -> Bool)
-> Eq SortingAndSlicing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortingAndSlicing -> SortingAndSlicing -> Bool
== :: SortingAndSlicing -> SortingAndSlicing -> Bool
$c/= :: SortingAndSlicing -> SortingAndSlicing -> Bool
/= :: SortingAndSlicing -> SortingAndSlicing -> Bool
Eq, (forall x. SortingAndSlicing -> Rep SortingAndSlicing x)
-> (forall x. Rep SortingAndSlicing x -> SortingAndSlicing)
-> Generic SortingAndSlicing
forall x. Rep SortingAndSlicing x -> SortingAndSlicing
forall x. SortingAndSlicing -> Rep SortingAndSlicing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SortingAndSlicing -> Rep SortingAndSlicing x
from :: forall x. SortingAndSlicing -> Rep SortingAndSlicing x
$cto :: forall x. Rep SortingAndSlicing x -> SortingAndSlicing
to :: forall x. Rep SortingAndSlicing x -> SortingAndSlicing
Generic)

instance Hashable SortingAndSlicing

data SelectSource = SelectSource
  { SelectSource -> Identifier
_ssPrefix :: Postgres.Identifier,
    SelectSource -> FromItem
_ssFrom :: Postgres.FromItem,
    SelectSource -> BoolExp
_ssWhere :: Postgres.BoolExp,
    SelectSource -> SortingAndSlicing
_ssSortingAndSlicing :: SortingAndSlicing
  }
  deriving ((forall x. SelectSource -> Rep SelectSource x)
-> (forall x. Rep SelectSource x -> SelectSource)
-> Generic SelectSource
forall x. Rep SelectSource x -> SelectSource
forall x. SelectSource -> Rep SelectSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SelectSource -> Rep SelectSource x
from :: forall x. SelectSource -> Rep SelectSource x
$cto :: forall x. Rep SelectSource x -> SelectSource
to :: forall x. Rep SelectSource x -> SelectSource
Generic)

instance Hashable SelectSource

deriving instance Show SelectSource

deriving instance Eq SelectSource

noSortingAndSlicing :: SortingAndSlicing
noSortingAndSlicing :: SortingAndSlicing
noSortingAndSlicing =
  SelectSorting -> SelectSlicing -> SortingAndSlicing
SortingAndSlicing (Maybe DistinctExpr -> SelectSorting
NoSorting Maybe DistinctExpr
forall a. Maybe a
Nothing) SelectSlicing
noSlicing

noSlicing :: SelectSlicing
noSlicing :: SelectSlicing
noSlicing = Maybe Int -> Maybe Int64 -> SelectSlicing
SelectSlicing Maybe Int
forall a. Maybe a
Nothing Maybe Int64
forall a. Maybe a
Nothing

orderByForJsonAgg :: SelectSource -> Maybe Postgres.OrderByExp
orderByForJsonAgg :: SelectSource -> Maybe OrderByExp
orderByForJsonAgg SelectSource {Identifier
BoolExp
FromItem
SortingAndSlicing
_ssPrefix :: SelectSource -> Identifier
_ssFrom :: SelectSource -> FromItem
_ssWhere :: SelectSource -> BoolExp
_ssSortingAndSlicing :: SelectSource -> SortingAndSlicing
_ssPrefix :: Identifier
_ssFrom :: FromItem
_ssWhere :: BoolExp
_ssSortingAndSlicing :: SortingAndSlicing
..} =
  case SortingAndSlicing -> SelectSorting
_sasSorting SortingAndSlicing
_ssSortingAndSlicing of
    NoSorting {} -> Maybe OrderByExp
forall a. Maybe a
Nothing
    Sorting ASorting {Maybe (OrderByExp, Maybe DistinctExpr)
(OrderByExp, Maybe DistinctExpr)
_sortAtNode :: DistinctAndOrderByExpr -> (OrderByExp, Maybe DistinctExpr)
_sortAtBase :: DistinctAndOrderByExpr -> Maybe (OrderByExp, Maybe DistinctExpr)
_sortAtNode :: (OrderByExp, Maybe DistinctExpr)
_sortAtBase :: Maybe (OrderByExp, Maybe DistinctExpr)
..} -> OrderByExp -> Maybe OrderByExp
forall a. a -> Maybe a
Just (OrderByExp -> Maybe OrderByExp) -> OrderByExp -> Maybe OrderByExp
forall a b. (a -> b) -> a -> b
$ (OrderByExp, Maybe DistinctExpr) -> OrderByExp
forall a b. (a, b) -> a
fst (OrderByExp, Maybe DistinctExpr)
_sortAtNode

data ApplySortingAndSlicing = ApplySortingAndSlicing
  { ApplySortingAndSlicing
-> (Maybe OrderByExp, SelectSlicing, Maybe DistinctExpr)
_applyAtBase :: (Maybe Postgres.OrderByExp, SelectSlicing, Maybe Postgres.DistinctExpr),
    ApplySortingAndSlicing
-> (Maybe OrderByExp, SelectSlicing, Maybe DistinctExpr)
_applyAtNode :: (Maybe Postgres.OrderByExp, SelectSlicing, Maybe Postgres.DistinctExpr)
  }

applySortingAndSlicing :: SortingAndSlicing -> ApplySortingAndSlicing
applySortingAndSlicing :: SortingAndSlicing -> ApplySortingAndSlicing
applySortingAndSlicing SortingAndSlicing {SelectSorting
SelectSlicing
_sasSorting :: SortingAndSlicing -> SelectSorting
_sasSlicing :: SortingAndSlicing -> SelectSlicing
_sasSorting :: SelectSorting
_sasSlicing :: SelectSlicing
..} =
  case SelectSorting
_sasSorting of
    NoSorting Maybe DistinctExpr
distinctExp -> Maybe DistinctExpr -> ApplySortingAndSlicing
withNoSorting Maybe DistinctExpr
distinctExp
    Sorting DistinctAndOrderByExpr
sorting -> DistinctAndOrderByExpr -> ApplySortingAndSlicing
withSoritng DistinctAndOrderByExpr
sorting
  where
    withNoSorting :: Maybe DistinctExpr -> ApplySortingAndSlicing
withNoSorting Maybe DistinctExpr
distinctExp =
      (Maybe OrderByExp, SelectSlicing, Maybe DistinctExpr)
-> (Maybe OrderByExp, SelectSlicing, Maybe DistinctExpr)
-> ApplySortingAndSlicing
ApplySortingAndSlicing (Maybe OrderByExp
forall a. Maybe a
Nothing, SelectSlicing
_sasSlicing, Maybe DistinctExpr
distinctExp) (Maybe OrderByExp
forall a. Maybe a
Nothing, SelectSlicing
noSlicing, Maybe DistinctExpr
forall a. Maybe a
Nothing)
    withSoritng :: DistinctAndOrderByExpr -> ApplySortingAndSlicing
withSoritng ASorting {Maybe (OrderByExp, Maybe DistinctExpr)
(OrderByExp, Maybe DistinctExpr)
_sortAtNode :: DistinctAndOrderByExpr -> (OrderByExp, Maybe DistinctExpr)
_sortAtBase :: DistinctAndOrderByExpr -> Maybe (OrderByExp, Maybe DistinctExpr)
_sortAtNode :: (OrderByExp, Maybe DistinctExpr)
_sortAtBase :: Maybe (OrderByExp, Maybe DistinctExpr)
..} =
      let (OrderByExp
nodeOrderBy, Maybe DistinctExpr
nodeDistinctOn) = (OrderByExp, Maybe DistinctExpr)
_sortAtNode
       in case Maybe (OrderByExp, Maybe DistinctExpr)
_sortAtBase of
            Just (OrderByExp
baseOrderBy, Maybe DistinctExpr
baseDistinctOn) ->
              (Maybe OrderByExp, SelectSlicing, Maybe DistinctExpr)
-> (Maybe OrderByExp, SelectSlicing, Maybe DistinctExpr)
-> ApplySortingAndSlicing
ApplySortingAndSlicing (OrderByExp -> Maybe OrderByExp
forall a. a -> Maybe a
Just OrderByExp
baseOrderBy, SelectSlicing
_sasSlicing, Maybe DistinctExpr
baseDistinctOn) (OrderByExp -> Maybe OrderByExp
forall a. a -> Maybe a
Just OrderByExp
nodeOrderBy, SelectSlicing
noSlicing, Maybe DistinctExpr
nodeDistinctOn)
            Maybe (OrderByExp, Maybe DistinctExpr)
Nothing ->
              (Maybe OrderByExp, SelectSlicing, Maybe DistinctExpr)
-> (Maybe OrderByExp, SelectSlicing, Maybe DistinctExpr)
-> ApplySortingAndSlicing
ApplySortingAndSlicing (Maybe OrderByExp
forall a. Maybe a
Nothing, SelectSlicing
noSlicing, Maybe DistinctExpr
forall a. Maybe a
Nothing) (OrderByExp -> Maybe OrderByExp
forall a. a -> Maybe a
Just OrderByExp
nodeOrderBy, SelectSlicing
_sasSlicing, Maybe DistinctExpr
nodeDistinctOn)

data SelectNode = SelectNode
  { SelectNode -> InsOrdHashMap ColumnAlias SQLExp
_snExtractors :: InsOrdHashMap Postgres.ColumnAlias Postgres.SQLExp,
    SelectNode -> JoinTree
_snJoinTree :: JoinTree
  }
  deriving stock (SelectNode -> SelectNode -> Bool
(SelectNode -> SelectNode -> Bool)
-> (SelectNode -> SelectNode -> Bool) -> Eq SelectNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectNode -> SelectNode -> Bool
== :: SelectNode -> SelectNode -> Bool
$c/= :: SelectNode -> SelectNode -> Bool
/= :: SelectNode -> SelectNode -> Bool
Eq, Int -> SelectNode -> ShowS
[SelectNode] -> ShowS
SelectNode -> String
(Int -> SelectNode -> ShowS)
-> (SelectNode -> String)
-> ([SelectNode] -> ShowS)
-> Show SelectNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectNode -> ShowS
showsPrec :: Int -> SelectNode -> ShowS
$cshow :: SelectNode -> String
show :: SelectNode -> String
$cshowList :: [SelectNode] -> ShowS
showList :: [SelectNode] -> ShowS
Show)

instance Semigroup SelectNode where
  SelectNode InsOrdHashMap ColumnAlias SQLExp
lExtrs JoinTree
lJoinTree <> :: SelectNode -> SelectNode -> SelectNode
<> SelectNode InsOrdHashMap ColumnAlias SQLExp
rExtrs JoinTree
rJoinTree =
    InsOrdHashMap ColumnAlias SQLExp -> JoinTree -> SelectNode
SelectNode (InsOrdHashMap ColumnAlias SQLExp
lExtrs InsOrdHashMap ColumnAlias SQLExp
-> InsOrdHashMap ColumnAlias SQLExp
-> InsOrdHashMap ColumnAlias SQLExp
forall a. Semigroup a => a -> a -> a
<> InsOrdHashMap ColumnAlias SQLExp
rExtrs) (JoinTree
lJoinTree JoinTree -> JoinTree -> JoinTree
forall a. Semigroup a => a -> a -> a
<> JoinTree
rJoinTree)

data ObjectSelectSource = ObjectSelectSource
  { ObjectSelectSource -> Identifier
_ossPrefix :: Postgres.Identifier,
    ObjectSelectSource -> FromItem
_ossFrom :: Postgres.FromItem,
    ObjectSelectSource -> BoolExp
_ossWhere :: Postgres.BoolExp
  }
  deriving (Int -> ObjectSelectSource -> ShowS
[ObjectSelectSource] -> ShowS
ObjectSelectSource -> String
(Int -> ObjectSelectSource -> ShowS)
-> (ObjectSelectSource -> String)
-> ([ObjectSelectSource] -> ShowS)
-> Show ObjectSelectSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectSelectSource -> ShowS
showsPrec :: Int -> ObjectSelectSource -> ShowS
$cshow :: ObjectSelectSource -> String
show :: ObjectSelectSource -> String
$cshowList :: [ObjectSelectSource] -> ShowS
showList :: [ObjectSelectSource] -> ShowS
Show, ObjectSelectSource -> ObjectSelectSource -> Bool
(ObjectSelectSource -> ObjectSelectSource -> Bool)
-> (ObjectSelectSource -> ObjectSelectSource -> Bool)
-> Eq ObjectSelectSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectSelectSource -> ObjectSelectSource -> Bool
== :: ObjectSelectSource -> ObjectSelectSource -> Bool
$c/= :: ObjectSelectSource -> ObjectSelectSource -> Bool
/= :: ObjectSelectSource -> ObjectSelectSource -> Bool
Eq, (forall x. ObjectSelectSource -> Rep ObjectSelectSource x)
-> (forall x. Rep ObjectSelectSource x -> ObjectSelectSource)
-> Generic ObjectSelectSource
forall x. Rep ObjectSelectSource x -> ObjectSelectSource
forall x. ObjectSelectSource -> Rep ObjectSelectSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectSelectSource -> Rep ObjectSelectSource x
from :: forall x. ObjectSelectSource -> Rep ObjectSelectSource x
$cto :: forall x. Rep ObjectSelectSource x -> ObjectSelectSource
to :: forall x. Rep ObjectSelectSource x -> ObjectSelectSource
Generic)

instance Hashable ObjectSelectSource

objectSelectSourceToSelectSource :: ObjectSelectSource -> SelectSource
objectSelectSourceToSelectSource :: ObjectSelectSource -> SelectSource
objectSelectSourceToSelectSource ObjectSelectSource {Identifier
BoolExp
FromItem
_ossPrefix :: ObjectSelectSource -> Identifier
_ossFrom :: ObjectSelectSource -> FromItem
_ossWhere :: ObjectSelectSource -> BoolExp
_ossPrefix :: Identifier
_ossFrom :: FromItem
_ossWhere :: BoolExp
..} =
  Identifier
-> FromItem -> BoolExp -> SortingAndSlicing -> SelectSource
SelectSource Identifier
_ossPrefix FromItem
_ossFrom BoolExp
_ossWhere SortingAndSlicing
sortingAndSlicing
  where
    sortingAndSlicing :: SortingAndSlicing
sortingAndSlicing = SelectSorting -> SelectSlicing -> SortingAndSlicing
SortingAndSlicing SelectSorting
noSorting SelectSlicing
limit1
    noSorting :: SelectSorting
noSorting = Maybe DistinctExpr -> SelectSorting
NoSorting Maybe DistinctExpr
forall a. Maybe a
Nothing
    -- We specify 'LIMIT 1' here to mitigate misconfigured object relationships with an
    -- unexpected one-to-many/many-to-many relationship, instead of the expected one-to-one/many-to-one relationship.
    -- Because we can't detect this misconfiguration statically (it depends on the data),
    -- we force a single (or null) result instead by adding 'LIMIT 1'.
    -- Which result is returned might be non-deterministic (though only in misconfigured cases).
    -- Proper one-to-one/many-to-one object relationships should not be semantically affected by this.
    -- See: https://github.com/hasura/graphql-engine/issues/7936
    limit1 :: SelectSlicing
limit1 = Maybe Int -> Maybe Int64 -> SelectSlicing
SelectSlicing (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Maybe Int64
forall a. Maybe a
Nothing

data ObjectRelationSource = ObjectRelationSource
  { ObjectRelationSource -> RelName
_orsRelationshipName :: RelName,
    ObjectRelationSource -> HashMap PGCol PGCol
_orsRelationMapping :: HashMap.HashMap Postgres.PGCol Postgres.PGCol,
    ObjectRelationSource -> ObjectSelectSource
_orsSelectSource :: ObjectSelectSource,
    ObjectRelationSource -> Nullable
_orsNullable :: Nullable
  }
  deriving ((forall x. ObjectRelationSource -> Rep ObjectRelationSource x)
-> (forall x. Rep ObjectRelationSource x -> ObjectRelationSource)
-> Generic ObjectRelationSource
forall x. Rep ObjectRelationSource x -> ObjectRelationSource
forall x. ObjectRelationSource -> Rep ObjectRelationSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectRelationSource -> Rep ObjectRelationSource x
from :: forall x. ObjectRelationSource -> Rep ObjectRelationSource x
$cto :: forall x. Rep ObjectRelationSource x -> ObjectRelationSource
to :: forall x. Rep ObjectRelationSource x -> ObjectRelationSource
Generic, Int -> ObjectRelationSource -> ShowS
[ObjectRelationSource] -> ShowS
ObjectRelationSource -> String
(Int -> ObjectRelationSource -> ShowS)
-> (ObjectRelationSource -> String)
-> ([ObjectRelationSource] -> ShowS)
-> Show ObjectRelationSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectRelationSource -> ShowS
showsPrec :: Int -> ObjectRelationSource -> ShowS
$cshow :: ObjectRelationSource -> String
show :: ObjectRelationSource -> String
$cshowList :: [ObjectRelationSource] -> ShowS
showList :: [ObjectRelationSource] -> ShowS
Show)

instance Hashable ObjectRelationSource

deriving instance Eq ObjectRelationSource

data ArrayRelationSource = ArrayRelationSource
  { ArrayRelationSource -> TableAlias
_arsAlias :: Postgres.TableAlias,
    ArrayRelationSource -> HashMap PGCol PGCol
_arsRelationMapping :: HashMap.HashMap Postgres.PGCol Postgres.PGCol,
    ArrayRelationSource -> SelectSource
_arsSelectSource :: SelectSource
  }
  deriving ((forall x. ArrayRelationSource -> Rep ArrayRelationSource x)
-> (forall x. Rep ArrayRelationSource x -> ArrayRelationSource)
-> Generic ArrayRelationSource
forall x. Rep ArrayRelationSource x -> ArrayRelationSource
forall x. ArrayRelationSource -> Rep ArrayRelationSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ArrayRelationSource -> Rep ArrayRelationSource x
from :: forall x. ArrayRelationSource -> Rep ArrayRelationSource x
$cto :: forall x. Rep ArrayRelationSource x -> ArrayRelationSource
to :: forall x. Rep ArrayRelationSource x -> ArrayRelationSource
Generic, Int -> ArrayRelationSource -> ShowS
[ArrayRelationSource] -> ShowS
ArrayRelationSource -> String
(Int -> ArrayRelationSource -> ShowS)
-> (ArrayRelationSource -> String)
-> ([ArrayRelationSource] -> ShowS)
-> Show ArrayRelationSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArrayRelationSource -> ShowS
showsPrec :: Int -> ArrayRelationSource -> ShowS
$cshow :: ArrayRelationSource -> String
show :: ArrayRelationSource -> String
$cshowList :: [ArrayRelationSource] -> ShowS
showList :: [ArrayRelationSource] -> ShowS
Show)

instance Hashable ArrayRelationSource

deriving instance Eq ArrayRelationSource

data MultiRowSelectNode = MultiRowSelectNode
  { MultiRowSelectNode -> [Extractor]
_mrsnTopExtractors :: [Postgres.Extractor],
    MultiRowSelectNode -> SelectNode
_mrsnSelectNode :: SelectNode
  }
  deriving stock (MultiRowSelectNode -> MultiRowSelectNode -> Bool
(MultiRowSelectNode -> MultiRowSelectNode -> Bool)
-> (MultiRowSelectNode -> MultiRowSelectNode -> Bool)
-> Eq MultiRowSelectNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MultiRowSelectNode -> MultiRowSelectNode -> Bool
== :: MultiRowSelectNode -> MultiRowSelectNode -> Bool
$c/= :: MultiRowSelectNode -> MultiRowSelectNode -> Bool
/= :: MultiRowSelectNode -> MultiRowSelectNode -> Bool
Eq, Int -> MultiRowSelectNode -> ShowS
[MultiRowSelectNode] -> ShowS
MultiRowSelectNode -> String
(Int -> MultiRowSelectNode -> ShowS)
-> (MultiRowSelectNode -> String)
-> ([MultiRowSelectNode] -> ShowS)
-> Show MultiRowSelectNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MultiRowSelectNode -> ShowS
showsPrec :: Int -> MultiRowSelectNode -> ShowS
$cshow :: MultiRowSelectNode -> String
show :: MultiRowSelectNode -> String
$cshowList :: [MultiRowSelectNode] -> ShowS
showList :: [MultiRowSelectNode] -> ShowS
Show)

instance Semigroup MultiRowSelectNode where
  MultiRowSelectNode [Extractor]
lTopExtrs SelectNode
lSelNode <> :: MultiRowSelectNode -> MultiRowSelectNode -> MultiRowSelectNode
<> MultiRowSelectNode [Extractor]
rTopExtrs SelectNode
rSelNode =
    [Extractor] -> SelectNode -> MultiRowSelectNode
MultiRowSelectNode ([Extractor]
lTopExtrs [Extractor] -> [Extractor] -> [Extractor]
forall a. Semigroup a => a -> a -> a
<> [Extractor]
rTopExtrs) (SelectNode
lSelNode SelectNode -> SelectNode -> SelectNode
forall a. Semigroup a => a -> a -> a
<> SelectNode
rSelNode)

data ComputedFieldTableSetSource = ComputedFieldTableSetSource
  { ComputedFieldTableSetSource -> FieldName
_cftssFieldName :: FieldName,
    ComputedFieldTableSetSource -> SelectSource
_cftssSelectSource :: SelectSource
  }
  deriving ((forall x.
 ComputedFieldTableSetSource -> Rep ComputedFieldTableSetSource x)
-> (forall x.
    Rep ComputedFieldTableSetSource x -> ComputedFieldTableSetSource)
-> Generic ComputedFieldTableSetSource
forall x.
Rep ComputedFieldTableSetSource x -> ComputedFieldTableSetSource
forall x.
ComputedFieldTableSetSource -> Rep ComputedFieldTableSetSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ComputedFieldTableSetSource -> Rep ComputedFieldTableSetSource x
from :: forall x.
ComputedFieldTableSetSource -> Rep ComputedFieldTableSetSource x
$cto :: forall x.
Rep ComputedFieldTableSetSource x -> ComputedFieldTableSetSource
to :: forall x.
Rep ComputedFieldTableSetSource x -> ComputedFieldTableSetSource
Generic)

instance Hashable ComputedFieldTableSetSource

deriving instance Show ComputedFieldTableSetSource

deriving instance Eq ComputedFieldTableSetSource

data ArrayConnectionSource = ArrayConnectionSource
  { ArrayConnectionSource -> TableAlias
_acsAlias :: Postgres.TableAlias,
    ArrayConnectionSource -> HashMap PGCol PGCol
_acsRelationMapping :: HashMap.HashMap Postgres.PGCol Postgres.PGCol,
    ArrayConnectionSource -> Maybe BoolExp
_acsSplitFilter :: Maybe Postgres.BoolExp,
    ArrayConnectionSource -> Maybe ConnectionSlice
_acsSlice :: Maybe ConnectionSlice,
    ArrayConnectionSource -> SelectSource
_acsSource :: SelectSource
  }
  deriving ((forall x. ArrayConnectionSource -> Rep ArrayConnectionSource x)
-> (forall x. Rep ArrayConnectionSource x -> ArrayConnectionSource)
-> Generic ArrayConnectionSource
forall x. Rep ArrayConnectionSource x -> ArrayConnectionSource
forall x. ArrayConnectionSource -> Rep ArrayConnectionSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ArrayConnectionSource -> Rep ArrayConnectionSource x
from :: forall x. ArrayConnectionSource -> Rep ArrayConnectionSource x
$cto :: forall x. Rep ArrayConnectionSource x -> ArrayConnectionSource
to :: forall x. Rep ArrayConnectionSource x -> ArrayConnectionSource
Generic, Int -> ArrayConnectionSource -> ShowS
[ArrayConnectionSource] -> ShowS
ArrayConnectionSource -> String
(Int -> ArrayConnectionSource -> ShowS)
-> (ArrayConnectionSource -> String)
-> ([ArrayConnectionSource] -> ShowS)
-> Show ArrayConnectionSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArrayConnectionSource -> ShowS
showsPrec :: Int -> ArrayConnectionSource -> ShowS
$cshow :: ArrayConnectionSource -> String
show :: ArrayConnectionSource -> String
$cshowList :: [ArrayConnectionSource] -> ShowS
showList :: [ArrayConnectionSource] -> ShowS
Show)

deriving instance Eq ArrayConnectionSource

instance Hashable ArrayConnectionSource

----

data JoinTree = JoinTree
  { JoinTree -> HashMap ObjectRelationSource SelectNode
_jtObjectRelations :: HashMap.HashMap ObjectRelationSource SelectNode,
    JoinTree -> HashMap ArrayRelationSource MultiRowSelectNode
_jtArrayRelations :: HashMap.HashMap ArrayRelationSource MultiRowSelectNode,
    JoinTree -> HashMap ArrayConnectionSource MultiRowSelectNode
_jtArrayConnections :: HashMap.HashMap ArrayConnectionSource MultiRowSelectNode,
    JoinTree -> HashMap ComputedFieldTableSetSource MultiRowSelectNode
_jtComputedFieldTableSets :: HashMap.HashMap ComputedFieldTableSetSource MultiRowSelectNode
  }
  deriving stock (JoinTree -> JoinTree -> Bool
(JoinTree -> JoinTree -> Bool)
-> (JoinTree -> JoinTree -> Bool) -> Eq JoinTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoinTree -> JoinTree -> Bool
== :: JoinTree -> JoinTree -> Bool
$c/= :: JoinTree -> JoinTree -> Bool
/= :: JoinTree -> JoinTree -> Bool
Eq, Int -> JoinTree -> ShowS
[JoinTree] -> ShowS
JoinTree -> String
(Int -> JoinTree -> ShowS)
-> (JoinTree -> String) -> ([JoinTree] -> ShowS) -> Show JoinTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoinTree -> ShowS
showsPrec :: Int -> JoinTree -> ShowS
$cshow :: JoinTree -> String
show :: JoinTree -> String
$cshowList :: [JoinTree] -> ShowS
showList :: [JoinTree] -> ShowS
Show)

instance Semigroup JoinTree where
  JoinTree HashMap ObjectRelationSource SelectNode
lObjs HashMap ArrayRelationSource MultiRowSelectNode
lArrs HashMap ArrayConnectionSource MultiRowSelectNode
lArrConns HashMap ComputedFieldTableSetSource MultiRowSelectNode
lCfts <> :: JoinTree -> JoinTree -> JoinTree
<> JoinTree HashMap ObjectRelationSource SelectNode
rObjs HashMap ArrayRelationSource MultiRowSelectNode
rArrs HashMap ArrayConnectionSource MultiRowSelectNode
rArrConns HashMap ComputedFieldTableSetSource MultiRowSelectNode
rCfts =
    HashMap ObjectRelationSource SelectNode
-> HashMap ArrayRelationSource MultiRowSelectNode
-> HashMap ArrayConnectionSource MultiRowSelectNode
-> HashMap ComputedFieldTableSetSource MultiRowSelectNode
-> JoinTree
JoinTree
      ((SelectNode -> SelectNode -> SelectNode)
-> HashMap ObjectRelationSource SelectNode
-> HashMap ObjectRelationSource SelectNode
-> HashMap ObjectRelationSource SelectNode
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith SelectNode -> SelectNode -> SelectNode
forall a. Semigroup a => a -> a -> a
(<>) HashMap ObjectRelationSource SelectNode
lObjs HashMap ObjectRelationSource SelectNode
rObjs)
      ((MultiRowSelectNode -> MultiRowSelectNode -> MultiRowSelectNode)
-> HashMap ArrayRelationSource MultiRowSelectNode
-> HashMap ArrayRelationSource MultiRowSelectNode
-> HashMap ArrayRelationSource MultiRowSelectNode
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith MultiRowSelectNode -> MultiRowSelectNode -> MultiRowSelectNode
forall a. Semigroup a => a -> a -> a
(<>) HashMap ArrayRelationSource MultiRowSelectNode
lArrs HashMap ArrayRelationSource MultiRowSelectNode
rArrs)
      ((MultiRowSelectNode -> MultiRowSelectNode -> MultiRowSelectNode)
-> HashMap ArrayConnectionSource MultiRowSelectNode
-> HashMap ArrayConnectionSource MultiRowSelectNode
-> HashMap ArrayConnectionSource MultiRowSelectNode
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith MultiRowSelectNode -> MultiRowSelectNode -> MultiRowSelectNode
forall a. Semigroup a => a -> a -> a
(<>) HashMap ArrayConnectionSource MultiRowSelectNode
lArrConns HashMap ArrayConnectionSource MultiRowSelectNode
rArrConns)
      ((MultiRowSelectNode -> MultiRowSelectNode -> MultiRowSelectNode)
-> HashMap ComputedFieldTableSetSource MultiRowSelectNode
-> HashMap ComputedFieldTableSetSource MultiRowSelectNode
-> HashMap ComputedFieldTableSetSource MultiRowSelectNode
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith MultiRowSelectNode -> MultiRowSelectNode -> MultiRowSelectNode
forall a. Semigroup a => a -> a -> a
(<>) HashMap ComputedFieldTableSetSource MultiRowSelectNode
lCfts HashMap ComputedFieldTableSetSource MultiRowSelectNode
rCfts)

instance Monoid JoinTree where
  mempty :: JoinTree
mempty = HashMap ObjectRelationSource SelectNode
-> HashMap ArrayRelationSource MultiRowSelectNode
-> HashMap ArrayConnectionSource MultiRowSelectNode
-> HashMap ComputedFieldTableSetSource MultiRowSelectNode
-> JoinTree
JoinTree HashMap ObjectRelationSource SelectNode
forall a. Monoid a => a
mempty HashMap ArrayRelationSource MultiRowSelectNode
forall a. Monoid a => a
mempty HashMap ArrayConnectionSource MultiRowSelectNode
forall a. Monoid a => a
mempty HashMap ComputedFieldTableSetSource MultiRowSelectNode
forall a. Monoid a => a
mempty

data PermissionLimitSubQuery
  = -- | Permission limit
    PLSQRequired Int
  | PLSQNotRequired
  deriving (Int -> PermissionLimitSubQuery -> ShowS
[PermissionLimitSubQuery] -> ShowS
PermissionLimitSubQuery -> String
(Int -> PermissionLimitSubQuery -> ShowS)
-> (PermissionLimitSubQuery -> String)
-> ([PermissionLimitSubQuery] -> ShowS)
-> Show PermissionLimitSubQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PermissionLimitSubQuery -> ShowS
showsPrec :: Int -> PermissionLimitSubQuery -> ShowS
$cshow :: PermissionLimitSubQuery -> String
show :: PermissionLimitSubQuery -> String
$cshowList :: [PermissionLimitSubQuery] -> ShowS
showList :: [PermissionLimitSubQuery] -> ShowS
Show, PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool
(PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool)
-> (PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool)
-> Eq PermissionLimitSubQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool
== :: PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool
$c/= :: PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool
/= :: PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool
Eq)

type SimilarArrayFields = HashMap.HashMap FieldName [FieldName]

----

newtype CustomSQLCTEs = CustomSQLCTEs
  { CustomSQLCTEs -> HashMap TableAlias (InterpolatedQuery SQLExp)
getCustomSQLCTEs :: HashMap.HashMap Postgres.TableAlias (InterpolatedQuery Postgres.SQLExp)
  }
  deriving newtype (CustomSQLCTEs -> CustomSQLCTEs -> Bool
(CustomSQLCTEs -> CustomSQLCTEs -> Bool)
-> (CustomSQLCTEs -> CustomSQLCTEs -> Bool) -> Eq CustomSQLCTEs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomSQLCTEs -> CustomSQLCTEs -> Bool
== :: CustomSQLCTEs -> CustomSQLCTEs -> Bool
$c/= :: CustomSQLCTEs -> CustomSQLCTEs -> Bool
/= :: CustomSQLCTEs -> CustomSQLCTEs -> Bool
Eq, Int -> CustomSQLCTEs -> ShowS
[CustomSQLCTEs] -> ShowS
CustomSQLCTEs -> String
(Int -> CustomSQLCTEs -> ShowS)
-> (CustomSQLCTEs -> String)
-> ([CustomSQLCTEs] -> ShowS)
-> Show CustomSQLCTEs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomSQLCTEs -> ShowS
showsPrec :: Int -> CustomSQLCTEs -> ShowS
$cshow :: CustomSQLCTEs -> String
show :: CustomSQLCTEs -> String
$cshowList :: [CustomSQLCTEs] -> ShowS
showList :: [CustomSQLCTEs] -> ShowS
Show, NonEmpty CustomSQLCTEs -> CustomSQLCTEs
CustomSQLCTEs -> CustomSQLCTEs -> CustomSQLCTEs
(CustomSQLCTEs -> CustomSQLCTEs -> CustomSQLCTEs)
-> (NonEmpty CustomSQLCTEs -> CustomSQLCTEs)
-> (forall b. Integral b => b -> CustomSQLCTEs -> CustomSQLCTEs)
-> Semigroup CustomSQLCTEs
forall b. Integral b => b -> CustomSQLCTEs -> CustomSQLCTEs
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: CustomSQLCTEs -> CustomSQLCTEs -> CustomSQLCTEs
<> :: CustomSQLCTEs -> CustomSQLCTEs -> CustomSQLCTEs
$csconcat :: NonEmpty CustomSQLCTEs -> CustomSQLCTEs
sconcat :: NonEmpty CustomSQLCTEs -> CustomSQLCTEs
$cstimes :: forall b. Integral b => b -> CustomSQLCTEs -> CustomSQLCTEs
stimes :: forall b. Integral b => b -> CustomSQLCTEs -> CustomSQLCTEs
Semigroup, Semigroup CustomSQLCTEs
CustomSQLCTEs
Semigroup CustomSQLCTEs
-> CustomSQLCTEs
-> (CustomSQLCTEs -> CustomSQLCTEs -> CustomSQLCTEs)
-> ([CustomSQLCTEs] -> CustomSQLCTEs)
-> Monoid CustomSQLCTEs
[CustomSQLCTEs] -> CustomSQLCTEs
CustomSQLCTEs -> CustomSQLCTEs -> CustomSQLCTEs
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: CustomSQLCTEs
mempty :: CustomSQLCTEs
$cmappend :: CustomSQLCTEs -> CustomSQLCTEs -> CustomSQLCTEs
mappend :: CustomSQLCTEs -> CustomSQLCTEs -> CustomSQLCTEs
$cmconcat :: [CustomSQLCTEs] -> CustomSQLCTEs
mconcat :: [CustomSQLCTEs] -> CustomSQLCTEs
Monoid)

----

data SelectWriter = SelectWriter
  { SelectWriter -> JoinTree
_swJoinTree :: JoinTree,
    SelectWriter -> CustomSQLCTEs
_swCustomSQLCTEs :: CustomSQLCTEs
  }

instance Semigroup SelectWriter where
  (SelectWriter JoinTree
jtA CustomSQLCTEs
cteA) <> :: SelectWriter -> SelectWriter -> SelectWriter
<> (SelectWriter JoinTree
jtB CustomSQLCTEs
cteB) =
    JoinTree -> CustomSQLCTEs -> SelectWriter
SelectWriter (JoinTree
jtA JoinTree -> JoinTree -> JoinTree
forall a. Semigroup a => a -> a -> a
<> JoinTree
jtB) (CustomSQLCTEs
cteA CustomSQLCTEs -> CustomSQLCTEs -> CustomSQLCTEs
forall a. Semigroup a => a -> a -> a
<> CustomSQLCTEs
cteB)

instance Monoid SelectWriter where
  mempty :: SelectWriter
mempty = JoinTree -> CustomSQLCTEs -> SelectWriter
SelectWriter JoinTree
forall a. Monoid a => a
mempty CustomSQLCTEs
forall a. Monoid a => a
mempty

----

newtype NativeQueryFreshIdStore = NativeQueryFreshIdStore {NativeQueryFreshIdStore -> Int
nqNextFreshId :: Int}
  deriving newtype (NativeQueryFreshIdStore -> NativeQueryFreshIdStore -> Bool
(NativeQueryFreshIdStore -> NativeQueryFreshIdStore -> Bool)
-> (NativeQueryFreshIdStore -> NativeQueryFreshIdStore -> Bool)
-> Eq NativeQueryFreshIdStore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NativeQueryFreshIdStore -> NativeQueryFreshIdStore -> Bool
== :: NativeQueryFreshIdStore -> NativeQueryFreshIdStore -> Bool
$c/= :: NativeQueryFreshIdStore -> NativeQueryFreshIdStore -> Bool
/= :: NativeQueryFreshIdStore -> NativeQueryFreshIdStore -> Bool
Eq, Int -> NativeQueryFreshIdStore -> ShowS
[NativeQueryFreshIdStore] -> ShowS
NativeQueryFreshIdStore -> String
(Int -> NativeQueryFreshIdStore -> ShowS)
-> (NativeQueryFreshIdStore -> String)
-> ([NativeQueryFreshIdStore] -> ShowS)
-> Show NativeQueryFreshIdStore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NativeQueryFreshIdStore -> ShowS
showsPrec :: Int -> NativeQueryFreshIdStore -> ShowS
$cshow :: NativeQueryFreshIdStore -> String
show :: NativeQueryFreshIdStore -> String
$cshowList :: [NativeQueryFreshIdStore] -> ShowS
showList :: [NativeQueryFreshIdStore] -> ShowS
Show, Int -> NativeQueryFreshIdStore
NativeQueryFreshIdStore -> Int
NativeQueryFreshIdStore -> [NativeQueryFreshIdStore]
NativeQueryFreshIdStore -> NativeQueryFreshIdStore
NativeQueryFreshIdStore
-> NativeQueryFreshIdStore -> [NativeQueryFreshIdStore]
NativeQueryFreshIdStore
-> NativeQueryFreshIdStore
-> NativeQueryFreshIdStore
-> [NativeQueryFreshIdStore]
(NativeQueryFreshIdStore -> NativeQueryFreshIdStore)
-> (NativeQueryFreshIdStore -> NativeQueryFreshIdStore)
-> (Int -> NativeQueryFreshIdStore)
-> (NativeQueryFreshIdStore -> Int)
-> (NativeQueryFreshIdStore -> [NativeQueryFreshIdStore])
-> (NativeQueryFreshIdStore
    -> NativeQueryFreshIdStore -> [NativeQueryFreshIdStore])
-> (NativeQueryFreshIdStore
    -> NativeQueryFreshIdStore -> [NativeQueryFreshIdStore])
-> (NativeQueryFreshIdStore
    -> NativeQueryFreshIdStore
    -> NativeQueryFreshIdStore
    -> [NativeQueryFreshIdStore])
-> Enum NativeQueryFreshIdStore
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: NativeQueryFreshIdStore -> NativeQueryFreshIdStore
succ :: NativeQueryFreshIdStore -> NativeQueryFreshIdStore
$cpred :: NativeQueryFreshIdStore -> NativeQueryFreshIdStore
pred :: NativeQueryFreshIdStore -> NativeQueryFreshIdStore
$ctoEnum :: Int -> NativeQueryFreshIdStore
toEnum :: Int -> NativeQueryFreshIdStore
$cfromEnum :: NativeQueryFreshIdStore -> Int
fromEnum :: NativeQueryFreshIdStore -> Int
$cenumFrom :: NativeQueryFreshIdStore -> [NativeQueryFreshIdStore]
enumFrom :: NativeQueryFreshIdStore -> [NativeQueryFreshIdStore]
$cenumFromThen :: NativeQueryFreshIdStore
-> NativeQueryFreshIdStore -> [NativeQueryFreshIdStore]
enumFromThen :: NativeQueryFreshIdStore
-> NativeQueryFreshIdStore -> [NativeQueryFreshIdStore]
$cenumFromTo :: NativeQueryFreshIdStore
-> NativeQueryFreshIdStore -> [NativeQueryFreshIdStore]
enumFromTo :: NativeQueryFreshIdStore
-> NativeQueryFreshIdStore -> [NativeQueryFreshIdStore]
$cenumFromThenTo :: NativeQueryFreshIdStore
-> NativeQueryFreshIdStore
-> NativeQueryFreshIdStore
-> [NativeQueryFreshIdStore]
enumFromThenTo :: NativeQueryFreshIdStore
-> NativeQueryFreshIdStore
-> NativeQueryFreshIdStore
-> [NativeQueryFreshIdStore]
Enum)

initialNativeQueryFreshIdStore :: NativeQueryFreshIdStore
initialNativeQueryFreshIdStore :: NativeQueryFreshIdStore
initialNativeQueryFreshIdStore = Int -> NativeQueryFreshIdStore
NativeQueryFreshIdStore Int
0