{-# 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),
    DistinctAndOrderByExpr (ASorting),
    JoinTree (..),
    MultiRowSelectNode (..),
    ObjectRelationSource (ObjectRelationSource),
    ObjectSelectSource (ObjectSelectSource, _ossPrefix),
    PermissionLimitSubQuery (..),
    SelectNode (SelectNode),
    SelectSlicing (SelectSlicing, _ssLimit, _ssOffset),
    SelectSorting (..),
    SelectSource (SelectSource, _ssPrefix),
    SortingAndSlicing (SortingAndSlicing),
    SourcePrefixes (..),
    SimilarArrayFields,
    applySortingAndSlicing,
    noSortingAndSlicing,
    objectSelectSourceToSelectSource,
    orderByForJsonAgg,
  )
where

import Data.HashMap.Strict qualified as HM
import Data.Int (Int64)
import Hasura.Backends.Postgres.SQL.DML qualified as PG
import Hasura.Backends.Postgres.SQL.Types qualified as PG
import Hasura.Prelude
import Hasura.RQL.IR.Select
import Hasura.RQL.Types.Common

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

instance Hashable SelectSlicing

data DistinctAndOrderByExpr = ASorting
  { DistinctAndOrderByExpr -> (OrderByExp, Maybe DistinctExpr)
_sortAtNode :: (PG.OrderByExp, Maybe PG.DistinctExpr),
    DistinctAndOrderByExpr -> Maybe (OrderByExp, Maybe DistinctExpr)
_sortAtBase :: Maybe (PG.OrderByExp, Maybe PG.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
showList :: [DistinctAndOrderByExpr] -> ShowS
$cshowList :: [DistinctAndOrderByExpr] -> ShowS
show :: DistinctAndOrderByExpr -> String
$cshow :: DistinctAndOrderByExpr -> String
showsPrec :: Int -> DistinctAndOrderByExpr -> ShowS
$cshowsPrec :: Int -> DistinctAndOrderByExpr -> ShowS
Show, DistinctAndOrderByExpr -> DistinctAndOrderByExpr -> Bool
(DistinctAndOrderByExpr -> DistinctAndOrderByExpr -> Bool)
-> (DistinctAndOrderByExpr -> DistinctAndOrderByExpr -> Bool)
-> Eq DistinctAndOrderByExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DistinctAndOrderByExpr -> DistinctAndOrderByExpr -> Bool
$c/= :: DistinctAndOrderByExpr -> DistinctAndOrderByExpr -> Bool
== :: DistinctAndOrderByExpr -> DistinctAndOrderByExpr -> Bool
$c== :: 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
$cto :: forall x. Rep DistinctAndOrderByExpr x -> DistinctAndOrderByExpr
$cfrom :: forall x. DistinctAndOrderByExpr -> Rep DistinctAndOrderByExpr x
Generic)

instance Hashable DistinctAndOrderByExpr

-- | Sorting with -- Note [Optimizing queries using limit/offset])
data SelectSorting
  = NoSorting (Maybe PG.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
showList :: [SelectSorting] -> ShowS
$cshowList :: [SelectSorting] -> ShowS
show :: SelectSorting -> String
$cshow :: SelectSorting -> String
showsPrec :: Int -> SelectSorting -> ShowS
$cshowsPrec :: Int -> SelectSorting -> ShowS
Show, SelectSorting -> SelectSorting -> Bool
(SelectSorting -> SelectSorting -> Bool)
-> (SelectSorting -> SelectSorting -> Bool) -> Eq SelectSorting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectSorting -> SelectSorting -> Bool
$c/= :: SelectSorting -> SelectSorting -> Bool
== :: SelectSorting -> SelectSorting -> Bool
$c== :: 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
$cto :: forall x. Rep SelectSorting x -> SelectSorting
$cfrom :: forall x. SelectSorting -> Rep SelectSorting x
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
showList :: [SortingAndSlicing] -> ShowS
$cshowList :: [SortingAndSlicing] -> ShowS
show :: SortingAndSlicing -> String
$cshow :: SortingAndSlicing -> String
showsPrec :: Int -> SortingAndSlicing -> ShowS
$cshowsPrec :: Int -> SortingAndSlicing -> ShowS
Show, SortingAndSlicing -> SortingAndSlicing -> Bool
(SortingAndSlicing -> SortingAndSlicing -> Bool)
-> (SortingAndSlicing -> SortingAndSlicing -> Bool)
-> Eq SortingAndSlicing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortingAndSlicing -> SortingAndSlicing -> Bool
$c/= :: SortingAndSlicing -> SortingAndSlicing -> Bool
== :: SortingAndSlicing -> SortingAndSlicing -> Bool
$c== :: 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
$cto :: forall x. Rep SortingAndSlicing x -> SortingAndSlicing
$cfrom :: forall x. SortingAndSlicing -> Rep SortingAndSlicing x
Generic)

instance Hashable SortingAndSlicing

data SelectSource = SelectSource
  { SelectSource -> Identifier
_ssPrefix :: PG.Identifier,
    SelectSource -> FromItem
_ssFrom :: PG.FromItem,
    SelectSource -> BoolExp
_ssWhere :: PG.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
$cto :: forall x. Rep SelectSource x -> SelectSource
$cfrom :: forall x. SelectSource -> Rep SelectSource x
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 PG.OrderByExp
orderByForJsonAgg :: SelectSource -> Maybe OrderByExp
orderByForJsonAgg SelectSource {Identifier
BoolExp
FromItem
SortingAndSlicing
_ssSortingAndSlicing :: SortingAndSlicing
_ssWhere :: BoolExp
_ssFrom :: FromItem
_ssPrefix :: Identifier
_ssSortingAndSlicing :: SelectSource -> SortingAndSlicing
_ssWhere :: SelectSource -> BoolExp
_ssFrom :: SelectSource -> FromItem
_ssPrefix :: SelectSource -> Identifier
..} =
  case SortingAndSlicing -> SelectSorting
_sasSorting SortingAndSlicing
_ssSortingAndSlicing of
    NoSorting {} -> Maybe OrderByExp
forall a. Maybe a
Nothing
    Sorting ASorting {Maybe (OrderByExp, Maybe DistinctExpr)
(OrderByExp, Maybe DistinctExpr)
_sortAtBase :: Maybe (OrderByExp, Maybe DistinctExpr)
_sortAtNode :: (OrderByExp, Maybe DistinctExpr)
_sortAtBase :: DistinctAndOrderByExpr -> Maybe (OrderByExp, Maybe DistinctExpr)
_sortAtNode :: DistinctAndOrderByExpr -> (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 PG.OrderByExp, SelectSlicing, Maybe PG.DistinctExpr),
    ApplySortingAndSlicing
-> (Maybe OrderByExp, SelectSlicing, Maybe DistinctExpr)
_applyAtNode :: (Maybe PG.OrderByExp, SelectSlicing, Maybe PG.DistinctExpr)
  }

applySortingAndSlicing :: SortingAndSlicing -> ApplySortingAndSlicing
applySortingAndSlicing :: SortingAndSlicing -> ApplySortingAndSlicing
applySortingAndSlicing SortingAndSlicing {SelectSorting
SelectSlicing
_sasSlicing :: SelectSlicing
_sasSorting :: SelectSorting
_sasSlicing :: SortingAndSlicing -> SelectSlicing
_sasSorting :: SortingAndSlicing -> SelectSorting
..} =
  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)
_sortAtBase :: Maybe (OrderByExp, Maybe DistinctExpr)
_sortAtNode :: (OrderByExp, Maybe DistinctExpr)
_sortAtBase :: DistinctAndOrderByExpr -> Maybe (OrderByExp, Maybe DistinctExpr)
_sortAtNode :: DistinctAndOrderByExpr -> (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 -> HashMap ColumnAlias SQLExp
_snExtractors :: HM.HashMap PG.ColumnAlias PG.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
/= :: SelectNode -> SelectNode -> Bool
$c/= :: SelectNode -> SelectNode -> Bool
== :: SelectNode -> SelectNode -> Bool
$c== :: SelectNode -> SelectNode -> Bool
Eq)

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

data ObjectSelectSource = ObjectSelectSource
  { ObjectSelectSource -> Identifier
_ossPrefix :: PG.Identifier,
    ObjectSelectSource -> FromItem
_ossFrom :: PG.FromItem,
    ObjectSelectSource -> BoolExp
_ossWhere :: PG.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
showList :: [ObjectSelectSource] -> ShowS
$cshowList :: [ObjectSelectSource] -> ShowS
show :: ObjectSelectSource -> String
$cshow :: ObjectSelectSource -> String
showsPrec :: Int -> ObjectSelectSource -> ShowS
$cshowsPrec :: Int -> ObjectSelectSource -> ShowS
Show, ObjectSelectSource -> ObjectSelectSource -> Bool
(ObjectSelectSource -> ObjectSelectSource -> Bool)
-> (ObjectSelectSource -> ObjectSelectSource -> Bool)
-> Eq ObjectSelectSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectSelectSource -> ObjectSelectSource -> Bool
$c/= :: ObjectSelectSource -> ObjectSelectSource -> Bool
== :: ObjectSelectSource -> ObjectSelectSource -> Bool
$c== :: 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
$cto :: forall x. Rep ObjectSelectSource x -> ObjectSelectSource
$cfrom :: forall x. ObjectSelectSource -> Rep ObjectSelectSource x
Generic)

instance Hashable ObjectSelectSource

objectSelectSourceToSelectSource :: ObjectSelectSource -> SelectSource
objectSelectSourceToSelectSource :: ObjectSelectSource -> SelectSource
objectSelectSourceToSelectSource ObjectSelectSource {Identifier
BoolExp
FromItem
_ossWhere :: BoolExp
_ossFrom :: FromItem
_ossPrefix :: Identifier
_ossWhere :: ObjectSelectSource -> BoolExp
_ossFrom :: ObjectSelectSource -> FromItem
_ossPrefix :: ObjectSelectSource -> Identifier
..} =
  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 :: HM.HashMap PG.PGCol PG.PGCol,
    ObjectRelationSource -> ObjectSelectSource
_orsSelectSource :: ObjectSelectSource
  }
  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
$cto :: forall x. Rep ObjectRelationSource x -> ObjectRelationSource
$cfrom :: forall x. ObjectRelationSource -> Rep ObjectRelationSource x
Generic)

instance Hashable ObjectRelationSource

deriving instance Eq ObjectRelationSource

data ArrayRelationSource = ArrayRelationSource
  { ArrayRelationSource -> TableAlias
_arsAlias :: PG.TableAlias,
    ArrayRelationSource -> HashMap PGCol PGCol
_arsRelationMapping :: HM.HashMap PG.PGCol PG.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
$cto :: forall x. Rep ArrayRelationSource x -> ArrayRelationSource
$cfrom :: forall x. ArrayRelationSource -> Rep ArrayRelationSource x
Generic)

instance Hashable ArrayRelationSource

deriving instance Eq ArrayRelationSource

data MultiRowSelectNode = MultiRowSelectNode
  { MultiRowSelectNode -> [Extractor]
_mrsnTopExtractors :: [PG.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
/= :: MultiRowSelectNode -> MultiRowSelectNode -> Bool
$c/= :: MultiRowSelectNode -> MultiRowSelectNode -> Bool
== :: MultiRowSelectNode -> MultiRowSelectNode -> Bool
$c== :: MultiRowSelectNode -> MultiRowSelectNode -> Bool
Eq)

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
$cto :: forall x.
Rep ComputedFieldTableSetSource x -> ComputedFieldTableSetSource
$cfrom :: forall x.
ComputedFieldTableSetSource -> Rep ComputedFieldTableSetSource x
Generic)

instance Hashable ComputedFieldTableSetSource

deriving instance Show ComputedFieldTableSetSource

deriving instance Eq ComputedFieldTableSetSource

data ArrayConnectionSource = ArrayConnectionSource
  { ArrayConnectionSource -> TableAlias
_acsAlias :: PG.TableAlias,
    ArrayConnectionSource -> HashMap PGCol PGCol
_acsRelationMapping :: HM.HashMap PG.PGCol PG.PGCol,
    ArrayConnectionSource -> Maybe BoolExp
_acsSplitFilter :: Maybe PG.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
$cto :: forall x. Rep ArrayConnectionSource x -> ArrayConnectionSource
$cfrom :: forall x. ArrayConnectionSource -> Rep ArrayConnectionSource x
Generic)

deriving instance Eq ArrayConnectionSource

instance Hashable ArrayConnectionSource

data JoinTree = JoinTree
  { JoinTree -> HashMap ObjectRelationSource SelectNode
_jtObjectRelations :: HM.HashMap ObjectRelationSource SelectNode,
    JoinTree -> HashMap ArrayRelationSource MultiRowSelectNode
_jtArrayRelations :: HM.HashMap ArrayRelationSource MultiRowSelectNode,
    JoinTree -> HashMap ArrayConnectionSource MultiRowSelectNode
_jtArrayConnections :: HM.HashMap ArrayConnectionSource MultiRowSelectNode,
    JoinTree -> HashMap ComputedFieldTableSetSource MultiRowSelectNode
_jtComputedFieldTableSets :: HM.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
/= :: JoinTree -> JoinTree -> Bool
$c/= :: JoinTree -> JoinTree -> Bool
== :: JoinTree -> JoinTree -> Bool
$c== :: JoinTree -> JoinTree -> Bool
Eq)

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
HM.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
HM.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
HM.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
HM.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
showList :: [PermissionLimitSubQuery] -> ShowS
$cshowList :: [PermissionLimitSubQuery] -> ShowS
show :: PermissionLimitSubQuery -> String
$cshow :: PermissionLimitSubQuery -> String
showsPrec :: Int -> PermissionLimitSubQuery -> ShowS
$cshowsPrec :: Int -> PermissionLimitSubQuery -> ShowS
Show, PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool
(PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool)
-> (PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool)
-> Eq PermissionLimitSubQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool
$c/= :: PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool
== :: PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool
$c== :: PermissionLimitSubQuery -> PermissionLimitSubQuery -> Bool
Eq)

type SimilarArrayFields = HM.HashMap FieldName [FieldName]