module Hasura.RQL.DML.Select
( runSelect,
)
where
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.HashMap.Strict qualified as HM
import Data.List.NonEmpty qualified as NE
import Data.Sequence qualified as DS
import Data.Text.Extended
import Database.PG.Query qualified as Q
import Hasura.Backends.Postgres.Connection.MonadTx
import Hasura.Backends.Postgres.Execute.Types
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.SQL.Types hiding (TableName)
import Hasura.Backends.Postgres.Translate.Select
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.DML.Internal
import Hasura.RQL.DML.Types
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.OrderBy
import Hasura.RQL.IR.Select
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
import Hasura.SQL.Types
import Hasura.Server.Types
import Hasura.Session
import Hasura.Tracing qualified as Tracing
type SelectQExt = SelectG (ExtCol ('Postgres 'Vanilla)) (BoolExp ('Postgres 'Vanilla)) Int
data ExtCol (b :: BackendType)
= ECSimple (Column b)
| ECRel RelName (Maybe RelName) SelectQExt
convSelCol ::
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
SelPermInfo ('Postgres 'Vanilla) ->
SelCol ->
m [ExtCol ('Postgres 'Vanilla)]
convSelCol :: FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelCol
-> m [ExtCol ('Postgres 'Vanilla)]
convSelCol FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
_ SelPermInfo ('Postgres 'Vanilla)
_ (SCExtSimple PGCol
cn) =
[ExtCol ('Postgres 'Vanilla)] -> m [ExtCol ('Postgres 'Vanilla)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Column ('Postgres 'Vanilla) -> ExtCol ('Postgres 'Vanilla)
forall (b :: BackendType). Column b -> ExtCol b
ECSimple Column ('Postgres 'Vanilla)
PGCol
cn]
convSelCol FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
_ (SCExtRel RelName
rn Maybe RelName
malias SelectQ
selQ) = do
let pgWhenRelErr :: Text
pgWhenRelErr = Text
"only relationships can be expanded"
RelInfo ('Postgres 'Vanilla)
relInfo <-
Text
-> m (RelInfo ('Postgres 'Vanilla))
-> m (RelInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"name" (m (RelInfo ('Postgres 'Vanilla))
-> m (RelInfo ('Postgres 'Vanilla)))
-> m (RelInfo ('Postgres 'Vanilla))
-> m (RelInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> RelName -> Text -> m (RelInfo ('Postgres 'Vanilla))
forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> RelName -> Text -> m (RelInfo backend)
askRelType FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap RelName
rn Text
pgWhenRelErr
let (RelInfo RelName
_ RelType
_ HashMap (Column ('Postgres 'Vanilla)) (Column ('Postgres 'Vanilla))
_ TableName ('Postgres 'Vanilla)
relTab Bool
_ InsertOrder
_) = RelInfo ('Postgres 'Vanilla)
relInfo
(FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
rfim, SelPermInfo ('Postgres 'Vanilla)
rspi) <- RelName
-> TableName ('Postgres 'Vanilla)
-> m (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
RelName
-> TableName ('Postgres 'Vanilla)
-> m (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
fetchRelDet RelName
rn TableName ('Postgres 'Vanilla)
relTab
SelectQExt
resolvedSelQ <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla) -> SelectQ -> m SelectQExt
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla) -> SelectQ -> m SelectQExt
resolveStar FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
rfim SelPermInfo ('Postgres 'Vanilla)
rspi SelectQ
selQ
[ExtCol ('Postgres 'Vanilla)] -> m [ExtCol ('Postgres 'Vanilla)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [RelName
-> Maybe RelName -> SelectQExt -> ExtCol ('Postgres 'Vanilla)
forall (b :: BackendType).
RelName -> Maybe RelName -> SelectQExt -> ExtCol b
ECRel RelName
rn Maybe RelName
malias SelectQExt
resolvedSelQ]
convSelCol FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
spi (SCStar Wildcard
wildcard) =
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
convWildcard FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
spi Wildcard
wildcard
convWildcard ::
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
SelPermInfo ('Postgres 'Vanilla) ->
Wildcard ->
m [ExtCol ('Postgres 'Vanilla)]
convWildcard :: FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
convWildcard FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
selPermInfo Wildcard
wildcard =
case Wildcard
wildcard of
Wildcard
Star -> [ExtCol ('Postgres 'Vanilla)] -> m [ExtCol ('Postgres 'Vanilla)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ExtCol ('Postgres 'Vanilla)]
simpleCols
(StarDot Wildcard
wc) -> ([ExtCol ('Postgres 'Vanilla)]
simpleCols [ExtCol ('Postgres 'Vanilla)]
-> [ExtCol ('Postgres 'Vanilla)] -> [ExtCol ('Postgres 'Vanilla)]
forall a. [a] -> [a] -> [a]
++) ([ExtCol ('Postgres 'Vanilla)] -> [ExtCol ('Postgres 'Vanilla)])
-> m [ExtCol ('Postgres 'Vanilla)]
-> m [ExtCol ('Postgres 'Vanilla)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Maybe (ExtCol ('Postgres 'Vanilla))]
-> [ExtCol ('Postgres 'Vanilla)]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes ([Maybe (ExtCol ('Postgres 'Vanilla))]
-> [ExtCol ('Postgres 'Vanilla)])
-> m [Maybe (ExtCol ('Postgres 'Vanilla))]
-> m [ExtCol ('Postgres 'Vanilla)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wildcard -> m [Maybe (ExtCol ('Postgres 'Vanilla))]
relExtCols Wildcard
wc)
where
cols :: HashMap
(Column ('Postgres 'Vanilla))
(Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
cols = SelPermInfo ('Postgres 'Vanilla)
-> HashMap
(Column ('Postgres 'Vanilla))
(Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
forall (b :: BackendType).
SelPermInfo b
-> HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b))
spiCols SelPermInfo ('Postgres 'Vanilla)
selPermInfo
pgCols :: [PGCol]
pgCols = (ColumnInfo ('Postgres 'Vanilla) -> PGCol)
-> [ColumnInfo ('Postgres 'Vanilla)] -> [PGCol]
forall a b. (a -> b) -> [a] -> [b]
map ColumnInfo ('Postgres 'Vanilla) -> PGCol
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ([ColumnInfo ('Postgres 'Vanilla)] -> [PGCol])
-> [ColumnInfo ('Postgres 'Vanilla)] -> [PGCol]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [ColumnInfo ('Postgres 'Vanilla)]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [ColumnInfo backend]
getCols FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap
relColInfos :: [RelInfo ('Postgres 'Vanilla)]
relColInfos = FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [RelInfo ('Postgres 'Vanilla)]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [RelInfo backend]
getRels FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap
simpleCols :: [ExtCol ('Postgres 'Vanilla)]
simpleCols = (PGCol -> ExtCol ('Postgres 'Vanilla))
-> [PGCol] -> [ExtCol ('Postgres 'Vanilla)]
forall a b. (a -> b) -> [a] -> [b]
map PGCol -> ExtCol ('Postgres 'Vanilla)
forall (b :: BackendType). Column b -> ExtCol b
ECSimple ([PGCol] -> [ExtCol ('Postgres 'Vanilla)])
-> [PGCol] -> [ExtCol ('Postgres 'Vanilla)]
forall a b. (a -> b) -> a -> b
$ (PGCol -> Bool) -> [PGCol] -> [PGCol]
forall a. (a -> Bool) -> [a] -> [a]
filter (PGCol
-> HashMap
PGCol (Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
-> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HM.member` HashMap
(Column ('Postgres 'Vanilla))
(Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
HashMap
PGCol (Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
cols) [PGCol]
pgCols
mkRelCol :: Wildcard -> RelInfo b -> m (Maybe (ExtCol b))
mkRelCol Wildcard
wc RelInfo b
relInfo = do
let relName :: RelName
relName = RelInfo b -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo b
relInfo
relTab :: TableName b
relTab = RelInfo b -> TableName b
forall (b :: BackendType). RelInfo b -> TableName b
riRTable RelInfo b
relInfo
TableInfo ('Postgres 'Vanilla)
relTabInfo <- TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
fetchRelTabInfo TableName b
TableName ('Postgres 'Vanilla)
relTab
Maybe (SelPermInfo ('Postgres 'Vanilla))
mRelSelPerm <- Lens'
(RolePermInfo ('Postgres 'Vanilla))
(Maybe (SelPermInfo ('Postgres 'Vanilla)))
-> TableInfo ('Postgres 'Vanilla)
-> m (Maybe (SelPermInfo ('Postgres 'Vanilla)))
forall (m :: * -> *) c.
UserInfoM m =>
Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla) -> m (Maybe c)
askPermInfo forall (b :: BackendType).
Lens' (RolePermInfo b) (Maybe (SelPermInfo b))
Lens'
(RolePermInfo ('Postgres 'Vanilla))
(Maybe (SelPermInfo ('Postgres 'Vanilla)))
permSel TableInfo ('Postgres 'Vanilla)
relTabInfo
Maybe (SelPermInfo ('Postgres 'Vanilla))
-> (SelPermInfo ('Postgres 'Vanilla) -> m (ExtCol b))
-> m (Maybe (ExtCol b))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (SelPermInfo ('Postgres 'Vanilla))
mRelSelPerm ((SelPermInfo ('Postgres 'Vanilla) -> m (ExtCol b))
-> m (Maybe (ExtCol b)))
-> (SelPermInfo ('Postgres 'Vanilla) -> m (ExtCol b))
-> m (Maybe (ExtCol b))
forall a b. (a -> b) -> a -> b
$ \SelPermInfo ('Postgres 'Vanilla)
relSelPermInfo -> do
[ExtCol ('Postgres 'Vanilla)]
rExtCols <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
convWildcard (TableCoreInfoG
('Postgres 'Vanilla)
(FieldInfo ('Postgres 'Vanilla))
(ColumnInfo ('Postgres 'Vanilla))
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap (TableCoreInfoG
('Postgres 'Vanilla)
(FieldInfo ('Postgres 'Vanilla))
(ColumnInfo ('Postgres 'Vanilla))
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla)))
-> TableCoreInfoG
('Postgres 'Vanilla)
(FieldInfo ('Postgres 'Vanilla))
(ColumnInfo ('Postgres 'Vanilla))
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ TableInfo ('Postgres 'Vanilla)
-> TableCoreInfoG
('Postgres 'Vanilla)
(FieldInfo ('Postgres 'Vanilla))
(ColumnInfo ('Postgres 'Vanilla))
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo ('Postgres 'Vanilla)
relTabInfo) SelPermInfo ('Postgres 'Vanilla)
relSelPermInfo Wildcard
wc
ExtCol b -> m (ExtCol b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExtCol b -> m (ExtCol b)) -> ExtCol b -> m (ExtCol b)
forall a b. (a -> b) -> a -> b
$
RelName -> Maybe RelName -> SelectQExt -> ExtCol b
forall (b :: BackendType).
RelName -> Maybe RelName -> SelectQExt -> ExtCol b
ECRel RelName
relName Maybe RelName
forall a. Maybe a
Nothing (SelectQExt -> ExtCol b) -> SelectQExt -> ExtCol b
forall a b. (a -> b) -> a -> b
$
[ExtCol ('Postgres 'Vanilla)]
-> Maybe (BoolExp ('Postgres 'Vanilla))
-> Maybe OrderByExp
-> Maybe Int
-> Maybe Int
-> SelectQExt
forall a b c.
[a]
-> Maybe b
-> Maybe OrderByExp
-> Maybe c
-> Maybe c
-> SelectG a b c
SelectG [ExtCol ('Postgres 'Vanilla)]
rExtCols Maybe (BoolExp ('Postgres 'Vanilla))
forall a. Maybe a
Nothing Maybe OrderByExp
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing
relExtCols :: Wildcard -> m [Maybe (ExtCol ('Postgres 'Vanilla))]
relExtCols Wildcard
wc = (RelInfo ('Postgres 'Vanilla)
-> m (Maybe (ExtCol ('Postgres 'Vanilla))))
-> [RelInfo ('Postgres 'Vanilla)]
-> m [Maybe (ExtCol ('Postgres 'Vanilla))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Wildcard
-> RelInfo ('Postgres 'Vanilla)
-> m (Maybe (ExtCol ('Postgres 'Vanilla)))
forall (m :: * -> *) (b :: BackendType) (b :: BackendType).
(MonadError QErr m, TableInfoRM ('Postgres 'Vanilla) m,
UserInfoM m, TableName b ~ QualifiedTable) =>
Wildcard -> RelInfo b -> m (Maybe (ExtCol b))
mkRelCol Wildcard
wc) [RelInfo ('Postgres 'Vanilla)]
relColInfos
resolveStar ::
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
SelPermInfo ('Postgres 'Vanilla) ->
SelectQ ->
m SelectQExt
resolveStar :: FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla) -> SelectQ -> m SelectQExt
resolveStar FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fim SelPermInfo ('Postgres 'Vanilla)
selPermInfo (SelectG [SelCol]
selCols Maybe (BoolExp ('Postgres 'Vanilla))
mWh Maybe OrderByExp
mOb Maybe Int
mLt Maybe Int
mOf) = do
[ExtCol ('Postgres 'Vanilla)]
procOverrides <- ([Maybe [ExtCol ('Postgres 'Vanilla)]]
-> [ExtCol ('Postgres 'Vanilla)])
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> m [ExtCol ('Postgres 'Vanilla)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([[ExtCol ('Postgres 'Vanilla)]] -> [ExtCol ('Postgres 'Vanilla)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ExtCol ('Postgres 'Vanilla)]] -> [ExtCol ('Postgres 'Vanilla)])
-> ([Maybe [ExtCol ('Postgres 'Vanilla)]]
-> [[ExtCol ('Postgres 'Vanilla)]])
-> [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> [ExtCol ('Postgres 'Vanilla)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> [[ExtCol ('Postgres 'Vanilla)]]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes) (m [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> m [ExtCol ('Postgres 'Vanilla)])
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> m [ExtCol ('Postgres 'Vanilla)]
forall a b. (a -> b) -> a -> b
$
Text
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"columns" (m [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]])
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
forall a b. (a -> b) -> a -> b
$
[SelCol]
-> (SelCol -> m (Maybe [ExtCol ('Postgres 'Vanilla)]))
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
forall (m :: * -> *) a b. QErrM m => [a] -> (a -> m b) -> m [b]
indexedForM [SelCol]
selCols ((SelCol -> m (Maybe [ExtCol ('Postgres 'Vanilla)]))
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]])
-> (SelCol -> m (Maybe [ExtCol ('Postgres 'Vanilla)]))
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
forall a b. (a -> b) -> a -> b
$ \SelCol
selCol -> case SelCol
selCol of
(SCStar Wildcard
_) -> Maybe [ExtCol ('Postgres 'Vanilla)]
-> m (Maybe [ExtCol ('Postgres 'Vanilla)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [ExtCol ('Postgres 'Vanilla)]
forall a. Maybe a
Nothing
SelCol
_ -> [ExtCol ('Postgres 'Vanilla)]
-> Maybe [ExtCol ('Postgres 'Vanilla)]
forall a. a -> Maybe a
Just ([ExtCol ('Postgres 'Vanilla)]
-> Maybe [ExtCol ('Postgres 'Vanilla)])
-> m [ExtCol ('Postgres 'Vanilla)]
-> m (Maybe [ExtCol ('Postgres 'Vanilla)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelCol
-> m [ExtCol ('Postgres 'Vanilla)]
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelCol
-> m [ExtCol ('Postgres 'Vanilla)]
convSelCol FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fim SelPermInfo ('Postgres 'Vanilla)
selPermInfo SelCol
selCol
[ExtCol ('Postgres 'Vanilla)]
everything <- case [Wildcard]
wildcards of
[] -> [ExtCol ('Postgres 'Vanilla)] -> m [ExtCol ('Postgres 'Vanilla)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
[Wildcard]
_ -> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
convWildcard FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fim SelPermInfo ('Postgres 'Vanilla)
selPermInfo (Wildcard -> m [ExtCol ('Postgres 'Vanilla)])
-> Wildcard -> m [ExtCol ('Postgres 'Vanilla)]
forall a b. (a -> b) -> a -> b
$ [Wildcard] -> Wildcard
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Wildcard]
wildcards
let extCols :: [ExtCol ('Postgres 'Vanilla)]
extCols = (ExtCol ('Postgres 'Vanilla)
-> ExtCol ('Postgres 'Vanilla) -> Bool)
-> [ExtCol ('Postgres 'Vanilla)]
-> [ExtCol ('Postgres 'Vanilla)]
-> [ExtCol ('Postgres 'Vanilla)]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
unionBy ExtCol ('Postgres 'Vanilla) -> ExtCol ('Postgres 'Vanilla) -> Bool
forall (b :: BackendType) (b :: BackendType).
(Eq (Column b), Column b ~ Column b) =>
ExtCol b -> ExtCol b -> Bool
equals [ExtCol ('Postgres 'Vanilla)]
procOverrides [ExtCol ('Postgres 'Vanilla)]
everything
SelectQExt -> m SelectQExt
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SelectQExt -> m SelectQExt) -> SelectQExt -> m SelectQExt
forall a b. (a -> b) -> a -> b
$ [ExtCol ('Postgres 'Vanilla)]
-> Maybe (BoolExp ('Postgres 'Vanilla))
-> Maybe OrderByExp
-> Maybe Int
-> Maybe Int
-> SelectQExt
forall a b c.
[a]
-> Maybe b
-> Maybe OrderByExp
-> Maybe c
-> Maybe c
-> SelectG a b c
SelectG [ExtCol ('Postgres 'Vanilla)]
extCols Maybe (BoolExp ('Postgres 'Vanilla))
mWh Maybe OrderByExp
mOb Maybe Int
mLt Maybe Int
mOf
where
wildcards :: [Wildcard]
wildcards = [Either Wildcard SelCol] -> [Wildcard]
forall a b. [Either a b] -> [a]
lefts ([Either Wildcard SelCol] -> [Wildcard])
-> [Either Wildcard SelCol] -> [Wildcard]
forall a b. (a -> b) -> a -> b
$ (SelCol -> Either Wildcard SelCol)
-> [SelCol] -> [Either Wildcard SelCol]
forall a b. (a -> b) -> [a] -> [b]
map SelCol -> Either Wildcard SelCol
mkEither [SelCol]
selCols
mkEither :: SelCol -> Either Wildcard SelCol
mkEither (SCStar Wildcard
wc) = Wildcard -> Either Wildcard SelCol
forall a b. a -> Either a b
Left Wildcard
wc
mkEither SelCol
selCol = SelCol -> Either Wildcard SelCol
forall a b. b -> Either a b
Right SelCol
selCol
equals :: ExtCol b -> ExtCol b -> Bool
equals (ECSimple Column b
x) (ECSimple Column b
y) = Column b
Column b
x Column b -> Column b -> Bool
forall a. Eq a => a -> a -> Bool
== Column b
y
equals (ECRel RelName
x Maybe RelName
_ SelectQExt
_) (ECRel RelName
y Maybe RelName
_ SelectQExt
_) = RelName
x RelName -> RelName -> Bool
forall a. Eq a => a -> a -> Bool
== RelName
y
equals ExtCol b
_ ExtCol b
_ = Bool
False
convOrderByElem ::
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SessionVariableBuilder m ->
(FieldInfoMap (FieldInfo ('Postgres 'Vanilla)), SelPermInfo ('Postgres 'Vanilla)) ->
OrderByCol ->
m (AnnotatedOrderByElement ('Postgres 'Vanilla) S.SQLExp)
convOrderByElem :: SessionVariableBuilder m
-> (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
-> OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
convOrderByElem SessionVariableBuilder m
sessVarBldr (FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
flds, SelPermInfo ('Postgres 'Vanilla)
spi) = \case
OCPG FieldName
fldName -> do
FieldInfo ('Postgres 'Vanilla)
fldInfo <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> FieldName -> m (FieldInfo ('Postgres 'Vanilla))
forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
flds FieldName
fldName
case FieldInfo ('Postgres 'Vanilla)
fldInfo of
FIColumn ColumnInfo ('Postgres 'Vanilla)
colInfo -> do
SelPermInfo ('Postgres 'Vanilla)
-> Column ('Postgres 'Vanilla) -> m ()
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
SelPermInfo ('Postgres 'Vanilla)
-> Column ('Postgres 'Vanilla) -> m ()
checkSelOnCol SelPermInfo ('Postgres 'Vanilla)
spi (ColumnInfo ('Postgres 'Vanilla) -> Column ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres 'Vanilla)
colInfo)
let ty :: ColumnType ('Postgres 'Vanilla)
ty = ColumnInfo ('Postgres 'Vanilla) -> ColumnType ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo ('Postgres 'Vanilla)
colInfo
if (ScalarType ('Postgres 'Vanilla) -> Bool)
-> ColumnType ('Postgres 'Vanilla) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere ScalarType ('Postgres 'Vanilla) -> Bool
PGScalarType -> Bool
isGeoType ColumnType ('Postgres 'Vanilla)
ty
then
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload (Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$
FieldName
fldName FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has type 'geometry' and cannot be used in order_by"
else AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ ColumnInfo ('Postgres 'Vanilla)
-> AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
ColumnInfo b -> AnnotatedOrderByElement b v
AOCColumn ColumnInfo ('Postgres 'Vanilla)
colInfo
FIRelationship RelInfo ('Postgres 'Vanilla)
_ ->
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload (Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$
FieldName
fldName FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a relationship and should be expanded"
FIComputedField ComputedFieldInfo ('Postgres 'Vanilla)
_ ->
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload (Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$
FieldName
fldName FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a computed field and can't be used in 'order_by'"
FIRemoteRelationship {} ->
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload (FieldName
fldName FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a remote field")
OCRel FieldName
fldName OrderByCol
rest -> do
FieldInfo ('Postgres 'Vanilla)
fldInfo <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> FieldName -> m (FieldInfo ('Postgres 'Vanilla))
forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
flds FieldName
fldName
case FieldInfo ('Postgres 'Vanilla)
fldInfo of
FIColumn ColumnInfo ('Postgres 'Vanilla)
_ ->
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload (Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$
FieldName
fldName FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a Postgres column and cannot be chained further"
FIComputedField ComputedFieldInfo ('Postgres 'Vanilla)
_ ->
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload (Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$
FieldName
fldName FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a computed field and can't be used in 'order_by'"
FIRelationship RelInfo ('Postgres 'Vanilla)
relInfo -> do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RelInfo ('Postgres 'Vanilla) -> RelType
forall (b :: BackendType). RelInfo b -> RelType
riType RelInfo ('Postgres 'Vanilla)
relInfo RelType -> RelType -> Bool
forall a. Eq a => a -> a -> Bool
== RelType
ArrRel) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
FieldName
fldName FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is an array relationship and can't be used in 'order_by'"
(FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
relFim, SelPermInfo ('Postgres 'Vanilla)
relSelPermInfo) <- RelName
-> TableName ('Postgres 'Vanilla)
-> m (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
RelName
-> TableName ('Postgres 'Vanilla)
-> m (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
fetchRelDet (RelInfo ('Postgres 'Vanilla) -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo ('Postgres 'Vanilla)
relInfo) (RelInfo ('Postgres 'Vanilla) -> TableName ('Postgres 'Vanilla)
forall (b :: BackendType). RelInfo b -> TableName b
riRTable RelInfo ('Postgres 'Vanilla)
relInfo)
AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedSelFltr <- SessionVariableBuilder m
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('Postgres 'Vanilla))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnBoolExpSQL ('Postgres 'Vanilla))
convAnnBoolExpPartialSQL SessionVariableBuilder m
sessVarBldr (AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('Postgres 'Vanilla)))
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ SelPermInfo ('Postgres 'Vanilla)
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
forall (b :: BackendType). SelPermInfo b -> AnnBoolExpPartialSQL b
spiFilter SelPermInfo ('Postgres 'Vanilla)
relSelPermInfo
RelInfo ('Postgres 'Vanilla)
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
-> AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
RelInfo b
-> AnnBoolExp b v
-> AnnotatedOrderByElement b v
-> AnnotatedOrderByElement b v
AOCObjectRelation RelInfo ('Postgres 'Vanilla)
relInfo AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedSelFltr (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
-> AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SessionVariableBuilder m
-> (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
-> OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SessionVariableBuilder m
-> (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
-> OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
convOrderByElem SessionVariableBuilder m
sessVarBldr (FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
relFim, SelPermInfo ('Postgres 'Vanilla)
relSelPermInfo) OrderByCol
rest
FIRemoteRelationship {} ->
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload (FieldName
fldName FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a remote field")
convSelectQ ::
( UserInfoM m,
QErrM m,
TableInfoRM ('Postgres 'Vanilla) m,
HasServerConfigCtx m
) =>
TableName ('Postgres 'Vanilla) ->
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
SelPermInfo ('Postgres 'Vanilla) ->
SelectQExt ->
SessionVariableBuilder m ->
ValueParser ('Postgres 'Vanilla) m S.SQLExp ->
m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQ :: TableName ('Postgres 'Vanilla)
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQ TableName ('Postgres 'Vanilla)
table FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
selPermInfo SelectQExt
selQ SessionVariableBuilder m
sessVarBldr ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr = do
Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
wClause <- Maybe (BoolExp ('Postgres 'Vanilla))
-> (BoolExp ('Postgres 'Vanilla)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
-> m (Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (SelectQExt -> Maybe (BoolExp ('Postgres 'Vanilla))
forall a b c. SelectG a b c -> Maybe b
sqWhere SelectQExt
selQ) ((BoolExp ('Postgres 'Vanilla)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
-> m (Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)))
-> (BoolExp ('Postgres 'Vanilla)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
-> m (Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
forall a b. (a -> b) -> a -> b
$ \BoolExp ('Postgres 'Vanilla)
boolExp ->
Text
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"where" (m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> BoolExp ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> TableName ('Postgres 'Vanilla)
-> ValueParser
('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
-> m (AnnBoolExpSQL ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> BoolExp ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> TableName ('Postgres 'Vanilla)
-> ValueParser
('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
-> m (AnnBoolExpSQL ('Postgres 'Vanilla))
convBoolExp FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
selPermInfo BoolExp ('Postgres 'Vanilla)
boolExp SessionVariableBuilder m
sessVarBldr TableName ('Postgres 'Vanilla)
table ValueParser
('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr
[(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
annFlds <- Text
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"columns" (m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)])
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
forall a b. (a -> b) -> a -> b
$
[ExtCol ('Postgres 'Vanilla)]
-> (ExtCol ('Postgres 'Vanilla)
-> m (FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp))
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
forall (m :: * -> *) a b. QErrM m => [a] -> (a -> m b) -> m [b]
indexedForM (SelectQExt -> [ExtCol ('Postgres 'Vanilla)]
forall a b c. SelectG a b c -> [a]
sqColumns SelectQExt
selQ) ((ExtCol ('Postgres 'Vanilla)
-> m (FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp))
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)])
-> (ExtCol ('Postgres 'Vanilla)
-> m (FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp))
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
forall a b. (a -> b) -> a -> b
$ \case
(ECSimple Column ('Postgres 'Vanilla)
pgCol) -> do
(ColumnInfo ('Postgres 'Vanilla)
colInfo, Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla))
caseBoolExpMaybe) <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> PGCol
-> m (ColumnInfo ('Postgres 'Vanilla),
Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> PGCol
-> m (ColumnInfo ('Postgres 'Vanilla),
Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
convExtSimple FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
selPermInfo Column ('Postgres 'Vanilla)
PGCol
pgCol
Maybe (AnnColumnCaseBoolExp ('Postgres 'Vanilla) SQLExp)
resolvedCaseBoolExp <-
(AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnColumnCaseBoolExp ('Postgres 'Vanilla) SQLExp))
-> Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla))
-> m (Maybe (AnnColumnCaseBoolExp ('Postgres 'Vanilla) SQLExp))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (SessionVariableBuilder m
-> AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnColumnCaseBoolExp
('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnColumnCaseBoolExp
('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
convAnnColumnCaseBoolExpPartialSQL SessionVariableBuilder m
sessVarBldr) Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla))
caseBoolExpMaybe
(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)
-> m (FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column ('Postgres 'Vanilla) -> FieldName
forall (b :: BackendType). Backend b => Column b -> FieldName
fromCol @('Postgres 'Vanilla) Column ('Postgres 'Vanilla)
pgCol, Column ('Postgres 'Vanilla)
-> ColumnType ('Postgres 'Vanilla)
-> Maybe (AnnColumnCaseBoolExp ('Postgres 'Vanilla) SQLExp)
-> Maybe (ScalarSelectionArguments ('Postgres 'Vanilla))
-> AnnFieldG ('Postgres 'Vanilla) Void SQLExp
forall (backend :: BackendType) v r.
Column backend
-> ColumnType backend
-> Maybe (AnnColumnCaseBoolExp backend v)
-> Maybe (ScalarSelectionArguments backend)
-> AnnFieldG backend r v
mkAnnColumnField (ColumnInfo ('Postgres 'Vanilla) -> Column ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres 'Vanilla)
colInfo) (ColumnInfo ('Postgres 'Vanilla) -> ColumnType ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo ('Postgres 'Vanilla)
colInfo) Maybe (AnnColumnCaseBoolExp ('Postgres 'Vanilla) SQLExp)
resolvedCaseBoolExp Maybe (ScalarSelectionArguments ('Postgres 'Vanilla))
forall a. Maybe a
Nothing)
(ECRel RelName
relName Maybe RelName
mAlias SelectQExt
relSelQ) -> do
Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
annRel <-
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> RelName
-> Maybe RelName
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (Either
(ObjectRelationSelect ('Postgres 'Vanilla))
(ArraySelect ('Postgres 'Vanilla)))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m,
HasServerConfigCtx m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> RelName
-> Maybe RelName
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (Either
(ObjectRelationSelect ('Postgres 'Vanilla))
(ArraySelect ('Postgres 'Vanilla)))
convExtRel
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap
RelName
relName
Maybe RelName
mAlias
SelectQExt
relSelQ
SessionVariableBuilder m
sessVarBldr
ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr
(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)
-> m (FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( RelName -> FieldName
fromRel (RelName -> FieldName) -> RelName -> FieldName
forall a b. (a -> b) -> a -> b
$ RelName -> Maybe RelName -> RelName
forall a. a -> Maybe a -> a
fromMaybe RelName
relName Maybe RelName
mAlias,
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> AnnFieldG ('Postgres 'Vanilla) Void SQLExp)
-> (ArraySelectG ('Postgres 'Vanilla) Void SQLExp
-> AnnFieldG ('Postgres 'Vanilla) Void SQLExp)
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> AnnFieldG ('Postgres 'Vanilla) Void SQLExp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> AnnFieldG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) r v.
ObjectRelationSelectG b r v -> AnnFieldG b r v
AFObjectRelation ArraySelectG ('Postgres 'Vanilla) Void SQLExp
-> AnnFieldG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) r v.
ArraySelectG b r v -> AnnFieldG b r v
AFArrayRelation Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
annRel
)
Maybe
[OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
annOrdByML <- Maybe OrderByExp
-> (OrderByExp
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
-> m (Maybe
[OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (SelectQExt -> Maybe OrderByExp
forall a b c. SelectG a b c -> Maybe OrderByExp
sqOrderBy SelectQExt
selQ) ((OrderByExp
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
-> m (Maybe
[OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]))
-> (OrderByExp
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
-> m (Maybe
[OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
forall a b. (a -> b) -> a -> b
$ \(OrderByExp [OrderByItem ('Postgres 'Vanilla)]
obItems) ->
Text
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"order_by" (m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
forall a b. (a -> b) -> a -> b
$
[OrderByItem ('Postgres 'Vanilla)]
-> (OrderByItem ('Postgres 'Vanilla)
-> m (OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
forall (m :: * -> *) a b. QErrM m => [a] -> (a -> m b) -> m [b]
indexedForM [OrderByItem ('Postgres 'Vanilla)]
obItems ((OrderByItem ('Postgres 'Vanilla)
-> m (OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
-> (OrderByItem ('Postgres 'Vanilla)
-> m (OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
forall a b. (a -> b) -> a -> b
$
(OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> OrderByItem ('Postgres 'Vanilla)
-> m (OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> OrderByItem ('Postgres 'Vanilla)
-> m (OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
-> (OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> OrderByItem ('Postgres 'Vanilla)
-> m (OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
forall a b. (a -> b) -> a -> b
$
SessionVariableBuilder m
-> (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
-> OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SessionVariableBuilder m
-> (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
-> OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
convOrderByElem SessionVariableBuilder m
sessVarBldr (FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap, SelPermInfo ('Postgres 'Vanilla)
selPermInfo)
let annOrdByM :: Maybe
(NonEmpty
(OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
annOrdByM = [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
-> Maybe
(NonEmpty
(OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
-> Maybe
(NonEmpty
(OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))))
-> Maybe
[OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
-> Maybe
(NonEmpty
(OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe
[OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
annOrdByML
Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"limit" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (Int -> m ()) -> Maybe Int -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> m ()
forall (m :: * -> *). MonadError QErr m => Int -> m ()
onlyPositiveInt Maybe Int
mQueryLimit
Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"offset" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (Int -> m ()) -> Maybe Int -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> m ()
forall (m :: * -> *). MonadError QErr m => Int -> m ()
onlyPositiveInt Maybe Int
mQueryOffset
AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedSelFltr <-
SessionVariableBuilder m
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('Postgres 'Vanilla))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnBoolExpSQL ('Postgres 'Vanilla))
convAnnBoolExpPartialSQL SessionVariableBuilder m
sessVarBldr (AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('Postgres 'Vanilla)))
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$
SelPermInfo ('Postgres 'Vanilla)
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
forall (b :: BackendType). SelPermInfo b -> AnnBoolExpPartialSQL b
spiFilter SelPermInfo ('Postgres 'Vanilla)
selPermInfo
let tabFrom :: SelectFromG ('Postgres 'Vanilla) SQLExp
tabFrom = TableName ('Postgres 'Vanilla)
-> SelectFromG ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v. TableName b -> SelectFromG b v
FromTable TableName ('Postgres 'Vanilla)
table
tabPerm :: TablePermG ('Postgres 'Vanilla) SQLExp
tabPerm = AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> Maybe Int -> TablePermG ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
AnnBoolExp b v -> Maybe Int -> TablePermG b v
TablePerm AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedSelFltr Maybe Int
mPermLimit
tabArgs :: SelectArgsG ('Postgres 'Vanilla) SQLExp
tabArgs = Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> Maybe
(NonEmpty
(OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
-> Maybe Int
-> Maybe Int64
-> Maybe (NonEmpty (Column ('Postgres 'Vanilla)))
-> SelectArgsG ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
Maybe (AnnBoolExp b v)
-> Maybe (NonEmpty (AnnotatedOrderByItemG b v))
-> Maybe Int
-> Maybe Int64
-> Maybe (NonEmpty (Column b))
-> SelectArgsG b v
SelectArgs Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
wClause Maybe
(NonEmpty
(OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
annOrdByM Maybe Int
mQueryLimit (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Maybe Int -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mQueryOffset) Maybe (NonEmpty (Column ('Postgres 'Vanilla)))
forall a. Maybe a
Nothing
StringifyNumbers
strfyNum <- SQLGenCtx -> StringifyNumbers
stringifyNum (SQLGenCtx -> StringifyNumbers)
-> (ServerConfigCtx -> SQLGenCtx)
-> ServerConfigCtx
-> StringifyNumbers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerConfigCtx -> SQLGenCtx
_sccSQLGenCtx (ServerConfigCtx -> StringifyNumbers)
-> m ServerConfigCtx -> m StringifyNumbers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx
AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp))
-> AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp)
forall a b. (a -> b) -> a -> b
$ [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
-> SelectFromG ('Postgres 'Vanilla) SQLExp
-> TablePermG ('Postgres 'Vanilla) SQLExp
-> SelectArgsG ('Postgres 'Vanilla) SQLExp
-> StringifyNumbers
-> Maybe NamingCase
-> AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
forall (b :: BackendType) (f :: * -> *) v.
Fields (f v)
-> SelectFromG b v
-> TablePermG b v
-> SelectArgsG b v
-> StringifyNumbers
-> Maybe NamingCase
-> AnnSelectG b f v
AnnSelectG [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
annFlds SelectFromG ('Postgres 'Vanilla) SQLExp
tabFrom TablePermG ('Postgres 'Vanilla) SQLExp
tabPerm SelectArgsG ('Postgres 'Vanilla) SQLExp
tabArgs StringifyNumbers
strfyNum Maybe NamingCase
forall a. Maybe a
Nothing
where
mQueryOffset :: Maybe Int
mQueryOffset = SelectQExt -> Maybe Int
forall a b c. SelectG a b c -> Maybe c
sqOffset SelectQExt
selQ
mQueryLimit :: Maybe Int
mQueryLimit = SelectQExt -> Maybe Int
forall a b c. SelectG a b c -> Maybe c
sqLimit SelectQExt
selQ
mPermLimit :: Maybe Int
mPermLimit = SelPermInfo ('Postgres 'Vanilla) -> Maybe Int
forall (b :: BackendType). SelPermInfo b -> Maybe Int
spiLimit SelPermInfo ('Postgres 'Vanilla)
selPermInfo
convExtSimple ::
(UserInfoM m, QErrM m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
SelPermInfo ('Postgres 'Vanilla) ->
PGCol ->
m (ColumnInfo ('Postgres 'Vanilla), Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
convExtSimple :: FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> PGCol
-> m (ColumnInfo ('Postgres 'Vanilla),
Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
convExtSimple FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
selPermInfo PGCol
pgCol = do
SelPermInfo ('Postgres 'Vanilla)
-> Column ('Postgres 'Vanilla) -> m ()
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
SelPermInfo ('Postgres 'Vanilla)
-> Column ('Postgres 'Vanilla) -> m ()
checkSelOnCol SelPermInfo ('Postgres 'Vanilla)
selPermInfo Column ('Postgres 'Vanilla)
PGCol
pgCol
ColumnInfo ('Postgres 'Vanilla)
colInfo <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> Column ('Postgres 'Vanilla)
-> Text
-> m (ColumnInfo ('Postgres 'Vanilla))
forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnInfo backend)
askColInfo FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap Column ('Postgres 'Vanilla)
PGCol
pgCol Text
relWhenPGErr
(ColumnInfo ('Postgres 'Vanilla),
Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
-> m (ColumnInfo ('Postgres 'Vanilla),
Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColumnInfo ('Postgres 'Vanilla)
colInfo, Maybe (Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
-> Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe
(Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
-> Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
-> Maybe
(Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
-> Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ PGCol
-> HashMap
PGCol (Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
-> Maybe
(Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup PGCol
pgCol (SelPermInfo ('Postgres 'Vanilla)
-> HashMap
(Column ('Postgres 'Vanilla))
(Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
forall (b :: BackendType).
SelPermInfo b
-> HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b))
spiCols SelPermInfo ('Postgres 'Vanilla)
selPermInfo))
where
relWhenPGErr :: Text
relWhenPGErr = Text
"relationships have to be expanded"
convExtRel ::
( UserInfoM m,
QErrM m,
TableInfoRM ('Postgres 'Vanilla) m,
HasServerConfigCtx m
) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
RelName ->
Maybe RelName ->
SelectQExt ->
SessionVariableBuilder m ->
ValueParser ('Postgres 'Vanilla) m S.SQLExp ->
m (Either (ObjectRelationSelect ('Postgres 'Vanilla)) (ArraySelect ('Postgres 'Vanilla)))
convExtRel :: FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> RelName
-> Maybe RelName
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (Either
(ObjectRelationSelect ('Postgres 'Vanilla))
(ArraySelect ('Postgres 'Vanilla)))
convExtRel FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap RelName
relName Maybe RelName
mAlias SelectQExt
selQ SessionVariableBuilder m
sessVarBldr ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr = do
RelInfo ('Postgres 'Vanilla)
relInfo <-
Text
-> m (RelInfo ('Postgres 'Vanilla))
-> m (RelInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"name" (m (RelInfo ('Postgres 'Vanilla))
-> m (RelInfo ('Postgres 'Vanilla)))
-> m (RelInfo ('Postgres 'Vanilla))
-> m (RelInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> RelName -> Text -> m (RelInfo ('Postgres 'Vanilla))
forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> RelName -> Text -> m (RelInfo backend)
askRelType FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap RelName
relName Text
pgWhenRelErr
let (RelInfo RelName
_ RelType
relTy HashMap (Column ('Postgres 'Vanilla)) (Column ('Postgres 'Vanilla))
colMapping TableName ('Postgres 'Vanilla)
relTab Bool
_ InsertOrder
_) = RelInfo ('Postgres 'Vanilla)
relInfo
(FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
relCIM, SelPermInfo ('Postgres 'Vanilla)
relSPI) <- RelName
-> TableName ('Postgres 'Vanilla)
-> m (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
RelName
-> TableName ('Postgres 'Vanilla)
-> m (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
fetchRelDet RelName
relName TableName ('Postgres 'Vanilla)
relTab
AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
annSel <- TableName ('Postgres 'Vanilla)
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m,
HasServerConfigCtx m) =>
TableName ('Postgres 'Vanilla)
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQ TableName ('Postgres 'Vanilla)
relTab FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
relCIM SelPermInfo ('Postgres 'Vanilla)
relSPI SelectQExt
selQ SessionVariableBuilder m
sessVarBldr ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr
case RelType
relTy of
RelType
ObjRel -> do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
misused (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload Text
objRelMisuseMsg
Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> m (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> m (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)))
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> m (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp))
forall a b. (a -> b) -> a -> b
$
ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
forall a b. a -> Either a b
Left (ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp))
-> ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
forall a b. (a -> b) -> a -> b
$
RelName
-> HashMap
(Column ('Postgres 'Vanilla)) (Column ('Postgres 'Vanilla))
-> AnnObjectSelectG ('Postgres 'Vanilla) Void SQLExp
-> ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) a.
RelName
-> HashMap (Column b) (Column b) -> a -> AnnRelationSelectG b a
AnnRelationSelectG (RelName -> Maybe RelName -> RelName
forall a. a -> Maybe a -> a
fromMaybe RelName
relName Maybe RelName
mAlias) HashMap (Column ('Postgres 'Vanilla)) (Column ('Postgres 'Vanilla))
colMapping (AnnObjectSelectG ('Postgres 'Vanilla) Void SQLExp
-> ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
-> AnnObjectSelectG ('Postgres 'Vanilla) Void SQLExp
-> ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
forall a b. (a -> b) -> a -> b
$
[(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
-> TableName ('Postgres 'Vanilla)
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnObjectSelectG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) r v.
AnnFieldsG b r v
-> TableName b -> AnnBoolExp b v -> AnnObjectSelectG b r v
AnnObjectSelectG (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
-> [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> Fields (f v)
_asnFields AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
annSel) TableName ('Postgres 'Vanilla)
relTab (AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnObjectSelectG ('Postgres 'Vanilla) Void SQLExp)
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnObjectSelectG ('Postgres 'Vanilla) Void SQLExp
forall a b. (a -> b) -> a -> b
$ TablePermG ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v. TablePermG b v -> AnnBoolExp b v
_tpFilter (TablePermG ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> TablePermG ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
forall a b. (a -> b) -> a -> b
$ AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
-> TablePermG ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> TablePermG b v
_asnPerm AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
annSel
RelType
ArrRel ->
Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> m (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> m (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)))
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> m (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp))
forall a b. (a -> b) -> a -> b
$
ArraySelectG ('Postgres 'Vanilla) Void SQLExp
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
forall a b. b -> Either a b
Right (ArraySelectG ('Postgres 'Vanilla) Void SQLExp
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp))
-> ArraySelectG ('Postgres 'Vanilla) Void SQLExp
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
forall a b. (a -> b) -> a -> b
$
ArrayRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> ArraySelectG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) r v.
ArrayRelationSelectG b r v -> ArraySelectG b r v
ASSimple (ArrayRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> ArrayRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> ArraySelectG ('Postgres 'Vanilla) Void SQLExp
forall a b. (a -> b) -> a -> b
$
RelName
-> HashMap
(Column ('Postgres 'Vanilla)) (Column ('Postgres 'Vanilla))
-> AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
-> ArrayRelationSelectG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) a.
RelName
-> HashMap (Column b) (Column b) -> a -> AnnRelationSelectG b a
AnnRelationSelectG
(RelName -> Maybe RelName -> RelName
forall a. a -> Maybe a -> a
fromMaybe RelName
relName Maybe RelName
mAlias)
HashMap (Column ('Postgres 'Vanilla)) (Column ('Postgres 'Vanilla))
colMapping
AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
annSel
where
pgWhenRelErr :: Text
pgWhenRelErr = Text
"only relationships can be expanded"
misused :: Bool
misused =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
[ Maybe (BoolExp ('Postgres 'Vanilla)) -> Bool
forall a. Maybe a -> Bool
isJust (SelectQExt -> Maybe (BoolExp ('Postgres 'Vanilla))
forall a b c. SelectG a b c -> Maybe b
sqWhere SelectQExt
selQ),
Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (SelectQExt -> Maybe Int
forall a b c. SelectG a b c -> Maybe c
sqLimit SelectQExt
selQ),
Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (SelectQExt -> Maybe Int
forall a b c. SelectG a b c -> Maybe c
sqOffset SelectQExt
selQ),
Maybe OrderByExp -> Bool
forall a. Maybe a -> Bool
isJust (SelectQExt -> Maybe OrderByExp
forall a b c. SelectG a b c -> Maybe OrderByExp
sqOrderBy SelectQExt
selQ)
]
objRelMisuseMsg :: Text
objRelMisuseMsg =
Text
"when selecting an 'obj_relationship' 'where', 'order_by', 'limit' and 'offset' can't be used"
convSelectQuery ::
( UserInfoM m,
QErrM m,
TableInfoRM ('Postgres 'Vanilla) m,
HasServerConfigCtx m
) =>
SessionVariableBuilder m ->
ValueParser ('Postgres 'Vanilla) m S.SQLExp ->
SelectQuery ->
m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQuery :: SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> SelectQuery
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQuery SessionVariableBuilder m
sessVarBldr ValueParser ('Postgres 'Vanilla) m SQLExp
prepArgBuilder (DMLQuery SourceName
_ QualifiedTable
qt SelectQ
selQ) = do
TableInfo ('Postgres 'Vanilla)
tabInfo <- Text
-> m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"table" (m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla)))
-> m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
askTableInfoSource TableName ('Postgres 'Vanilla)
QualifiedTable
qt
SelPermInfo ('Postgres 'Vanilla)
selPermInfo <- TableInfo ('Postgres 'Vanilla)
-> m (SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
TableInfo ('Postgres 'Vanilla)
-> m (SelPermInfo ('Postgres 'Vanilla))
askSelPermInfo TableInfo ('Postgres 'Vanilla)
tabInfo
let fieldInfo :: FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfo = TableCoreInfoG
('Postgres 'Vanilla)
(FieldInfo ('Postgres 'Vanilla))
(ColumnInfo ('Postgres 'Vanilla))
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap (TableCoreInfoG
('Postgres 'Vanilla)
(FieldInfo ('Postgres 'Vanilla))
(ColumnInfo ('Postgres 'Vanilla))
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla)))
-> TableCoreInfoG
('Postgres 'Vanilla)
(FieldInfo ('Postgres 'Vanilla))
(ColumnInfo ('Postgres 'Vanilla))
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ TableInfo ('Postgres 'Vanilla)
-> TableCoreInfoG
('Postgres 'Vanilla)
(FieldInfo ('Postgres 'Vanilla))
(ColumnInfo ('Postgres 'Vanilla))
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo ('Postgres 'Vanilla)
tabInfo
SelectQExt
extSelQ <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla) -> SelectQ -> m SelectQExt
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla) -> SelectQ -> m SelectQExt
resolveStar FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfo SelPermInfo ('Postgres 'Vanilla)
selPermInfo SelectQ
selQ
HashSet Text -> m ()
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
HashSet Text -> m ()
validateHeaders (HashSet Text -> m ()) -> HashSet Text -> m ()
forall a b. (a -> b) -> a -> b
$ SelPermInfo ('Postgres 'Vanilla) -> HashSet Text
forall (b :: BackendType). SelPermInfo b -> HashSet Text
spiRequiredHeaders SelPermInfo ('Postgres 'Vanilla)
selPermInfo
TableName ('Postgres 'Vanilla)
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m,
HasServerConfigCtx m) =>
TableName ('Postgres 'Vanilla)
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQ TableName ('Postgres 'Vanilla)
QualifiedTable
qt FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfo SelPermInfo ('Postgres 'Vanilla)
selPermInfo SelectQExt
extSelQ SessionVariableBuilder m
sessVarBldr ValueParser ('Postgres 'Vanilla) m SQLExp
prepArgBuilder
selectP2 :: JsonAggSelect -> (AnnSimpleSelect ('Postgres 'Vanilla), DS.Seq Q.PrepArg) -> Q.TxE QErr EncJSON
selectP2 :: JsonAggSelect
-> (AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg)
-> TxE QErr EncJSON
selectP2 JsonAggSelect
jsonAggSelect (AnnSimpleSelect ('Postgres 'Vanilla)
sel, Seq PrepArg
p) =
ByteString -> EncJSON
encJFromBS (ByteString -> EncJSON)
-> (SingleRow (Identity ByteString) -> ByteString)
-> SingleRow (Identity ByteString)
-> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity (Identity ByteString -> ByteString)
-> (SingleRow (Identity ByteString) -> Identity ByteString)
-> SingleRow (Identity ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (Identity ByteString) -> Identity ByteString
forall a. SingleRow a -> a
Q.getRow
(SingleRow (Identity ByteString) -> EncJSON)
-> TxET QErr IO (SingleRow (Identity ByteString))
-> TxE QErr EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query
-> [PrepArg]
-> Bool
-> TxET QErr IO (SingleRow (Identity ByteString))
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> [PrepArg] -> Bool -> TxET e m a
Q.rawQE PGTxErr -> QErr
dmlTxErrorHandler (Builder -> Query
Q.fromBuilder Builder
selectSQL) (Seq PrepArg -> [PrepArg]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq PrepArg
p) Bool
True
where
selectSQL :: Builder
selectSQL = Select -> Builder
forall a. ToSQL a => a -> Builder
toSQL (Select -> Builder) -> Select -> Builder
forall a b. (a -> b) -> a -> b
$ JsonAggSelect -> AnnSimpleSelect ('Postgres 'Vanilla) -> Select
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> Select
mkSQLSelect JsonAggSelect
jsonAggSelect AnnSimpleSelect ('Postgres 'Vanilla)
sel
phaseOne ::
(QErrM m, UserInfoM m, CacheRM m, HasServerConfigCtx m) =>
SelectQuery ->
m (AnnSimpleSelect ('Postgres 'Vanilla), DS.Seq Q.PrepArg)
phaseOne :: SelectQuery
-> m (AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg)
phaseOne SelectQuery
query = do
let sourceName :: SourceName
sourceName = SelectQuery -> SourceName
forall a. DMLQuery a -> SourceName
getSourceDMLQuery SelectQuery
query
tableCache :: TableCache ('Postgres 'Vanilla) <- Maybe (HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla))
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe (HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> m (Maybe
(HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla))))
-> m (HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName -> m (Maybe (TableCache ('Postgres 'Vanilla)))
forall (b :: BackendType) (m :: * -> *).
(Backend b, CacheRM m) =>
SourceName -> m (Maybe (TableCache b))
askTableCache SourceName
sourceName
(TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> (SourceName,
HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg))
-> (SourceName,
HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> (SourceName,
HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
forall (b :: BackendType) (m :: * -> *) a.
TableCacheRT b m a -> (SourceName, TableCache b) -> m a
runTableCacheRT (SourceName
sourceName, TableCache ('Postgres 'Vanilla)
HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla))
tableCache) (TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg))
-> TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
forall a b. (a -> b) -> a -> b
$
DMLP1T
(TableCacheRT ('Postgres 'Vanilla) m)
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp)
-> TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
forall (m :: * -> *) a. DMLP1T m a -> m (a, Seq PrepArg)
runDMLP1T (DMLP1T
(TableCacheRT ('Postgres 'Vanilla) m)
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp)
-> TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg))
-> DMLP1T
(TableCacheRT ('Postgres 'Vanilla) m)
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp)
-> TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
forall a b. (a -> b) -> a -> b
$
SessionVariableBuilder
(DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
-> ValueParser
('Postgres 'Vanilla)
(DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
SQLExp
-> SelectQuery
-> DMLP1T
(TableCacheRT ('Postgres 'Vanilla) m)
(AnnSimpleSelect ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m,
HasServerConfigCtx m) =>
SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> SelectQuery
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQuery SessionVariableBuilder
(DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
forall (f :: * -> *). Applicative f => SessionVariableBuilder f
sessVarFromCurrentSetting ((ColumnType ('Postgres 'Vanilla)
-> Value -> DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) SQLExp)
-> ValueParser
('Postgres 'Vanilla)
(DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
SQLExp
forall (m :: * -> *).
MonadError QErr m =>
(ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp)
-> CollectableType (ColumnType ('Postgres 'Vanilla))
-> Value
-> m SQLExp
valueParserWithCollectableType ColumnType ('Postgres 'Vanilla)
-> Value -> DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) SQLExp
forall (m :: * -> *).
QErrM m =>
ColumnType ('Postgres 'Vanilla) -> Value -> DMLP1T m SQLExp
binRHSBuilder) SelectQuery
query
phaseTwo :: (MonadTx m) => (AnnSimpleSelect ('Postgres 'Vanilla), DS.Seq Q.PrepArg) -> m EncJSON
phaseTwo :: (AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg) -> m EncJSON
phaseTwo =
TxE QErr EncJSON -> m EncJSON
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr EncJSON -> m EncJSON)
-> ((AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> TxE QErr EncJSON)
-> (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonAggSelect
-> (AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg)
-> TxE QErr EncJSON
selectP2 JsonAggSelect
JASMultipleRows
runSelect ::
( QErrM m,
UserInfoM m,
CacheRM m,
HasServerConfigCtx m,
MonadIO m,
MonadBaseControl IO m,
Tracing.MonadTrace m,
MetadataM m
) =>
SelectQuery ->
m EncJSON
runSelect :: SelectQuery -> m EncJSON
runSelect SelectQuery
q = do
PGSourceConfig
sourceConfig <- SourceName -> m (SourceConfig ('Postgres 'Vanilla))
forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig @('Postgres 'Vanilla) (SelectQuery -> SourceName
forall a. DMLQuery a -> SourceName
getSourceDMLQuery SelectQuery
q)
SelectQuery
-> m (AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg)
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m, HasServerConfigCtx m) =>
SelectQuery
-> m (AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg)
phaseOne SelectQuery
q m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> ((AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> m EncJSON)
-> m EncJSON
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PGExecCtx -> TxAccess -> TxET QErr m EncJSON -> m EncJSON
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m, MonadError QErr m, MonadTrace m,
UserInfoM m) =>
PGExecCtx -> TxAccess -> TxET QErr m a -> m a
runTxWithCtx (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
sourceConfig) TxAccess
Q.ReadOnly (TxET QErr m EncJSON -> m EncJSON)
-> ((AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> TxET QErr m EncJSON)
-> (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> TxET QErr m EncJSON
forall (m :: * -> *).
MonadTx m =>
(AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg) -> m EncJSON
phaseTwo