2018-10-31 15:51:20 +03:00
|
|
|
{-# LANGUAGE DeriveLift #-}
|
|
|
|
{-# LANGUAGE LambdaCase #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE TupleSections #-}
|
|
|
|
|
|
|
|
module Hasura.RQL.DML.Select.Internal where
|
|
|
|
|
|
|
|
import Data.Aeson.Types
|
|
|
|
import Instances.TH.Lift ()
|
|
|
|
import Language.Haskell.TH.Syntax (Lift)
|
|
|
|
|
|
|
|
import qualified Data.HashMap.Strict as HM
|
|
|
|
import qualified Data.List.NonEmpty as NE
|
|
|
|
import qualified Data.Text as T
|
|
|
|
|
|
|
|
import Hasura.Prelude
|
|
|
|
import Hasura.RQL.DML.Internal
|
|
|
|
import Hasura.RQL.GBoolExp
|
|
|
|
import Hasura.RQL.Types
|
|
|
|
import Hasura.SQL.Types
|
|
|
|
|
|
|
|
import qualified Hasura.SQL.DML as S
|
|
|
|
|
|
|
|
-- Conversion of SelectQ happens in 2 Stages.
|
|
|
|
-- Stage 1 : Convert input query into an annotated AST
|
|
|
|
-- Stage 2 : Convert annotated AST to SQL Select
|
|
|
|
|
|
|
|
type SelectQExt = SelectG ExtCol BoolExp Int
|
|
|
|
-- Columns in RQL
|
|
|
|
data ExtCol
|
|
|
|
= ECSimple !PGCol
|
|
|
|
| ECRel !RelName !(Maybe RelName) !SelectQExt
|
|
|
|
deriving (Show, Eq, Lift)
|
|
|
|
|
|
|
|
instance ToJSON ExtCol where
|
|
|
|
toJSON (ECSimple s) = toJSON s
|
|
|
|
toJSON (ECRel rn mrn selq) =
|
|
|
|
object $ [ "name" .= rn
|
|
|
|
, "alias" .= mrn
|
|
|
|
] ++ selectGToPairs selq
|
|
|
|
|
|
|
|
instance FromJSON ExtCol where
|
|
|
|
parseJSON v@(Object o) =
|
|
|
|
ECRel
|
|
|
|
<$> o .: "name"
|
|
|
|
<*> o .:? "alias"
|
|
|
|
<*> parseJSON v
|
|
|
|
parseJSON (String s) =
|
|
|
|
return $ ECSimple $ PGCol s
|
|
|
|
parseJSON _ =
|
|
|
|
fail $ mconcat
|
|
|
|
[ "A column should either be a string or an "
|
|
|
|
, "object (relationship)"
|
|
|
|
]
|
|
|
|
|
|
|
|
data AnnObCol
|
|
|
|
= AOCPG !PGColInfo
|
2018-11-16 15:40:23 +03:00
|
|
|
| AOCRel !RelInfo !AnnBoolExpSQL !AnnObCol
|
2018-10-31 15:51:20 +03:00
|
|
|
deriving (Show, Eq)
|
|
|
|
|
|
|
|
type AnnOrderByItem = OrderByItemG AnnObCol
|
|
|
|
|
|
|
|
data AnnRel
|
|
|
|
= AnnRel
|
|
|
|
{ arName :: !RelName -- Relationship name
|
|
|
|
, arType :: !RelType -- Relationship type (ObjRel, ArrRel)
|
|
|
|
, arMapping :: ![(PGCol, PGCol)] -- Column of the left table to join with
|
|
|
|
, arAnnSel :: !AnnSel -- Current table. Almost ~ to SQL Select
|
|
|
|
} deriving (Show, Eq)
|
|
|
|
|
|
|
|
type AnnAggSel = AnnSelG [(T.Text, TableAggFld)]
|
|
|
|
|
|
|
|
data AggSel
|
|
|
|
= AggSel
|
|
|
|
{ agColMapping :: ![(PGCol, PGCol)]
|
|
|
|
, agAnnSel :: !AnnAggSel
|
|
|
|
} deriving (Show, Eq)
|
|
|
|
|
|
|
|
data AnnFld
|
|
|
|
= FCol !PGColInfo
|
|
|
|
| FExp !T.Text
|
|
|
|
| FRel !AnnRel
|
|
|
|
| FAgg !AggSel
|
|
|
|
deriving (Show, Eq)
|
|
|
|
|
|
|
|
data TableArgs
|
|
|
|
= TableArgs
|
2018-11-16 15:40:23 +03:00
|
|
|
{ _taWhere :: !(Maybe AnnBoolExpSQL)
|
2018-10-31 15:51:20 +03:00
|
|
|
, _taOrderBy :: !(Maybe (NE.NonEmpty AnnOrderByItem))
|
|
|
|
, _taLimit :: !(Maybe Int)
|
|
|
|
, _taOffset :: !(Maybe S.SQLExp)
|
|
|
|
} deriving (Show, Eq)
|
|
|
|
|
|
|
|
noTableArgs :: TableArgs
|
|
|
|
noTableArgs = TableArgs Nothing Nothing Nothing Nothing
|
|
|
|
|
|
|
|
data PGColFld
|
|
|
|
= PCFCol !PGCol
|
|
|
|
| PCFExp !T.Text
|
|
|
|
deriving (Show, Eq)
|
|
|
|
|
|
|
|
type ColFlds = [(T.Text, PGColFld)]
|
|
|
|
|
2018-11-14 15:59:59 +03:00
|
|
|
data AggOp
|
|
|
|
= AggOp
|
|
|
|
{ _aoOp :: !T.Text
|
|
|
|
, _aoFlds :: !ColFlds
|
|
|
|
} deriving (Show, Eq)
|
|
|
|
|
2018-10-31 15:51:20 +03:00
|
|
|
data AggFld
|
2018-11-14 15:59:59 +03:00
|
|
|
= AFCount !S.CountType
|
|
|
|
| AFOp !AggOp
|
2018-10-31 15:51:20 +03:00
|
|
|
| AFExp !T.Text
|
|
|
|
deriving (Show, Eq)
|
|
|
|
|
|
|
|
type AggFlds = [(T.Text, AggFld)]
|
|
|
|
|
|
|
|
data TableAggFld
|
|
|
|
= TAFAgg !AggFlds
|
|
|
|
| TAFNodes ![(FieldName, AnnFld)]
|
|
|
|
| TAFExp !T.Text
|
|
|
|
deriving (Show, Eq)
|
|
|
|
|
|
|
|
data TableFrom
|
|
|
|
= TableFrom
|
|
|
|
{ _tfTable :: !QualifiedTable
|
2018-11-16 15:40:23 +03:00
|
|
|
, _tfIden :: !(Maybe Iden)
|
2018-10-31 15:51:20 +03:00
|
|
|
} deriving (Show, Eq)
|
|
|
|
|
2018-11-16 15:40:23 +03:00
|
|
|
tableFromToFromItem :: TableFrom -> S.FromItem
|
|
|
|
tableFromToFromItem = \case
|
|
|
|
TableFrom tn Nothing -> S.FISimple tn Nothing
|
|
|
|
TableFrom _ (Just i) -> S.FIIden i
|
|
|
|
|
|
|
|
tableFromToQual :: TableFrom -> S.Qual
|
|
|
|
tableFromToQual = \case
|
|
|
|
TableFrom tn Nothing -> S.QualTable tn
|
|
|
|
TableFrom _ (Just i) -> S.QualIden i
|
|
|
|
|
2018-10-31 15:51:20 +03:00
|
|
|
data TablePerm
|
|
|
|
= TablePerm
|
2018-11-16 15:40:23 +03:00
|
|
|
{ _tpFilter :: !AnnBoolExpSQL
|
2018-10-31 15:51:20 +03:00
|
|
|
, _tpLimit :: !(Maybe Int)
|
2018-11-16 15:40:23 +03:00
|
|
|
} deriving (Eq, Show)
|
2018-10-31 15:51:20 +03:00
|
|
|
|
|
|
|
data AnnSelG a
|
|
|
|
= AnnSelG
|
|
|
|
{ _asnFields :: !a
|
|
|
|
, _asnFrom :: !TableFrom
|
|
|
|
, _asnPerm :: !TablePerm
|
|
|
|
, _asnArgs :: !TableArgs
|
|
|
|
} deriving (Show, Eq)
|
|
|
|
|
|
|
|
type AnnSel = AnnSelG [(FieldName, AnnFld)]
|
|
|
|
|
|
|
|
data BaseNode
|
|
|
|
= BaseNode
|
|
|
|
{ _bnPrefix :: !Iden
|
|
|
|
, _bnFrom :: !S.FromItem
|
|
|
|
, _bnWhere :: !S.BoolExp
|
|
|
|
, _bnOrderBy :: !(Maybe S.OrderByExp)
|
|
|
|
, _bnLimit :: !(Maybe Int)
|
|
|
|
, _bnOffset :: !(Maybe S.SQLExp)
|
|
|
|
|
|
|
|
, _bnExtrs :: !(HM.HashMap S.Alias S.SQLExp)
|
|
|
|
, _bnObjRels :: !(HM.HashMap RelName RelNode)
|
|
|
|
, _bnArrRels :: !(HM.HashMap S.Alias RelNode)
|
|
|
|
, _bnAggs :: !(HM.HashMap S.Alias AggNode)
|
|
|
|
|
|
|
|
} deriving (Show, Eq)
|
|
|
|
|
|
|
|
txtToAlias :: Text -> S.Alias
|
|
|
|
txtToAlias = S.Alias . Iden
|
|
|
|
|
2018-11-12 10:28:46 +03:00
|
|
|
aggFldToExp :: AggFlds -> S.SQLExp
|
|
|
|
aggFldToExp aggFlds = jsonRow
|
2018-10-31 15:51:20 +03:00
|
|
|
where
|
|
|
|
jsonRow = S.applyJsonBuildObj (concatMap aggToFlds aggFlds)
|
|
|
|
withAls fldName sqlExp = [S.SELit fldName, sqlExp]
|
|
|
|
aggToFlds (t, fld) = withAls t $ case fld of
|
2018-11-14 15:59:59 +03:00
|
|
|
AFCount cty -> S.SECount cty
|
|
|
|
AFOp aggOp -> aggOpToObj aggOp
|
|
|
|
AFExp e -> S.SELit e
|
|
|
|
|
|
|
|
aggOpToObj (AggOp op flds) =
|
2018-10-31 15:51:20 +03:00
|
|
|
S.applyJsonBuildObj $ concatMap (colFldsToExtr op) flds
|
|
|
|
|
|
|
|
colFldsToExtr op (t, PCFCol col) =
|
|
|
|
[ S.SELit t
|
2018-11-12 10:28:46 +03:00
|
|
|
, S.SEFnApp op [S.SEIden $ toIden col] Nothing
|
2018-10-31 15:51:20 +03:00
|
|
|
]
|
|
|
|
colFldsToExtr _ (t, PCFExp e) =
|
|
|
|
[ S.SELit t , S.SELit e]
|
|
|
|
|
|
|
|
asSingleRow :: S.Alias -> S.FromItem -> S.Select
|
|
|
|
asSingleRow col fromItem =
|
|
|
|
S.mkSelect
|
|
|
|
{ S.selExtr = [S.Extractor extr $ Just col]
|
|
|
|
, S.selFrom = Just $ S.FromExp [fromItem]
|
|
|
|
}
|
|
|
|
where
|
|
|
|
extr = S.SEFnApp "coalesce" [jsonAgg, S.SELit "null"] Nothing
|
|
|
|
jsonAgg = S.SEOpApp (S.SQLOp "->")
|
|
|
|
[ S.SEFnApp "json_agg" [S.SEIden $ toIden col] Nothing
|
|
|
|
, S.SEUnsafe "0"
|
|
|
|
]
|
|
|
|
|
|
|
|
aggNodeToSelect :: BaseNode -> S.Extractor -> S.BoolExp -> S.Select
|
|
|
|
aggNodeToSelect bn extr joinCond =
|
|
|
|
S.mkSelect
|
|
|
|
{ S.selExtr = [extr]
|
|
|
|
, S.selFrom = Just $ S.FromExp [selFrom]
|
|
|
|
}
|
|
|
|
where
|
|
|
|
selFrom = S.mkSelFromItem (baseNodeToSel joinCond bn) $ S.Alias $
|
|
|
|
_bnPrefix bn
|
|
|
|
|
|
|
|
withJsonAgg :: Maybe S.OrderByExp -> S.Alias -> S.FromItem -> S.Select
|
|
|
|
withJsonAgg orderByM col fromItem =
|
|
|
|
S.mkSelect
|
|
|
|
{ S.selExtr = [S.Extractor extr $ Just col]
|
|
|
|
, S.selFrom = Just $ S.FromExp [fromItem]
|
|
|
|
}
|
|
|
|
where
|
|
|
|
extr = S.SEFnApp "coalesce" [jsonAgg, S.SELit "[]"] Nothing
|
|
|
|
jsonAgg = S.SEFnApp "json_agg" [S.SEIden $ toIden col] orderByM
|
|
|
|
|
|
|
|
asJsonAggSel :: Bool -> S.Alias -> S.BoolExp -> BaseNode -> S.Select
|
|
|
|
asJsonAggSel singleObj als joinCond n =
|
|
|
|
let ordByM = _bnOrderBy n
|
|
|
|
fromItem = S.mkSelFromItem (baseNodeToSel joinCond n) $
|
|
|
|
S.Alias $ _bnPrefix n
|
|
|
|
in bool
|
|
|
|
(withJsonAgg ordByM als fromItem)
|
|
|
|
(asSingleRow als fromItem)
|
|
|
|
singleObj
|
|
|
|
|
|
|
|
-- array relationships are not grouped, so have to be prefixed by
|
|
|
|
-- parent's alias
|
|
|
|
mkUniqArrRelAls :: FieldName -> FieldName -> Iden
|
|
|
|
mkUniqArrRelAls parAls relAls =
|
|
|
|
Iden $
|
|
|
|
getFieldNameTxt parAls <> "." <> getFieldNameTxt relAls
|
|
|
|
|
|
|
|
mkArrRelTableAls :: Iden -> FieldName -> FieldName -> Iden
|
|
|
|
mkArrRelTableAls pfx parAls relAls =
|
|
|
|
pfx <> Iden ".ar." <> uniqArrRelAls
|
|
|
|
where
|
|
|
|
uniqArrRelAls = mkUniqArrRelAls parAls relAls
|
|
|
|
|
|
|
|
mkObjRelTableAls :: Iden -> RelName -> Iden
|
|
|
|
mkObjRelTableAls pfx relName =
|
|
|
|
pfx <> Iden ".or." <> toIden relName
|
|
|
|
|
|
|
|
mkAggAls :: Iden -> FieldName -> Iden
|
|
|
|
mkAggAls pfx fldAls =
|
|
|
|
pfx <> Iden ".agg." <> toIden fldAls
|
|
|
|
|
|
|
|
mkBaseTableAls :: Iden -> Iden
|
|
|
|
mkBaseTableAls pfx =
|
|
|
|
pfx <> Iden ".base"
|
|
|
|
|
|
|
|
mkBaseTableColAls :: Iden -> PGCol -> Iden
|
|
|
|
mkBaseTableColAls pfx pgCol =
|
|
|
|
pfx <> Iden ".pg." <> toIden pgCol
|
|
|
|
|
|
|
|
-- posttgres ignores anything beyond 63 chars for an iden
|
|
|
|
-- in this case, we'll need to use json_build_object function
|
|
|
|
-- json_build_object is slower than row_to_json hence it is only
|
|
|
|
-- used when needed
|
|
|
|
buildJsonObject
|
|
|
|
:: Iden -> FieldName
|
|
|
|
-> [(FieldName, AnnFld)] -> (S.Alias, S.SQLExp)
|
|
|
|
buildJsonObject pfx parAls flds =
|
|
|
|
if any ( (> 63) . T.length . getFieldNameTxt . fst ) flds
|
|
|
|
then withJsonBuildObj parAls jsonBuildObjExps
|
|
|
|
else withRowToJSON parAls rowToJsonExtrs
|
|
|
|
where
|
|
|
|
jsonBuildObjExps = concatMap (toSQLFld withAlsExp) flds
|
|
|
|
rowToJsonExtrs = map (toSQLFld withAlsExtr) flds
|
|
|
|
|
|
|
|
withAlsExp fldName sqlExp =
|
|
|
|
[S.SELit $ getFieldNameTxt fldName, sqlExp]
|
|
|
|
withAlsExtr fldName sqlExp =
|
|
|
|
S.Extractor sqlExp $ Just $ S.toAlias fldName
|
|
|
|
|
|
|
|
toSQLFld f (fldAls, fld) = f fldAls $ case fld of
|
|
|
|
FCol col -> toJSONableExp (pgiType col) $
|
|
|
|
S.mkQIdenExp (mkBaseTableAls pfx) $ pgiName col
|
|
|
|
FExp e -> S.SELit e
|
|
|
|
FRel annRel ->
|
|
|
|
let qual = case arType annRel of
|
|
|
|
ObjRel -> mkObjRelTableAls pfx $ arName annRel
|
|
|
|
ArrRel -> mkArrRelTableAls pfx parAls fldAls
|
|
|
|
in S.mkQIdenExp qual fldAls
|
|
|
|
FAgg _ -> S.mkQIdenExp (mkAggAls pfx fldAls) fldAls
|
|
|
|
|
|
|
|
-- uses row_to_json to build a json object
|
|
|
|
withRowToJSON
|
|
|
|
:: FieldName -> [S.Extractor] -> (S.Alias, S.SQLExp)
|
|
|
|
withRowToJSON parAls extrs =
|
|
|
|
(S.toAlias parAls, jsonRow)
|
|
|
|
where
|
|
|
|
jsonRow = S.applyRowToJson extrs
|
|
|
|
|
|
|
|
-- uses json_build_object to build a json object
|
|
|
|
withJsonBuildObj
|
|
|
|
:: FieldName -> [S.SQLExp] -> (S.Alias, S.SQLExp)
|
|
|
|
withJsonBuildObj parAls exps =
|
|
|
|
(S.toAlias parAls, jsonRow)
|
|
|
|
where
|
|
|
|
jsonRow = S.applyJsonBuildObj exps
|
|
|
|
|
|
|
|
processAnnOrderByItem
|
|
|
|
:: Iden
|
|
|
|
-> AnnOrderByItem
|
|
|
|
-- the extractors which will select the needed columns
|
|
|
|
-> ( (S.Alias, S.SQLExp)
|
|
|
|
-- the sql order by item that is attached to the final select
|
|
|
|
, S.OrderByItem
|
|
|
|
-- optionally we may have to add an obj rel node
|
|
|
|
, Maybe (RelName, RelNode)
|
|
|
|
)
|
|
|
|
processAnnOrderByItem pfx (OrderByItemG obTyM annObCol obNullsM) =
|
|
|
|
( (obColAls, obColExp)
|
|
|
|
, sqlOrdByItem
|
|
|
|
, relNodeM
|
|
|
|
)
|
|
|
|
where
|
|
|
|
((obColAls, obColExp), relNodeM) = processAnnOrderByCol pfx annObCol
|
|
|
|
|
|
|
|
sqlOrdByItem =
|
|
|
|
S.OrderByItem (S.SEIden $ toIden obColAls) obTyM obNullsM
|
|
|
|
|
|
|
|
processAnnOrderByCol
|
|
|
|
:: Iden
|
|
|
|
-> AnnObCol
|
|
|
|
-- the extractors which will select the needed columns
|
|
|
|
-> ( (S.Alias, S.SQLExp)
|
|
|
|
-- optionally we may have to add an obj rel node
|
|
|
|
, Maybe (RelName, RelNode)
|
|
|
|
)
|
|
|
|
processAnnOrderByCol pfx = \case
|
|
|
|
AOCPG colInfo ->
|
|
|
|
let
|
|
|
|
qualCol = S.mkQIdenExp (mkBaseTableAls pfx) (toIden $ pgiName colInfo)
|
|
|
|
obColAls = mkBaseTableColAls pfx $ pgiName colInfo
|
|
|
|
in ( (S.Alias obColAls, qualCol)
|
|
|
|
, Nothing
|
|
|
|
)
|
|
|
|
-- "pfx.or.relname"."pfx.ob.or.relname.rest" AS "pfx.ob.or.relname.rest"
|
2018-11-16 15:40:23 +03:00
|
|
|
AOCRel (RelInfo rn _ colMapping relTab _) relFltr rest ->
|
2018-10-31 15:51:20 +03:00
|
|
|
let relPfx = mkObjRelTableAls pfx rn
|
|
|
|
((nesAls, nesCol), nesNodeM) = processAnnOrderByCol relPfx rest
|
|
|
|
qualCol = S.mkQIdenExp relPfx nesAls
|
|
|
|
relBaseNode =
|
2018-11-16 15:40:23 +03:00
|
|
|
BaseNode relPfx (S.FISimple relTab Nothing)
|
|
|
|
(toSQLBoolExp (S.QualTable relTab) relFltr)
|
2018-10-31 15:51:20 +03:00
|
|
|
Nothing Nothing Nothing
|
|
|
|
(HM.singleton nesAls nesCol)
|
|
|
|
(maybe HM.empty (uncurry HM.singleton) nesNodeM)
|
|
|
|
HM.empty HM.empty
|
|
|
|
relNode = RelNode rn (fromRel rn) colMapping relBaseNode
|
|
|
|
in ( (nesAls, qualCol)
|
|
|
|
, Just (rn, relNode)
|
|
|
|
)
|
|
|
|
|
|
|
|
mkEmptyBaseNode :: Iden -> TableFrom -> BaseNode
|
|
|
|
mkEmptyBaseNode pfx tableFrom =
|
|
|
|
BaseNode pfx fromItem (S.BELit True) Nothing Nothing Nothing
|
|
|
|
selOne HM.empty HM.empty HM.empty
|
|
|
|
where
|
|
|
|
selOne = HM.singleton (S.Alias $ pfx <> Iden "__one") (S.SEUnsafe "1")
|
2018-11-16 15:40:23 +03:00
|
|
|
fromItem = tableFromToFromItem tableFrom
|
2018-10-31 15:51:20 +03:00
|
|
|
|
|
|
|
-- If query limit > permission limit then consider permission limit Else consider query limit
|
|
|
|
applyPermLimit
|
|
|
|
:: Maybe Int -- Permission limit
|
|
|
|
-> Maybe Int -- Query limit
|
|
|
|
-> Maybe Int -- Return SQL exp
|
|
|
|
applyPermLimit mPermLimit mQueryLimit =
|
|
|
|
maybe mQueryLimit compareWithPermLimit mPermLimit
|
|
|
|
where
|
|
|
|
compareWithPermLimit pLimit =
|
|
|
|
maybe (Just pLimit) (compareLimits pLimit) mQueryLimit
|
|
|
|
compareLimits pLimit qLimit = Just $
|
|
|
|
if qLimit > pLimit then pLimit else qLimit
|
|
|
|
|
|
|
|
aggSelToAggNode :: Iden -> FieldName -> AggSel -> AggNode
|
|
|
|
aggSelToAggNode pfx als aggSel =
|
|
|
|
AggNode colMapping extr mergedBN
|
|
|
|
where
|
|
|
|
AggSel colMapping annSel = aggSel
|
|
|
|
AnnSelG aggFlds tabFrm tabPerm tabArgs = annSel
|
|
|
|
fldAls = S.Alias $ toIden als
|
|
|
|
|
|
|
|
extr = flip S.Extractor (Just fldAls) $ S.applyJsonBuildObj $
|
|
|
|
concatMap selFldToExtr aggFlds
|
|
|
|
|
|
|
|
ordBy = _bnOrderBy mergedBN
|
|
|
|
|
|
|
|
allBNs = map mkAggBaseNode aggFlds
|
|
|
|
emptyBN = mkEmptyBaseNode pfx tabFrm
|
|
|
|
mergedBN = foldr mergeBaseNodes emptyBN allBNs
|
|
|
|
|
|
|
|
mkAggBaseNode (t, selFld) =
|
|
|
|
mkBaseNode pfx (FieldName t) selFld tabFrm tabPerm tabArgs
|
|
|
|
|
|
|
|
selFldToExtr (t, fld) = (:) (S.SELit t) $ pure $ case fld of
|
2018-11-12 10:28:46 +03:00
|
|
|
TAFAgg flds -> aggFldToExp flds
|
2018-10-31 15:51:20 +03:00
|
|
|
TAFNodes _ ->
|
|
|
|
let jsonAgg = S.SEFnApp "json_agg" [S.SEIden $ Iden t] ordBy
|
|
|
|
in S.SEFnApp "coalesce" [jsonAgg, S.SELit "[]"] Nothing
|
|
|
|
TAFExp e ->
|
|
|
|
-- bool_or to force aggregation
|
|
|
|
S.SEFnApp "coalesce"
|
|
|
|
[ S.SELit e , S.SEUnsafe "bool_or('true')::text"] Nothing
|
|
|
|
|
|
|
|
mkBaseNode
|
|
|
|
:: Iden -> FieldName -> TableAggFld -> TableFrom
|
|
|
|
-> TablePerm -> TableArgs -> BaseNode
|
|
|
|
mkBaseNode pfx fldAls annSelFlds tableFrom tablePerm tableArgs =
|
|
|
|
BaseNode pfx fromItem finalWhere ordByExpM finalLimit offsetM
|
|
|
|
allExtrs allObjsWithOb allArrs aggs
|
|
|
|
where
|
|
|
|
TablePerm fltr permLimitM = tablePerm
|
|
|
|
TableArgs whereM orderByM limitM offsetM = tableArgs
|
|
|
|
(allExtrs, allObjsWithOb, allArrs, aggs) = case annSelFlds of
|
|
|
|
TAFNodes flds ->
|
|
|
|
let selExtr = buildJsonObject pfx fldAls flds
|
|
|
|
-- all the relationships
|
|
|
|
(allObjs, allArrRels) =
|
|
|
|
foldl' addRel (HM.empty, HM.empty) $
|
|
|
|
mapMaybe (\(als, f) -> (als,) <$> getAnnRel f) flds
|
|
|
|
allObjRelsWithOb =
|
|
|
|
foldl' (\objs (rn, relNode) -> HM.insertWith mergeRelNodes rn relNode objs)
|
|
|
|
allObjs $ catMaybes $ maybe [] _3 procOrdByM
|
|
|
|
aggItems = HM.fromList $ map mkAggItem $
|
|
|
|
mapMaybe (\(als, f) -> (als,) <$> getAggFld f) flds
|
|
|
|
in ( HM.fromList $ selExtr:obExtrs
|
|
|
|
, allObjRelsWithOb
|
|
|
|
, allArrRels
|
|
|
|
, aggItems
|
|
|
|
)
|
|
|
|
TAFAgg aggFlds ->
|
|
|
|
let extrs = concatMap (fetchExtrFromAggFld . snd) aggFlds
|
|
|
|
in ( HM.fromList $ extrs <> obExtrs
|
|
|
|
, HM.empty
|
|
|
|
, HM.empty
|
|
|
|
, HM.empty
|
|
|
|
)
|
|
|
|
TAFExp _ -> (HM.fromList obExtrs, HM.empty, HM.empty, HM.empty)
|
|
|
|
|
2018-11-14 15:59:59 +03:00
|
|
|
fetchExtrFromAggFld (AFCount cty) = countTyToExps cty
|
|
|
|
fetchExtrFromAggFld (AFOp aggOp) = aggOpToExps aggOp
|
|
|
|
fetchExtrFromAggFld (AFExp _) = []
|
|
|
|
|
|
|
|
countTyToExps S.CTStar = []
|
|
|
|
countTyToExps (S.CTSimple cols) = colsToExps cols
|
|
|
|
countTyToExps (S.CTDistinct cols) = colsToExps cols
|
|
|
|
|
|
|
|
colsToExps = mapMaybe (mkColExp . PCFCol)
|
2018-10-31 15:51:20 +03:00
|
|
|
|
2018-11-14 15:59:59 +03:00
|
|
|
aggOpToExps = mapMaybe (mkColExp . snd) . _aoFlds
|
2018-10-31 15:51:20 +03:00
|
|
|
|
|
|
|
mkColExp (PCFCol c) =
|
|
|
|
let qualCol = S.mkQIdenExp (mkBaseTableAls pfx) (toIden c)
|
2018-11-12 10:28:46 +03:00
|
|
|
colAls = toIden c
|
2018-10-31 15:51:20 +03:00
|
|
|
in Just (S.Alias colAls, qualCol)
|
|
|
|
mkColExp _ = Nothing
|
|
|
|
|
2018-11-16 15:40:23 +03:00
|
|
|
finalWhere =
|
|
|
|
toSQLBoolExp tableQual $ maybe fltr (andAnnBoolExps fltr) whereM
|
|
|
|
fromItem = tableFromToFromItem tableFrom
|
|
|
|
tableQual = tableFromToQual tableFrom
|
2018-10-31 15:51:20 +03:00
|
|
|
finalLimit = applyPermLimit permLimitM limitM
|
|
|
|
|
|
|
|
_1 (a, _, _) = a
|
|
|
|
_2 (_, b, _) = b
|
|
|
|
_3 (_, _, c) = c
|
|
|
|
|
|
|
|
procOrdByM = unzip3 . map (processAnnOrderByItem pfx) . toList <$> orderByM
|
|
|
|
ordByExpM = S.OrderByExp . _2 <$> procOrdByM
|
|
|
|
|
|
|
|
-- the columns needed for orderby
|
|
|
|
obExtrs = maybe [] _1 procOrdByM
|
|
|
|
|
|
|
|
mkRelPfx rTy rn relAls = case rTy of
|
|
|
|
ObjRel -> mkObjRelTableAls pfx rn
|
|
|
|
ArrRel -> mkArrRelTableAls pfx fldAls relAls
|
|
|
|
|
|
|
|
-- process a relationship
|
|
|
|
addRel (objs, arrs) (relAls, annRel) =
|
|
|
|
let relName = arName annRel
|
|
|
|
relNodePfx = mkRelPfx (arType annRel) relName relAls
|
|
|
|
relNode = mkRelNode relNodePfx (relAls, annRel)
|
|
|
|
in case arType annRel of
|
|
|
|
-- in case of object relationships, we merge
|
|
|
|
ObjRel ->
|
|
|
|
(HM.insertWith mergeRelNodes relName relNode objs, arrs)
|
|
|
|
ArrRel ->
|
|
|
|
let arrRelTableAls = S.Alias $ mkUniqArrRelAls fldAls relAls
|
|
|
|
in (objs, HM.insert arrRelTableAls relNode arrs)
|
|
|
|
|
|
|
|
-- process agg field
|
|
|
|
mkAggItem (f, aggSel) =
|
|
|
|
let aggPfx = mkAggAls pfx f
|
|
|
|
aggAls = S.Alias aggPfx
|
|
|
|
aggNode = aggSelToAggNode aggPfx f aggSel
|
|
|
|
in (aggAls, aggNode)
|
|
|
|
|
|
|
|
getAnnRel = \case
|
|
|
|
FRel ar -> Just ar
|
|
|
|
_ -> Nothing
|
|
|
|
|
|
|
|
getAggFld = \case
|
|
|
|
FAgg af -> Just af
|
|
|
|
_ -> Nothing
|
|
|
|
|
|
|
|
annSelToBaseNode :: Iden -> FieldName -> AnnSel -> BaseNode
|
|
|
|
annSelToBaseNode pfx fldAls annSel =
|
|
|
|
mkBaseNode pfx fldAls (TAFNodes selFlds) tabFrm tabPerm tabArgs
|
|
|
|
where
|
|
|
|
AnnSelG selFlds tabFrm tabPerm tabArgs = annSel
|
|
|
|
|
|
|
|
mergeBaseNodes :: BaseNode -> BaseNode -> BaseNode
|
|
|
|
mergeBaseNodes lNodeDet rNodeDet =
|
|
|
|
BaseNode pfx f whr ordBy limit offset
|
|
|
|
(HM.union lExtrs rExtrs)
|
|
|
|
(HM.unionWith mergeRelNodes lObjs rObjs)
|
|
|
|
(HM.union lArrs rArrs)
|
|
|
|
(HM.union lAggs rAggs)
|
|
|
|
where
|
|
|
|
(BaseNode pfx f whr ordBy limit offset lExtrs lObjs lArrs lAggs) = lNodeDet
|
|
|
|
(BaseNode _ _ _ _ _ _ rExtrs rObjs rArrs rAggs) = rNodeDet
|
|
|
|
|
|
|
|
-- should only be used to merge obj rel nodes
|
|
|
|
mergeRelNodes :: RelNode -> RelNode -> RelNode
|
|
|
|
mergeRelNodes lNode rNode =
|
|
|
|
RelNode rn rAls rMapn $ mergeBaseNodes lNodeDet rNodeDet
|
|
|
|
where
|
|
|
|
(RelNode rn rAls rMapn lNodeDet) = lNode
|
|
|
|
(RelNode _ _ _ rNodeDet) = rNode
|
|
|
|
|
|
|
|
data RelNode
|
|
|
|
= RelNode
|
|
|
|
{ _rnRelName :: !RelName
|
|
|
|
, _rnRelAlias :: !FieldName
|
|
|
|
, _rnRelMapping :: ![(PGCol, PGCol)]
|
|
|
|
, _rnNodeDet :: !BaseNode
|
|
|
|
} deriving (Show, Eq)
|
|
|
|
|
|
|
|
mkRelNode :: Iden -> (FieldName, AnnRel) -> RelNode
|
|
|
|
mkRelNode pfx (relAls, AnnRel rn _ rMapn rAnnSel) =
|
|
|
|
RelNode rn relAls rMapn $ annSelToBaseNode pfx relAls rAnnSel
|
|
|
|
|
|
|
|
data AggNode
|
|
|
|
= AggNode
|
|
|
|
{ _anColMapping :: ![(PGCol, PGCol)]
|
|
|
|
, _anExtr :: !S.Extractor
|
|
|
|
, _anNodeDet :: !BaseNode
|
|
|
|
} deriving (Show, Eq)
|
|
|
|
|
|
|
|
injectJoinCond :: S.BoolExp -- ^ Join condition
|
|
|
|
-> S.BoolExp -- ^ Where condition
|
|
|
|
-> S.WhereFrag -- ^ New where frag
|
|
|
|
injectJoinCond joinCond whereCond =
|
|
|
|
S.WhereFrag $ S.simplifyBoolExp $ S.BEBin S.AndOp joinCond whereCond
|
|
|
|
|
|
|
|
mkJoinCond :: S.Alias -> [(PGCol, PGCol)] -> S.BoolExp
|
|
|
|
mkJoinCond baseTableAls colMapn =
|
|
|
|
foldl' (S.BEBin S.AndOp) (S.BELit True) $ flip map colMapn $
|
|
|
|
\(lCol, rCol) ->
|
|
|
|
S.BECompare S.SEQ (S.mkQIdenExp baseTableAls lCol) (S.mkSIdenExp rCol)
|
|
|
|
|
|
|
|
baseNodeToSel :: S.BoolExp -> BaseNode -> S.Select
|
|
|
|
baseNodeToSel joinCond (BaseNode pfx fromItem whr ordByM limitM offsetM extrs objRels arrRels aggs) =
|
|
|
|
S.mkSelect
|
|
|
|
{ S.selExtr = [S.Extractor e $ Just a | (a, e) <- HM.toList extrs]
|
|
|
|
, S.selFrom = Just $ S.FromExp [joinedFrom]
|
|
|
|
, S.selOrderBy = ordByM
|
|
|
|
, S.selLimit = S.LimitExp . S.intToSQLExp <$> limitM
|
|
|
|
, S.selOffset = S.OffsetExp <$> offsetM
|
|
|
|
}
|
|
|
|
where
|
|
|
|
-- this is the table which is aliased as "pfx.base"
|
|
|
|
baseSel = S.mkSelect
|
|
|
|
{ S.selExtr = [S.Extractor S.SEStar Nothing]
|
|
|
|
, S.selFrom = Just $ S.FromExp [fromItem]
|
|
|
|
, S.selWhere = Just $ injectJoinCond joinCond whr
|
|
|
|
}
|
|
|
|
baseSelAls = S.Alias $ mkBaseTableAls pfx
|
|
|
|
baseFromItem = S.FISelect (S.Lateral False) baseSel baseSelAls
|
|
|
|
|
|
|
|
-- function to create a joined from item from two from items
|
|
|
|
leftOuterJoin current new =
|
|
|
|
S.FIJoin $ S.JoinExpr current S.LeftOuter new $
|
|
|
|
S.JoinOn $ S.BELit True
|
|
|
|
|
|
|
|
-- this is the from eexp for the final select
|
|
|
|
joinedFrom :: S.FromItem
|
|
|
|
joinedFrom = foldl' leftOuterJoin baseFromItem $
|
|
|
|
map objRelToFromItem (HM.elems objRels) <>
|
|
|
|
map arrRelToFromItem (HM.elems arrRels) <>
|
|
|
|
map aggToFromItem (HM.toList aggs)
|
|
|
|
|
|
|
|
objRelToFromItem :: RelNode -> S.FromItem
|
|
|
|
objRelToFromItem (RelNode _ _ relMapn relBaseNode) =
|
|
|
|
let als = S.Alias $ _bnPrefix relBaseNode
|
|
|
|
sel = baseNodeToSel (mkJoinCond baseSelAls relMapn) relBaseNode
|
|
|
|
in S.mkLateralFromItem sel als
|
|
|
|
|
|
|
|
arrRelToFromItem :: RelNode -> S.FromItem
|
|
|
|
arrRelToFromItem (RelNode _ relFld relMapn relBaseNode) =
|
|
|
|
let als = S.Alias $ _bnPrefix relBaseNode
|
|
|
|
fldAls = S.Alias $ toIden relFld
|
|
|
|
sel = asJsonAggSel False fldAls (mkJoinCond baseSelAls relMapn) relBaseNode
|
|
|
|
in S.mkLateralFromItem sel als
|
|
|
|
|
|
|
|
aggToFromItem :: (S.Alias, AggNode) -> S.FromItem
|
|
|
|
aggToFromItem (als, AggNode colMapn extr bn) =
|
|
|
|
let sel = aggNodeToSelect bn extr (mkJoinCond baseSelAls colMapn)
|
|
|
|
in S.mkLateralFromItem sel als
|