graphql-engine/server/src-lib/Hasura/RQL/DML/Select/Internal.hs

module Hasura.RQL.DML.Select.Internal
  ( mkSQLSelect
  , mkAggSelect
  , module Hasura.RQL.DML.Select.Types
  )
where

import           Control.Lens                hiding (op)
import           Data.List                   (delete, sort)
import           Instances.TH.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.DML.Select.Types
import           Hasura.RQL.GBoolExp
import           Hasura.RQL.Types
import           Hasura.SQL.Rewrite          (prefixNumToAliases)
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

functionToIden :: QualifiedFunction -> Iden
functionToIden = Iden . qualObjectToText

selFromToFromItem :: Iden -> SelectFrom -> S.FromItem
selFromToFromItem pfx = \case
  FromTable tn -> S.FISimple tn Nothing
  FromIden i   -> S.FIIden i
  FromFunction qf args defListM ->
    S.FIFunc $ S.FunctionExp qf (fromTableRowArgs pfx args) $
    Just $ S.mkFunctionAlias (functionToIden qf) defListM

-- This function shouldn't be present ideally
-- You should be able to retrieve this information
-- from the FromItem generated with selFromToFromItem
-- however given from S.FromItem is modelled, it is not
-- possible currently
selFromToQual :: SelectFrom -> S.Qual
selFromToQual = \case
  FromTable tn         -> S.QualTable tn
  FromIden i           -> S.QualIden i Nothing
  FromFunction qf _ _  -> S.QualIden (functionToIden qf) Nothing

aggFldToExp :: AggFlds -> S.SQLExp
aggFldToExp aggFlds = jsonRow
  where
    jsonRow = S.applyJsonBuildObj (concatMap aggToFlds aggFlds)
    withAls fldName sqlExp = [S.SELit fldName, sqlExp]
    aggToFlds (FieldName t, fld) = withAls t $ case fld of
      AFCount cty -> S.SECount cty
      AFOp aggOp  -> aggOpToObj aggOp
      AFExp e     -> S.SELit e

    aggOpToObj (AggOp op flds) =
      S.applyJsonBuildObj $ concatMap (colFldsToExtr op) flds

    colFldsToExtr op (FieldName t, PCFCol col) =
      [ S.SELit t
      , S.SEFnApp op [S.SEIden $ toIden col] Nothing
      ]
    colFldsToExtr _ (FieldName t, PCFExp e) =
      [ S.SELit t , S.SELit e]

arrNodeToSelect :: BaseNode -> [S.Extractor] -> S.BoolExp -> S.Select
arrNodeToSelect bn extrs joinCond =
  S.mkSelect
    { S.selExtr = extrs
    , S.selFrom = Just $ S.FromExp [selFrom]
    }
  where
    selFrom = S.mkSelFromItem (baseNodeToSel joinCond bn) $ S.Alias $
              _bnPrefix bn

asSingleRowExtr :: S.Alias -> S.SQLExp
asSingleRowExtr col =
  S.SEFnApp "coalesce" [jsonAgg, S.SELit "null"] Nothing
  where
    jsonAgg = S.SEOpApp (S.SQLOp "->")
              [ S.SEFnApp "json_agg" [S.SEIden $ toIden col] Nothing
              , S.SEUnsafe "0"
              ]

withJsonAggExtr
  :: Bool -> Maybe Int -> Maybe S.OrderByExp -> S.Alias -> S.SQLExp
withJsonAggExtr subQueryReq permLimitM ordBy alias =
  -- if select has aggregations then use subquery to apply permission limit
  if subQueryReq then maybe simpleJsonAgg withPermLimit permLimitM
  else simpleJsonAgg
  where
    simpleJsonAgg = mkSimpleJsonAgg rowIdenExp ordBy
    rowIdenExp = S.SEIden $ S.getAlias alias
    subSelAls = Iden "sub_query"
    unnestTable = Iden "unnest_table"

    mkSimpleJsonAgg rowExp ob =
      let jsonAggExp = S.SEFnApp "json_agg" [rowExp] ob
      in S.SEFnApp "coalesce" [jsonAggExp, S.SELit "[]"] Nothing

    withPermLimit limit =
      let subSelect = mkSubSelect limit
          rowIden = S.mkQIdenExp subSelAls alias
          extr = S.Extractor (mkSimpleJsonAgg rowIden newOrdBy) Nothing
          fromExp = S.FromExp $ pure $
                    S.mkSelFromItem subSelect $ S.Alias subSelAls
      in S.SESelect $ S.mkSelect { S.selExtr = pure extr
                                 , S.selFrom = Just fromExp
                                 }

    mkSubSelect limit =
      let jsonRowExtr = flip S.Extractor (Just alias) $
                        S.mkQIdenExp unnestTable alias
          obExtrs = flip map newOBAliases $ \a ->
                    S.Extractor (S.mkQIdenExp unnestTable a) $ Just $ S.Alias a
      in S.mkSelect { S.selExtr    = jsonRowExtr : obExtrs
                    , S.selFrom    = Just $ S.FromExp $ pure unnestFromItem
                    , S.selLimit   = Just $ S.LimitExp $ S.intToSQLExp limit
                    , S.selOrderBy = newOrdBy
                    }

    unnestFromItem =
      let arrayAggItems = flip map (rowIdenExp : obCols) $
                          \s -> S.SEFnApp "array_agg" [s] Nothing
      in S.FIUnnest arrayAggItems (S.Alias unnestTable) $
         rowIdenExp : map S.SEIden newOBAliases

    newOrdBy = bool (Just $ S.OrderByExp newOBItems) Nothing $ null newOBItems

    (newOBItems, obCols, newOBAliases) = maybe ([], [], []) transformOrdBy ordBy
    transformOrdBy (S.OrderByExp l) = unzip3 $
      flip map (zip l [1..]) $ \(obItem, i::Int) ->
                 let iden = Iden $ "ob_col_" <> T.pack (show i)
                 in ( obItem{S.oColumn = S.SEIden iden}
                    , S.oColumn obItem
                    , iden
                    )

asJsonAggExtr
  :: JsonAggSelect -> S.Alias -> Bool -> Maybe Int -> Maybe S.OrderByExp -> S.Extractor
asJsonAggExtr jsonAggSelect als subQueryReq permLimit ordByExpM =
  flip S.Extractor (Just als) $ case jsonAggSelect of
    JASMultipleRows -> withJsonAggExtr subQueryReq permLimit ordByExpM als
    JASSingleObject -> asSingleRowExtr als

-- array relationships are not grouped, so have to be prefixed by
-- parent's alias
mkUniqArrRelAls :: FieldName -> [FieldName] -> Iden
mkUniqArrRelAls parAls flds =
  Iden $
  getFieldNameTxt parAls <> "."
  <> T.intercalate "." (map getFieldNameTxt flds)

mkArrRelTableAls :: Iden -> FieldName -> [FieldName] -> Iden
mkArrRelTableAls pfx parAls flds =
  pfx <> Iden ".ar." <> uniqArrRelAls
  where
    uniqArrRelAls = mkUniqArrRelAls parAls flds

mkObjRelTableAls :: Iden -> RelName -> Iden
mkObjRelTableAls pfx relName =
  pfx <> Iden ".or." <> toIden relName

mkComputedFieldTableAls :: Iden -> FieldName -> Iden
mkComputedFieldTableAls pfx fldAls =
  pfx <> Iden ".cf." <> toIden fldAls

mkBaseTableAls :: Iden -> Iden
mkBaseTableAls pfx =
  pfx <> Iden ".base"

mkBaseTableColAls :: Iden -> PGCol -> Iden
mkBaseTableColAls pfx pgColumn =
  pfx <> Iden ".pg." <> toIden pgColumn

mkOrderByFieldName :: RelName -> FieldName
mkOrderByFieldName relName =
  FieldName $ relNameToTxt relName <> "." <> "order_by"

fromTableRowArgs
  :: Iden -> FunctionArgsExpTableRow S.SQLExp -> S.FunctionArgs
fromTableRowArgs pfx = toFunctionArgs . fmap toSQLExp
  where
    toFunctionArgs (FunctionArgsExp positional named) =
      S.FunctionArgs positional named
    toSQLExp (AETableRow Nothing)    = S.SERowIden $ mkBaseTableAls pfx
    toSQLExp (AETableRow (Just acc)) = S.mkQIdenExp (mkBaseTableAls pfx) acc
    toSQLExp (AESession s)           = s
    toSQLExp (AEInput s)             = s

-- 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 -> ArrRelCtx -> Bool
  -> [(FieldName, AnnFld)] -> (S.Alias, S.SQLExp)
buildJsonObject pfx parAls arrRelCtx strfyNum 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 :: (FieldName -> S.SQLExp -> f)
             -> (FieldName, AnnFld) -> f
    toSQLFld f (fldAls, fld) = f fldAls $ case fld of
      FCol c      -> toSQLCol c
      FExp e      -> S.SELit e
      FObj objSel ->
        let qual = mkObjRelTableAls pfx $ aarName objSel
        in S.mkQIdenExp qual fldAls
      FArr arrSel      ->
        let arrPfx = _aniPrefix $ mkArrNodeInfo pfx parAls arrRelCtx $
                                  ANIField (fldAls, arrSel)
        in S.mkQIdenExp arrPfx fldAls
      FComputedField (CFSScalar computedFieldScalar) ->
        fromScalarComputedField computedFieldScalar
      FComputedField (CFSTable _ _) ->
        let ccPfx = mkComputedFieldTableAls pfx fldAls
        in S.mkQIdenExp ccPfx fldAls

    toSQLCol :: AnnColField -> S.SQLExp
    toSQLCol (AnnColField col asText colOpM) =
      toJSONableExp strfyNum (pgiType col) asText $ withColOp colOpM $
      S.mkQIdenExp (mkBaseTableAls pfx) $ pgiColumn col

    fromScalarComputedField :: ComputedFieldScalarSel S.SQLExp -> S.SQLExp
    fromScalarComputedField computedFieldScalar =
      toJSONableExp strfyNum (PGColumnScalar ty) False $ withColOp colOpM $
      S.SEFunction $ S.FunctionExp fn (fromTableRowArgs pfx args) Nothing
      where
        ComputedFieldScalarSel fn args ty colOpM = computedFieldScalar

    withColOp :: Maybe ColOp -> S.SQLExp -> S.SQLExp
    withColOp colOpM sqlExp = case colOpM of
      Nothing              -> sqlExp
      Just (ColOp op cExp) -> S.mkSQLOpExp op sqlExp cExp

-- 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

mkAggObFld :: AnnAggOrdBy -> FieldName
mkAggObFld = \case
  AAOCount     -> FieldName "count"
  AAOOp op col -> FieldName $ op <> "." <> getPGColTxt col

mkAggObExtrAndFlds :: AnnAggOrdBy -> (S.Extractor, AggFlds)
mkAggObExtrAndFlds annAggOb = case annAggOb of
  AAOCount       ->
    ( S.Extractor S.countStar als
    , [(FieldName "count", AFCount S.CTStar)]
    )
  AAOOp op pgColumn ->
    ( S.Extractor (S.SEFnApp op [S.SEIden $ toIden pgColumn] Nothing) als
    , [(FieldName op, AFOp $ AggOp op [(fromPGCol pgColumn, PCFCol pgColumn)])]
    )
  where
    als = Just $ S.toAlias $ mkAggObFld annAggOb

processAnnOrderByItem
  :: Iden
  -> FieldName
  -> ArrRelCtx
  -> Bool
  -> 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
       -- extra nodes for order by
     , OrderByNode
     )
processAnnOrderByItem pfx parAls arrRelCtx strfyNum obItemG =
  ( (obColAls, obColExp)
  , sqlOrdByItem
  , relNodeM
  )
  where
    OrderByItemG obTyM annObCol obNullsM = obItemG
    ((obColAls, obColExp), relNodeM) =
      processAnnOrderByCol pfx parAls arrRelCtx strfyNum annObCol

    sqlOrdByItem =
      S.OrderByItem (S.SEIden $ toIden obColAls)
      (unOrderType <$> obTyM) (unNullsOrder <$> obNullsM)

processAnnOrderByCol
  :: Iden
  -> FieldName
  -> ArrRelCtx
  -> Bool
  -> AnnObCol
       -- the extractors which will select the needed columns
  -> ( (S.Alias, S.SQLExp)
       -- extra nodes for order by
     , OrderByNode
     )
processAnnOrderByCol pfx parAls arrRelCtx strfyNum = \case
  AOCPG pgColumn ->
    let
      qualCol  = S.mkQIdenExp (mkBaseTableAls pfx) (toIden pgColumn)
      obColAls = mkBaseTableColAls pfx pgColumn
    in ( (S.Alias obColAls, qualCol)
       , OBNNothing
       )
  -- "pfx.or.relname"."pfx.ob.or.relname.rest" AS "pfx.ob.or.relname.rest"
  AOCObj (RelInfo rn _ colMapping relTab _) relFltr rest ->
    let relPfx  = mkObjRelTableAls pfx rn
        ordByFldName = mkOrderByFieldName rn
        ((nesAls, nesCol), ordByNode) =
          processAnnOrderByCol relPfx ordByFldName emptyArrRelCtx strfyNum rest
        (objNodeM, arrNodeM) = case ordByNode of
          OBNNothing           -> (Nothing, Nothing)
          OBNObjNode name node -> (Just (name, node), Nothing)
          OBNArrNode als node  -> (Nothing, Just (als, node))
        qualCol = S.mkQIdenExp relPfx nesAls
        relBaseNode =
          BaseNode relPfx Nothing (S.FISimple relTab Nothing)
          (toSQLBoolExp (S.QualTable relTab) relFltr)
          Nothing Nothing Nothing
          (HM.singleton nesAls nesCol)
          (maybe HM.empty (uncurry HM.singleton) objNodeM)
          (maybe HM.empty (uncurry HM.singleton) arrNodeM)
          HM.empty
        relNode = ObjNode colMapping relBaseNode
    in ( (nesAls, qualCol)
       , OBNObjNode rn relNode
       )
  AOCAgg (RelInfo rn _ colMapping relTab _ ) relFltr annAggOb ->
    let ArrNodeInfo arrAls arrPfx _ =
          mkArrNodeInfo pfx parAls arrRelCtx $ ANIAggOrdBy rn
        fldName = mkAggObFld annAggOb
        qOrdBy = S.mkQIdenExp arrPfx $ toIden fldName
        tabFrom = FromTable relTab
        tabPerm = TablePerm relFltr Nothing
        (extr, arrFlds) = mkAggObExtrAndFlds annAggOb
        selFld = TAFAgg arrFlds
        bn = mkBaseNode False (Prefixes arrPfx pfx) fldName selFld tabFrom
             tabPerm noTableArgs strfyNum
        aggNode = ArrNode [extr] colMapping $ mergeBaseNodes bn $
                  mkEmptyBaseNode arrPfx tabFrom
        obAls = arrPfx <> Iden "." <> toIden fldName
    in ( (S.Alias obAls, qOrdBy)
       , OBNArrNode arrAls aggNode
       )

processDistinctOnCol
  :: Iden
  -> NE.NonEmpty PGCol
  -> ( S.DistinctExpr
     -- additional column extractors
     , [(S.Alias, S.SQLExp)]
     )
processDistinctOnCol pfx neCols = (distOnExp, colExtrs)
  where
    cols = toList neCols
    distOnExp = S.DistinctOn $ map (S.SEIden . toIden . mkQColAls) cols
    mkQCol c = S.mkQIdenExp (mkBaseTableAls pfx) $ toIden c
    mkQColAls = S.Alias . mkBaseTableColAls pfx
    colExtrs = flip map cols $ mkQColAls &&& mkQCol


mkEmptyBaseNode :: Iden -> SelectFrom -> BaseNode
mkEmptyBaseNode pfx selectFrom =
  BaseNode pfx Nothing 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")
    fromItem = selFromToFromItem pfx selectFrom

aggSelToArrNode :: Prefixes -> FieldName -> ArrRelAgg -> ArrNode
aggSelToArrNode pfxs als aggSel =
  ArrNode [extr] colMapping mergedBN
  where
    AnnRelG _ colMapping annSel = aggSel
    AnnSelG aggFlds tabFrm tabPerm tabArgs strfyNum = annSel
    fldAls = S.Alias $ toIden als

    extr = flip S.Extractor (Just fldAls) $ S.applyJsonBuildObj $
           concatMap selFldToExtr aggFlds

    permLimit = _tpLimit tabPerm
    ordBy = _bnOrderBy mergedBN

    allBNs = map mkAggBaseNode aggFlds
    emptyBN = mkEmptyBaseNode (_pfThis pfxs) tabFrm
    mergedBN = foldr mergeBaseNodes emptyBN allBNs

    mkAggBaseNode (fn, selFld) =
      mkBaseNode subQueryReq pfxs fn selFld tabFrm tabPerm tabArgs strfyNum

    selFldToExtr (FieldName t, fld) = (:) (S.SELit t) $ pure $ case fld of
      TAFAgg flds -> aggFldToExp flds
      TAFNodes _  ->
        withJsonAggExtr subQueryReq permLimit ordBy $ S.Alias $ Iden t
      TAFExp e    ->
        -- bool_or to force aggregation
        S.SEFnApp "coalesce"
        [ S.SELit e , S.SEUnsafe "bool_or('true')::text"] Nothing

    subQueryReq = hasAggFld aggFlds

hasAggFld :: Foldable t => t (a, TableAggFldG v) -> Bool
hasAggFld = any (isTabAggFld . snd)
  where
    isTabAggFld (TAFAgg _) = True
    isTabAggFld _          = False

mkArrNodeInfo
  :: Iden
  -> FieldName
  -> ArrRelCtx
  -> ArrNodeItem
  -> ArrNodeInfo
mkArrNodeInfo pfx parAls (ArrRelCtx arrFlds obRels) = \case
  ANIField aggFld@(fld, annArrSel) ->
    let (rn, tabArgs) = fetchRNAndTArgs annArrSel
        similarFlds = getSimilarAggFlds rn tabArgs $ delete aggFld
        similarFldNames = map fst similarFlds
        similarOrdByFound = rn `elem` obRels && tabArgs == noTableArgs
        ordByFldName = mkOrderByFieldName rn
        extraOrdByFlds = bool [] [ordByFldName] similarOrdByFound
        sortedFlds = sort $ fld : (similarFldNames <> extraOrdByFlds)
        alias = S.Alias $ mkUniqArrRelAls parAls sortedFlds
        prefix = mkArrRelTableAls pfx parAls sortedFlds
    in ArrNodeInfo alias prefix $
       subQueryRequired similarFlds similarOrdByFound
  ANIAggOrdBy rn ->
    let similarFlds = map fst $ getSimilarAggFlds rn noTableArgs id
        ordByFldName = mkOrderByFieldName rn
        sortedFlds = sort $ ordByFldName:similarFlds
        alias = S.Alias $ mkUniqArrRelAls parAls sortedFlds
        prefix = mkArrRelTableAls pfx parAls sortedFlds
    in ArrNodeInfo alias prefix False
  where
    getSimilarAggFlds rn tabArgs f =
      flip filter (f arrFlds) $ \(_, annArrSel) ->
        let (lrn, lTabArgs) = fetchRNAndTArgs annArrSel
        in (lrn == rn) && (lTabArgs == tabArgs)

    subQueryRequired similarFlds hasSimOrdBy =
      hasSimOrdBy || any hasAgg similarFlds

    hasAgg (_, ASSimple _)                 = False
    hasAgg (_, ASAgg (AnnRelG _ _ annSel)) = hasAggFld $ _asnFields annSel

    fetchRNAndTArgs (ASSimple (AnnRelG rn _ annSel)) =
      (rn, _asnArgs annSel)
    fetchRNAndTArgs (ASAgg (AnnRelG rn _ annSel)) =
      (rn, _asnArgs annSel)

fetchOrdByAggRels
  :: Maybe (NE.NonEmpty AnnOrderByItem)
  -> [RelName]
fetchOrdByAggRels orderByM = fromMaybe [] relNamesM
  where
    relNamesM =
      mapMaybe (fetchAggOrdByRels . obiColumn) . toList <$> orderByM

    fetchAggOrdByRels (AOCAgg ri _ _) = Just $ riName ri
    fetchAggOrdByRels _               = Nothing

mkOrdByItems
  :: Iden -> FieldName
  -> Maybe (NE.NonEmpty AnnOrderByItem)
  -> Bool
  -> ArrRelCtx
     -- extractors
  -> ( [(S.Alias, S.SQLExp)]
     -- object relation nodes
     , HM.HashMap RelName ObjNode
     -- array relation aggregate nodes
     , HM.HashMap S.Alias ArrNode
     -- final order by expression
     , Maybe S.OrderByExp
     )
mkOrdByItems pfx fldAls orderByM strfyNum arrRelCtx =
  (obExtrs, ordByObjsMap, ordByArrsMap, ordByExpM)
  where
    procAnnOrdBy' = processAnnOrderByItem pfx fldAls arrRelCtx strfyNum
    procOrdByM =
      unzip3 . map procAnnOrdBy' . toList <$> orderByM

    obExtrs  = maybe [] (^. _1) procOrdByM
    ordByExpM  = S.OrderByExp . (^. _2) <$> procOrdByM

    ordByObjs = mapMaybe getOrdByRelNode $ maybe [] (^. _3) procOrdByM
    ordByObjsMap = HM.fromListWith mergeObjNodes ordByObjs

    ordByAggArrs = mapMaybe getOrdByAggNode $ maybe [] (^. _3) procOrdByM
    ordByArrsMap = HM.fromListWith mergeArrNodes ordByAggArrs

    getOrdByRelNode (OBNObjNode name node) = Just (name, node)
    getOrdByRelNode _                      = Nothing

    getOrdByAggNode (OBNArrNode als node) = Just (als, node)
    getOrdByAggNode _                     = Nothing

mkBaseNode
  :: Bool
  -> Prefixes
  -> FieldName
  -> TableAggFld
  -> SelectFrom
  -> TablePerm
  -> TableArgs
  -> Bool
  -> BaseNode
mkBaseNode subQueryReq pfxs fldAls annSelFlds selectFrom
           tablePerm tableArgs strfyNum =
  BaseNode thisPfx distExprM fromItem finalWhere ordByExpM finalLimit offsetM
  allExtrs allObjsWithOb allArrsWithOb computedFields
  where
    Prefixes thisPfx baseTablepfx = pfxs
    TablePerm permFilter permLimit = tablePerm
    TableArgs whereM orderByM inpLimitM offsetM distM = tableArgs

    -- if sub query is used, then only use input limit
    --    because permission limit is being applied in subquery
    -- else compare input and permission limits
    finalLimit =
      if subQueryReq then inpLimitM
      else withPermLimit

    withPermLimit =
      case (inpLimitM, permLimit) of
        (inpLim, Nothing)     -> inpLim
        (Nothing, permLim)    -> permLim
        (Just inp, Just perm) -> Just $ if inp < perm then inp else perm


    aggOrdByRelNames = fetchOrdByAggRels orderByM

    (allExtrs, allObjsWithOb, allArrsWithOb, computedFields, ordByExpM) =
      case annSelFlds of
        TAFNodes flds ->
          let arrFlds = mapMaybe getAnnArr flds
              arrRelCtx = mkArrRelCtx arrFlds
              selExtr = buildJsonObject thisPfx fldAls arrRelCtx strfyNum flds
              -- all object relationships
              objNodes = HM.fromListWith mergeObjNodes $
                        map mkObjItem (mapMaybe getAnnObj flds)
              -- all array items (array relationships + aggregates)
              arrNodes = HM.fromListWith mergeArrNodes $
                         map (mkArrItem arrRelCtx) arrFlds
              -- all computed fields with table returns
              computedFieldNodes = HM.fromList $ map mkComputedFieldTable $
                                   mapMaybe getComputedFieldTable flds

              (obExtrs, ordByObjs, ordByArrs, obeM)
                      = mkOrdByItems' arrRelCtx
              allObjs = HM.unionWith mergeObjNodes objNodes ordByObjs
              allArrs = HM.unionWith mergeArrNodes arrNodes ordByArrs

          in ( HM.fromList $ selExtr:obExtrs <> distExtrs
             , allObjs
             , allArrs
             , computedFieldNodes
             , obeM
             )
        TAFAgg tabAggs ->
          let extrs = concatMap (fetchExtrFromAggFld . snd) tabAggs
              (obExtrs, ordByObjs, ordByArrs, obeM)
                      = mkOrdByItems' emptyArrRelCtx
          in ( HM.fromList $ extrs <> obExtrs <> distExtrs
             , ordByObjs
             , ordByArrs
             , HM.empty
             , obeM
             )
        TAFExp _ ->
          let (obExtrs, ordByObjs, ordByArrs, obeM)
                      = mkOrdByItems' emptyArrRelCtx
          in (HM.fromList obExtrs, ordByObjs, ordByArrs, HM.empty, obeM)

    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)

    aggOpToExps = mapMaybe (mkColExp . snd) . _aoFlds

    mkColExp (PCFCol c) =
      let qualCol = S.mkQIdenExp (mkBaseTableAls thisPfx) (toIden c)
          colAls = toIden c
      in Just (S.Alias colAls, qualCol)
    mkColExp _ = Nothing

    finalWhere = toSQLBoolExp tableQual $
                 maybe permFilter (andAnnBoolExps permFilter) whereM
    fromItem = selFromToFromItem baseTablepfx selectFrom
    tableQual = selFromToQual selectFrom

    mkArrRelCtx arrSels = ArrRelCtx arrSels aggOrdByRelNames

    mkOrdByItems' = mkOrdByItems thisPfx fldAls orderByM strfyNum

    distItemsM = processDistinctOnCol thisPfx <$> distM
    distExprM = fst <$> distItemsM
    distExtrs = maybe [] snd distItemsM

    -- process an object relationship
    mkObjItem (fld, objSel) =
      let relName = aarName objSel
          objNodePfx = mkObjRelTableAls thisPfx $ aarName objSel
          objNode = mkObjNode (Prefixes objNodePfx thisPfx) (fld, objSel)
      in (relName, objNode)

    -- process an array/array-aggregate item
    mkArrItem arrRelCtx (fld, arrSel) =
      let ArrNodeInfo arrAls arrPfx subQReq =
            mkArrNodeInfo thisPfx fldAls arrRelCtx $ ANIField (fld, arrSel)
          arrNode = mkArrNode subQReq (Prefixes arrPfx thisPfx) (fld, arrSel)
      in (arrAls, arrNode)

    -- process a computed field, which returns a table
    mkComputedFieldTable (fld, jsonAggSelect, sel) =
      let prefixes = Prefixes (mkComputedFieldTableAls thisPfx fld) thisPfx
          baseNode = annSelToBaseNode False prefixes fld sel
      in (fld, CFTableNode jsonAggSelect baseNode)

    getAnnObj (f, annFld) = case annFld of
      FObj ob -> Just (f, ob)
      _       -> Nothing

    getAnnArr (f, annFld) = case annFld of
      FArr ar -> Just (f, ar)
      _       -> Nothing

    getComputedFieldTable (f, annFld) = case annFld of
      FComputedField (CFSTable jas sel) -> Just (f, jas, sel)
      _                                 -> Nothing

annSelToBaseNode :: Bool -> Prefixes -> FieldName -> AnnSimpleSel -> BaseNode
annSelToBaseNode subQueryReq pfxs fldAls annSel =
  mkBaseNode subQueryReq pfxs fldAls (TAFNodes selFlds) tabFrm tabPerm tabArgs strfyNum
  where
    AnnSelG selFlds tabFrm tabPerm tabArgs strfyNum = annSel

mkObjNode :: Prefixes -> (FieldName, ObjSel) -> ObjNode
mkObjNode pfxs (fldName, AnnRelG _ rMapn rAnnSel) =
  ObjNode rMapn $ annSelToBaseNode False pfxs fldName rAnnSel

mkArrNode :: Bool -> Prefixes -> (FieldName, ArrSel) -> ArrNode
mkArrNode subQueryReq pfxs (fldName, annArrSel) = case annArrSel of
  ASSimple annArrRel ->
    let bn = annSelToBaseNode subQueryReq pfxs fldName $ aarAnnSel annArrRel
        permLimit = getPermLimit $ aarAnnSel annArrRel
        extr = asJsonAggExtr JASMultipleRows (S.toAlias fldName) subQueryReq permLimit $
               _bnOrderBy bn
    in ArrNode [extr] (aarMapping annArrRel) bn

  ASAgg annAggSel -> aggSelToArrNode pfxs fldName annAggSel

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 -> HashMap PGCol PGCol -> S.BoolExp
mkJoinCond baseTablepfx colMapn =
  foldl' (S.BEBin S.AndOp) (S.BELit True) $ flip map (HM.toList colMapn) $ \(lCol, rCol) ->
    S.BECompare S.SEQ (S.mkQIdenExp baseTablepfx lCol) (S.mkSIdenExp rCol)

baseNodeToSel :: S.BoolExp -> BaseNode -> S.Select
baseNodeToSel joinCond baseNode =
  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
  , S.selDistinct = dExp
  }
  where
    BaseNode pfx dExp fromItem whr ordByM limitM
             offsetM extrs objRels arrRels computedFields
             = baseNode
    -- this is the table which is aliased as "pfx.base"
    baseSel = S.mkSelect
      { S.selExtr  = [S.Extractor (S.SEStar Nothing) Nothing]
      , S.selFrom  = Just $ S.FromExp [fromItem]
      , S.selWhere = Just $ injectJoinCond joinCond whr
      }
    baseSelAls = S.Alias $ mkBaseTableAls pfx
    baseFromItem = S.mkSelFromItem 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 objNodeToFromItem (HM.elems objRels) <>
                 map arrNodeToFromItem (HM.elems arrRels) <>
                 map computedFieldNodeToFromItem (HM.toList computedFields)

    objNodeToFromItem :: ObjNode -> S.FromItem
    objNodeToFromItem (ObjNode relMapn relBaseNode) =
      let als = S.Alias $ _bnPrefix relBaseNode
          sel = baseNodeToSel (mkJoinCond baseSelAls relMapn) relBaseNode
      in S.mkLateralFromItem sel als

    arrNodeToFromItem :: ArrNode -> S.FromItem
    arrNodeToFromItem (ArrNode es colMapn bn) =
      let sel = arrNodeToSelect bn es (mkJoinCond baseSelAls colMapn)
          als = S.Alias $ _bnPrefix bn
      in S.mkLateralFromItem sel als

    computedFieldNodeToFromItem :: (FieldName, CFTableNode) -> S.FromItem
    computedFieldNodeToFromItem (fld, CFTableNode jsonAggSelect bn) =
      let internalSel = baseNodeToSel (S.BELit True) bn
          als = S.Alias $ _bnPrefix bn
          extr = asJsonAggExtr jsonAggSelect (S.toAlias fld) False Nothing $
                 _bnOrderBy bn
          internalSelFrom = S.mkSelFromItem internalSel als
          sel = S.mkSelect
                { S.selExtr = pure extr
                , S.selFrom = Just $ S.FromExp [internalSelFrom]
                }
      in S.mkLateralFromItem sel als

mkAggSelect :: AnnAggSel -> S.Select
mkAggSelect annAggSel =
  prefixNumToAliases $ arrNodeToSelect bn extr $ S.BELit True
  where
    aggSel = AnnRelG rootRelName HM.empty annAggSel
    rootIden = Iden "root"
    rootPrefix = Prefixes rootIden rootIden
    ArrNode extr _ bn =
      aggSelToArrNode rootPrefix (FieldName "root") aggSel

mkSQLSelect :: JsonAggSelect -> AnnSimpleSel -> S.Select
mkSQLSelect jsonAggSelect annSel =
  prefixNumToAliases $ arrNodeToSelect baseNode extrs $ S.BELit True
  where
    permLimit = getPermLimit annSel
    extrs = pure $ asJsonAggExtr jsonAggSelect rootFldAls False permLimit
            $ _bnOrderBy baseNode
    rootFldIden = toIden rootFldName
    rootPrefix = Prefixes rootFldIden rootFldIden
    baseNode = annSelToBaseNode False rootPrefix rootFldName annSel
    rootFldName = FieldName "root"
    rootFldAls  = S.Alias $ toIden rootFldName