{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE DerivingVia #-}
module PgSchema.DML.Select where

import Control.Monad.RWS
import Control.Monad
import Data.Bifunctor
import Data.Foldable as F
import Data.Functor
import Data.List as L
import Data.List.NonEmpty as NE
import Data.Maybe
import Data.Monoid
import Data.Singletons
import Data.String
import Data.Text as T
import Data.Tuple
import PgSchema.DML.Select.Types
import PgSchema.Ann
import Database.PostgreSQL.Simple hiding(In(..))
import Database.PostgreSQL.Simple.Types(PGArray(..))
import PgSchema.Schema
import GHC.Generics
import GHC.TypeLits
import PgSchema.Types
import PgSchema.Utils.Internal
import PgSchema.Utils.TF (Snd)
import Prelude as P


data QueryRead sch t = QueryRead
  { forall sch (t :: NameNSK). QueryRead sch t -> Int
qrCurrTabNum  :: Int
  , forall sch (t :: NameNSK). QueryRead sch t -> [Text]
qrPath        :: [Text]
  , forall sch (t :: NameNSK). QueryRead sch t -> QueryParam sch t
qrParam       :: QueryParam sch t }

data ParentInfo = ParentInfo
  { ParentInfo -> Text
piRelDbName   :: Text
  , ParentInfo -> Int
piFromNum     :: Int
  , ParentInfo -> Int
piToNum       :: Int
  , ParentInfo -> NameNS
piParentTab   :: NameNS
  , ParentInfo -> [Ref' Text]
piRefs        :: [Ref' Text]
  , ParentInfo -> [Text]
piPath        :: [Text] }
  deriving Int -> ParentInfo -> ShowS
[ParentInfo] -> ShowS
ParentInfo -> String
(Int -> ParentInfo -> ShowS)
-> (ParentInfo -> String)
-> ([ParentInfo] -> ShowS)
-> Show ParentInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParentInfo -> ShowS
showsPrec :: Int -> ParentInfo -> ShowS
$cshow :: ParentInfo -> String
show :: ParentInfo -> String
$cshowList :: [ParentInfo] -> ShowS
showList :: [ParentInfo] -> ShowS
Show

data QueryState = QueryState
  { QueryState -> Int
qsLastTabNum  :: Int
  , QueryState -> [ParentInfo]
qsParents     :: [ParentInfo] }
  deriving Int -> QueryState -> ShowS
[QueryState] -> ShowS
QueryState -> String
(Int -> QueryState -> ShowS)
-> (QueryState -> String)
-> ([QueryState] -> ShowS)
-> Show QueryState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryState -> ShowS
showsPrec :: Int -> QueryState -> ShowS
$cshow :: QueryState -> String
show :: QueryState -> String
$cshowList :: [QueryState] -> ShowS
showList :: [QueryState] -> ShowS
Show

type MonadQuery sch t m = (MonadRWS (QueryRead sch t) [SomeToField] QueryState m)

type Selectable ann r = (CRecInfo ann r, FromRow (PgTag ann r))

-- | Run a single @SELECT@ for root table @tab@ (see annotation @ann@ with schema
-- @sch@ and 'Renamer' @ren@) and decode rows into @[r]@, also returning the SQL
-- text and bind parameters (for tracing or debugging).
--
-- The desired result type @r@ /fixes the shape/ of each row: typically a record
-- with columns of the root table and nested Haskell values for relations along the
-- schema graph. There may be several /child/-side fields (often lists of nested
-- records) and several /parent/-side fields (nested records; wrapped in 'Maybe'
-- when the foreign-key side you join from allows NULL).
--
-- What actually appears in the generated SQL beyond that shape is controlled by
-- the 'QueryParam': filters, which paths are traversed, ordering on a branch
-- (e.g. child rows sorted by their position number), limits, and similar options.
-- You only configure in 'QueryParam' what you need for this query—not every
-- possible relation field in @r@.
--
-- Build 'QueryParam' with the 'MonadQP' API.
--
selectSch :: forall ann -> forall r. (Selectable ann r, ann ~ 'Ann ren sch d tab)
  => Connection -> QueryParam sch tab -> IO ([r], (Text,[SomeToField]))
selectSch :: forall (ren :: Renamer) sch (d :: Natural) (tab :: NameNSK).
forall (ann :: Ann) ->
forall r.
(Selectable ann r, ann ~ 'Ann ren sch d tab) =>
Connection -> QueryParam sch tab -> IO ([r], (Text, [SomeToField]))
selectSch ann @r Connection
conn (forall (ann :: Ann) ->
forall r.
(CRecInfo ann r, ann ~ 'Ann ren sch d tab) =>
QueryParam sch tab -> (Text, [SomeToField])
forall r.
(CRecInfo ann r, ann ~ 'Ann ren sch d tab) =>
QueryParam sch tab -> (Text, [SomeToField])
forall (ren :: Renamer) sch (d :: Natural) (tab :: NameNSK).
forall (ann :: Ann) ->
forall r.
(CRecInfo ann r, ann ~ 'Ann ren sch d tab) =>
QueryParam sch tab -> (Text, [SomeToField])
selectText ann @r -> (Text
sql,[SomeToField]
fs)) =
  String
-> IO ([r], (Text, [SomeToField]))
-> IO ([r], (Text, [SomeToField]))
forall a. String -> a -> a
trace' (String
"\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
sql String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [SomeToField] -> String
forall a. Show a => a -> String
P.show [SomeToField]
fs String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n\n")
  (IO ([r], (Text, [SomeToField]))
 -> IO ([r], (Text, [SomeToField])))
-> IO ([r], (Text, [SomeToField]))
-> IO ([r], (Text, [SomeToField]))
forall a b. (a -> b) -> a -> b
$ (,(Text
sql,[SomeToField]
fs)) ([r] -> ([r], (Text, [SomeToField])))
-> ([PgTag ann r] -> [r])
-> [PgTag ann r]
-> ([r], (Text, [SomeToField]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PgTag ann r -> r) -> [PgTag ann r] -> [r]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (s :: k) t. PgTag s t -> t
forall (s :: Ann) t. PgTag s t -> t
unPgTag @ann @r) ([PgTag ann r] -> ([r], (Text, [SomeToField])))
-> IO [PgTag ann r] -> IO ([r], (Text, [SomeToField]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> [SomeToField] -> IO [PgTag ann r]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn (String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
sql) [SomeToField]
fs

-- | Return the generated @SELECT@ SQL text (and bind parameters), e.g. for debugging.
selectText :: forall ann -> forall r. (CRecInfo ann r, ann ~ 'Ann ren sch d tab)
  => QueryParam sch tab -> (Text,[SomeToField])
selectText :: forall (ren :: Renamer) sch (d :: Natural) (tab :: NameNSK).
forall (ann :: Ann) ->
forall r.
(CRecInfo ann r, ann ~ 'Ann ren sch d tab) =>
QueryParam sch tab -> (Text, [SomeToField])
selectText ann @r QueryParam sch tab
qp = RWS (QueryRead sch tab) [SomeToField] QueryState Text
-> QueryRead sch tab -> QueryState -> (Text, [SomeToField])
forall r w s a. RWS r w s a -> r -> s -> (a, w)
evalRWS (Text
-> RecordInfo Text
-> RWS (QueryRead sch tab) [SomeToField] QueryState Text
forall sch (t :: NameNSK) (m :: * -> *).
MonadQuery sch t m =>
Text -> RecordInfo Text -> m Text
selectM Text
"" (forall (ann :: Ann) r. CRecInfo ann r => RecordInfo Text
getRecordInfo @ann @r)) (QueryParam sch tab -> QueryRead sch tab
forall sch (tab :: NameNSK).
QueryParam sch tab -> QueryRead sch tab
qr0 QueryParam sch tab
qp) QueryState
qs0

qr0 :: QueryParam sch tab -> QueryRead sch tab
qr0 :: forall sch (tab :: NameNSK).
QueryParam sch tab -> QueryRead sch tab
qr0 QueryParam sch tab
qrParam = QueryRead
  { qrCurrTabNum :: Int
qrCurrTabNum = Int
0 , qrPath :: [Text]
qrPath = [] , QueryParam sch tab
qrParam :: QueryParam sch tab
qrParam :: QueryParam sch tab
qrParam }

qs0 :: QueryState
qs0 :: QueryState
qs0 = QueryState { qsLastTabNum :: Int
qsLastTabNum = Int
0, qsParents :: [ParentInfo]
qsParents = [] }

two :: (a,b,c) -> (a,b)
two :: forall a b c. (a, b, c) -> (a, b)
two (a
a,b
b,c
_) = (a
a,b
b)

third :: (a,b,c) -> c
third :: forall a b c. (a, b, c) -> c
third (a
_,b
_,c
c) = c
c

jsonPairing :: [(Text, Text)] -> Text
jsonPairing :: [(Text, Text)] -> Text
jsonPairing [(Text, Text)]
fs = Text
"jsonb_build_object(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," [Text]
pairs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    pairs :: [Text]
pairs = ((Text, Text) -> Maybe Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Text
a,Text
b) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) [(Text, Text)]
fs

newtype TextI (s::Symbol) = TextI { forall (s :: Symbol). TextI s -> Text
unTextI :: Text}

instance KnownSymbol s => Semigroup (TextI s) where
  TextI Text
a <> :: TextI s -> TextI s -> TextI s
<> TextI Text
b =
    Text -> TextI s
forall (s :: Symbol). Text -> TextI s
TextI (Text -> TextI s) -> Text -> TextI s
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Symbol). (SingKind Symbol, SingI a) => Demote Symbol
demote @s) ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text
a,Text
b]

instance KnownSymbol s => Monoid (TextI s) where mempty :: TextI s
mempty = Text -> TextI s
forall (s :: Symbol). Text -> TextI s
TextI Text
forall a. Monoid a => a
mempty

selectM :: MonadQuery sch t m => Text -> RecordInfo Text -> m Text
selectM :: forall sch (t :: NameNSK) (m :: * -> *).
MonadQuery sch t m =>
Text -> RecordInfo Text -> m Text
selectM Text
refTxt RecordInfo Text
ri = do
  QueryRead {..} <- m (QueryRead sch t)
forall r (m :: * -> *). MonadReader r m => m r
ask
  (fmap two -> flds) <- traverse fieldM ri.fields
  -- qsParents are collected "in depth" (it is ok for joins etc) but in reverse order
  parents <- gets
    $ fmap (\ParentInfo
p -> ParentInfo
p { piPath = L.reverse p.piPath}) . L.reverse . qsParents
  let
    basePath = [Text] -> [Text]
forall a. [a] -> [a]
L.reverse [Text]
qrPath
    (unTextI -> condText, condPars) = F.fold $ L.reverse
      $ mapMaybe (\(CondWithPath @path Cond sch (TabOnPath sch t path)
cond) -> let p :: Demote [Symbol]
p = forall (a :: [Symbol]).
(SingKind [Symbol], SingI a) =>
Demote [Symbol]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @path in
        if
          | Bool -> Bool
not ([Text]
basePath [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Text]
Demote [Symbol]
p) -> Maybe (TextI " and ", [SomeToField])
forall a. Maybe a
Nothing
          | [Text]
Demote [Symbol]
p [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
basePath -> (TextI " and ", [SomeToField])
-> Maybe (TextI " and ", [SomeToField])
forall a. a -> Maybe a
Just ((TextI " and ", [SomeToField])
 -> Maybe (TextI " and ", [SomeToField]))
-> (TextI " and ", [SomeToField])
-> Maybe (TextI " and ", [SomeToField])
forall a b. (a -> b) -> a -> b
$ (Text -> TextI " and ")
-> (Text, [SomeToField]) -> (TextI " and ", [SomeToField])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> TextI " and "
forall (s :: Symbol). Text -> TextI s
TextI ((Text, [SomeToField]) -> (TextI " and ", [SomeToField]))
-> (Text, [SomeToField]) -> (TextI " and ", [SomeToField])
forall a b. (a -> b) -> a -> b
$ Int -> Cond sch (TabOnPath sch t path) -> (Text, [SomeToField])
forall sch (t :: NameNSK).
Int -> Cond sch t -> (Text, [SomeToField])
pgCond Int
qrCurrTabNum Cond sch (TabOnPath sch t path)
cond
          | Bool
otherwise -> (ParentInfo -> Bool) -> [ParentInfo] -> Maybe ParentInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (([Text]
Demote [Symbol]
p [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
==) ([Text] -> Bool) -> (ParentInfo -> [Text]) -> ParentInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text]
basePath [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text])
-> (ParentInfo -> [Text]) -> ParentInfo -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.piPath)) [ParentInfo]
parents
            Maybe ParentInfo
-> (ParentInfo -> (TextI " and ", [SomeToField]))
-> Maybe (TextI " and ", [SomeToField])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ParentInfo
pari -> (Text -> TextI " and ")
-> (Text, [SomeToField]) -> (TextI " and ", [SomeToField])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall (s :: Symbol). Text -> TextI s
TextI @" and ") ((Text, [SomeToField]) -> (TextI " and ", [SomeToField]))
-> (Text, [SomeToField]) -> (TextI " and ", [SomeToField])
forall a b. (a -> b) -> a -> b
$ Int -> Cond sch (TabOnPath sch t path) -> (Text, [SomeToField])
forall sch (t :: NameNSK).
Int -> Cond sch t -> (Text, [SomeToField])
pgCond ParentInfo
pari.piToNum Cond sch (TabOnPath sch t path)
cond
        ) qrParam.qpConds
    (unTextI -> ordText, ordPars) = F.fold $ L.reverse
      $ mapMaybe (\(OrdWithPath @path [OrdFld sch (TabOnPath sch t path)]
ord) -> let p :: Demote [Symbol]
p = forall (a :: [Symbol]).
(SingKind [Symbol], SingI a) =>
Demote [Symbol]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @path in
        if
          | Bool -> Bool
not ([Text]
basePath [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Text]
Demote [Symbol]
p) -> Maybe (TextI ",", [SomeToField])
forall a. Maybe a
Nothing
          | [Text]
Demote [Symbol]
p [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
basePath -> (TextI ",", [SomeToField]) -> Maybe (TextI ",", [SomeToField])
forall a. a -> Maybe a
Just ((TextI ",", [SomeToField]) -> Maybe (TextI ",", [SomeToField]))
-> (TextI ",", [SomeToField]) -> Maybe (TextI ",", [SomeToField])
forall a b. (a -> b) -> a -> b
$ Int
-> [OrdFld sch (TabOnPath sch t path)]
-> (TextI ",", [SomeToField])
forall {k} (sch :: k) (t :: NameNSK).
Int -> [OrdFld sch t] -> (TextI ",", [SomeToField])
pgOrd Int
qrCurrTabNum [OrdFld sch (TabOnPath sch t path)]
ord
          | Bool
otherwise -> (ParentInfo -> Bool) -> [ParentInfo] -> Maybe ParentInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (([Text]
Demote [Symbol]
p [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
==) ([Text] -> Bool) -> (ParentInfo -> [Text]) -> ParentInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text]
basePath [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text])
-> (ParentInfo -> [Text]) -> ParentInfo -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.piPath)) [ParentInfo]
parents
            Maybe ParentInfo
-> (ParentInfo -> (TextI ",", [SomeToField]))
-> Maybe (TextI ",", [SomeToField])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ParentInfo
pari -> Int
-> [OrdFld sch (TabOnPath sch t path)]
-> (TextI ",", [SomeToField])
forall {k} (sch :: k) (t :: NameNSK).
Int -> [OrdFld sch t] -> (TextI ",", [SomeToField])
pgOrd ParentInfo
pari.piToNum [OrdFld sch (TabOnPath sch t path)]
ord
        ) qrParam.qpOrds
    (distTexts, distPars) = F.fold $ L.reverse
      $ mapMaybe (\(DistWithPath @path Dist sch (TabOnPath sch t path)
dist) -> let p :: Demote [Symbol]
p = forall (a :: [Symbol]).
(SingKind [Symbol], SingI a) =>
Demote [Symbol]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @path in
        if
          | Bool -> Bool
not ([Text]
basePath [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Text]
Demote [Symbol]
p) -> Maybe (DistTexts, [SomeToField])
forall a. Maybe a
Nothing
          | [Text]
Demote [Symbol]
p [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
basePath -> (DistTexts, [SomeToField]) -> Maybe (DistTexts, [SomeToField])
forall a. a -> Maybe a
Just ((DistTexts, [SomeToField]) -> Maybe (DistTexts, [SomeToField]))
-> (DistTexts, [SomeToField]) -> Maybe (DistTexts, [SomeToField])
forall a b. (a -> b) -> a -> b
$ Int
-> Dist sch (TabOnPath sch t path) -> (DistTexts, [SomeToField])
forall {k} (sch :: k) (t :: NameNSK).
Int -> Dist sch t -> (DistTexts, [SomeToField])
pgDist Int
qrCurrTabNum Dist sch (TabOnPath sch t path)
dist
          | Bool
otherwise -> (ParentInfo -> Bool) -> [ParentInfo] -> Maybe ParentInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (([Text]
Demote [Symbol]
p [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
==) ([Text] -> Bool) -> (ParentInfo -> [Text]) -> ParentInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text]
basePath [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text])
-> (ParentInfo -> [Text]) -> ParentInfo -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.piPath)) [ParentInfo]
parents
            Maybe ParentInfo
-> (ParentInfo -> (DistTexts, [SomeToField]))
-> Maybe (DistTexts, [SomeToField])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ParentInfo
pari -> Int
-> Dist sch (TabOnPath sch t path) -> (DistTexts, [SomeToField])
forall {k} (sch :: k) (t :: NameNSK).
Int -> Dist sch t -> (DistTexts, [SomeToField])
pgDist ParentInfo
pari.piToNum Dist sch (TabOnPath sch t path)
dist
        ) qrParam.qpDistinct
    sel
      | [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Text]
basePath =
        Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(Text
a,Text
b) -> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"") [(Text, Text)]
flds
      | Bool
otherwise = [(Text, Text)] -> Text
jsonPairing [(Text, Text)]
flds
    whereText = let conds :: [Text]
conds = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text
refTxt, Text
condText] in
      if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Text]
conds then Text
forall a. Monoid a => a
mempty else Text
" where " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" and " [Text]
conds
    orderText
      | Text -> Bool
T.null Text
ordText Bool -> Bool -> Bool
&& Text -> Bool
T.null DistTexts
distTexts.orderBy.unTextI = Text
""
      | Bool
otherwise = Text
" order by " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
","
        ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [DistTexts
distTexts.orderBy.unTextI, Text
ordText])
    distinctText
      | DistTexts
distTexts.distinct.getAny Bool -> Bool -> Bool
&& Text -> Bool
T.null DistTexts
distTexts.distinctOn.unTextI = Text
" distinct "
      | Text -> Bool
T.null DistTexts
distTexts.distinctOn.unTextI = Text
""
      | Bool
otherwise = Text
" distinct on (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DistTexts
distTexts.distinctOn.unTextI Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") "
    qsLimOff = [Text] -> [LimOffWithPath sch t] -> Text
forall {k} (sch :: k) (t :: NameNSK).
[Text] -> [LimOffWithPath sch t] -> Text
loByPath ([Text] -> [Text]
forall a. [a] -> [a]
L.reverse [Text]
qrPath) ([LimOffWithPath sch t] -> Text) -> [LimOffWithPath sch t] -> Text
forall a b. (a -> b) -> a -> b
$ QueryParam sch t -> [LimOffWithPath sch t]
forall sch (t :: NameNSK).
QueryParam sch t -> [LimOffWithPath sch t]
qpLOs QueryParam sch t
qrParam
    groupByText
      | [FieldInfo Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [FieldInfo Text]
aggrs Bool -> Bool -> Bool
|| [FieldInfo Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [FieldInfo Text]
others = Text
""
      | Bool
otherwise = Text
" group by " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
","
        ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
L.nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [FieldInfo Text]
others [FieldInfo Text] -> (FieldInfo Text -> [Text]) -> [Text]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FieldInfo Text
fi -> case FieldInfo Text
fi.fieldKind of
          RFPlain{} -> [FieldInfo Text
fi.fieldDbName]
          RFToHere RecordInfo Text
_ [Ref' Text]
refs -> [Ref' Text]
refs [Ref' Text] -> (Ref' Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Ref' Text
ref -> Ref' Text
ref.toName
          RFFromHere RecordInfo Text
_ [Ref' Text]
refs -> [Ref' Text]
refs [Ref' Text] -> (Ref' Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Ref' Text
ref -> Ref' Text
ref.fromName
          RecField' Text (RecordInfo Text)
_ -> [])
      where
        ([FieldInfo Text]
aggrs, [FieldInfo Text]
others) = (FieldInfo Text -> Bool)
-> [FieldInfo Text] -> ([FieldInfo Text], [FieldInfo Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition
          (\FieldInfo Text
fld -> case FieldInfo Text
fld.fieldKind of { RFAggr{} -> Bool
True; RecField' Text (RecordInfo Text)
_ -> Bool
False })
          RecordInfo Text
ri.fields
  tell $ distPars <> condPars <> distPars <> ordPars
  pure $ "select "
    <> distinctText
    <> sel
    <> " from " <> qualName ri.tabName <> " t" <> show' qrCurrTabNum
    <> " " <> T.unwords (joinText <$> trace' (show' parents) parents)
    <> whereText
    <> groupByText
    <> orderText
    <> qsLimOff

-- | SQL text for the column expression, result alias, and emptiness-test expression
-- (non-obvious for nested relation fields).
fieldM :: MonadQuery sch tab m => FieldInfo Text -> m (Text, Text, Text)
fieldM :: forall sch (tab :: NameNSK) (m :: * -> *).
MonadQuery sch tab m =>
FieldInfo Text -> m (Text, Text, Text)
fieldM FieldInfo Text
fi = case FieldInfo Text
fi.fieldKind of
  RFEmpty Text
s -> (Text, Text, Text) -> m (Text, Text, Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"null", Text
s, Text
"true")
  RFSelfRef{} -> String -> m (Text, Text, Text)
forall a. HasCallStack => String -> a
error String
"Impossible: RFSelfRef should be changed to RFFromHere or RFToHere"
  RFPlain {} -> do
    n <- (QueryRead sch tab -> Int) -> m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks QueryRead sch tab -> Int
forall sch (t :: NameNSK). QueryRead sch t -> Int
qrCurrTabNum
    let val = Text
"t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (IsString b, Show a) => a -> b
show' Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldInfo Text
fi.fieldDbName
    pure (val, fi.fieldName, val <> " is null")
  RFAggr FldDef' Text
_ (Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> (AggrFun -> Text) -> AggrFun -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (AggrFun -> Text) -> AggrFun -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AggrFun -> Text
forall a. Show a => a -> Text
T.show -> Text
fname) Bool
_ -> do
    n <- (QueryRead sch tab -> Int) -> m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks QueryRead sch tab -> Int
forall sch (t :: NameNSK). QueryRead sch t -> Int
qrCurrTabNum
    let val = Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (IsString b, Show a) => a -> b
show' Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldInfo Text
fi.fieldDbName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    pure case fname of
      Text
"count" -> (Text
"count(*)", FieldInfo Text
fi.fieldName, Text
" false")
      Text
_ -> (Text
val, FieldInfo Text
fi.fieldName, Text
val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is null")
  RFFromHere RecordInfo Text
ri [Ref' Text]
refs -> do
    QueryRead {..} <- m (QueryRead sch tab)
forall r (m :: * -> *). MonadReader r m => m r
ask
    modify \QueryState{qsLastTabNum :: QueryState -> Int
qsLastTabNum = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) -> Int
n2, [ParentInfo]
qsParents :: QueryState -> [ParentInfo]
qsParents :: [ParentInfo]
qsParents} -> QueryState
      { qsLastTabNum :: Int
qsLastTabNum = Int
n2
      -- , qsJoins = joinText qrCurrTabNum n2 : qsJoins
      , qsParents :: [ParentInfo]
qsParents = ParentInfo
        { piRelDbName :: Text
piRelDbName = FieldInfo Text
fi.fieldDbName
        , piFromNum :: Int
piFromNum   = Int
qrCurrTabNum
        , piToNum :: Int
piToNum     = Int
n2
        , piParentTab :: NameNS
piParentTab = RecordInfo Text
ri.tabName
        , piRefs :: [Ref' Text]
piRefs      = [Ref' Text]
refs
        , piPath :: [Text]
piPath      = FieldInfo Text
fi.fieldDbName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
qrPath } ParentInfo -> [ParentInfo] -> [ParentInfo]
forall a. a -> [a] -> [a]
: [ParentInfo]
qsParents }
    n2 <- gets qsLastTabNum
    (flds, pars) <- listen $ local
      (\QueryRead sch tab
qr -> QueryRead sch tab
qr{ qrCurrTabNum = n2, qrPath = fi.fieldDbName : qrPath })
      $ traverse fieldM ri.fields
    val <- if L.any (fdNullable . fromDef) refs
      then do
        tell pars
        pure $ "case when " <> T.intercalate " and " (third <$> flds)
          <> " then null else " <> jsonPairing (two <$> flds) <> " end"
      else pure $ jsonPairing $ two <$> flds
    pure (val, fi.fieldName, val <> " is null")
  RFToHere RecordInfo Text
ri [Ref' Text]
refs -> do
    QueryRead{..} <- m (QueryRead sch tab)
forall r (m :: * -> *). MonadReader r m => m r
ask
    QueryState {qsLastTabNum = (+1) -> tabNum, qsParents} <- get
    modify (const $ QueryState tabNum [])
    selText <- local
      (\QueryRead sch tab
qr -> QueryRead sch tab
qr { qrCurrTabNum = tabNum, qrPath = fi.fieldDbName : qrPath })
      $ selectM (refCond tabNum qrCurrTabNum refs) ri
    modify (\QueryState
qs -> QueryState
qs { qsParents = qsParents })
    let
      val = Text
"array(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
selText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    pure ("array_to_json(" <> val <> ")", fi.fieldName, val <> " = '{}'")

joinText :: ParentInfo -> Text
joinText :: ParentInfo -> Text
joinText ParentInfo{Int
[Text]
[Ref' Text]
Text
NameNS
piRelDbName :: ParentInfo -> Text
piFromNum :: ParentInfo -> Int
piToNum :: ParentInfo -> Int
piParentTab :: ParentInfo -> NameNS
piRefs :: ParentInfo -> [Ref' Text]
piPath :: ParentInfo -> [Text]
piRelDbName :: Text
piFromNum :: Int
piToNum :: Int
piParentTab :: NameNS
piRefs :: [Ref' Text]
piPath :: [Text]
..} =
  Text
outer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"join " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NameNS -> Text
qualName NameNS
piParentTab Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (IsString b, Show a) => a -> b
show' Int
piToNum
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" on " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> [Ref' Text] -> Text
refCond Int
piFromNum Int
piToNum [Ref' Text]
piRefs
  where
    outer :: Text
outer
      | [Ref' Text] -> Bool
hasNullableRefs [Ref' Text]
piRefs = Text
"left outer "
      | Bool
otherwise = Text
""

refCond :: Int -> Int -> [Ref] -> Text
refCond :: Int -> Int -> [Ref' Text] -> Text
refCond Int
nFrom Int
nTo = Text -> [Text] -> Text
T.intercalate Text
" and " ([Text] -> Text) -> ([Ref' Text] -> [Text]) -> [Ref' Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ref' Text -> Text) -> [Ref' Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ref' Text -> Text
compFlds
  where
    compFlds :: Ref' Text -> Text
compFlds Ref {Text
fromName :: Text
fromName :: forall s. Ref' s -> s
fromName, Text
toName :: Text
toName :: forall s. Ref' s -> s
toName} =
      Int -> Text -> Text
forall {a} {a}. (Semigroup a, IsString a, Show a) => a -> a -> a
fldt Int
nFrom Text
fromName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
forall {a} {a}. (Semigroup a, IsString a, Show a) => a -> a -> a
fldt Int
nTo Text
toName
      where
        fldt :: a -> a -> a
fldt a
n = ((a
"t" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a -> a
forall b a. (IsString b, Show a) => a -> b
show' a
n a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".") a -> a -> a
forall a. Semigroup a => a -> a -> a
<>)

withLOWithPath
  :: forall sch t r. (LO -> r) -> [Text] -> LimOffWithPath sch t -> Maybe r
withLOWithPath :: forall {k} (sch :: k) (t :: NameNSK) r.
(LO -> r) -> [Text] -> LimOffWithPath sch t -> Maybe r
withLOWithPath LO -> r
f [Text]
p (LimOffWithPath @p LO
lo) =
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Text]
p [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== forall (a :: [Symbol]).
(SingKind [Symbol], SingI a) =>
Demote [Symbol]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @p) Maybe () -> Maybe r -> Maybe r
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> r -> Maybe r
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LO -> r
f LO
lo)

withLOsWithPath
  :: forall sch t r. (LO -> r) -> [Text] -> [LimOffWithPath sch t] -> Maybe r
withLOsWithPath :: forall {k} (sch :: k) (t :: NameNSK) r.
(LO -> r) -> [Text] -> [LimOffWithPath sch t] -> Maybe r
withLOsWithPath LO -> r
f [Text]
p = Maybe (Maybe r) -> Maybe r
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe r) -> Maybe r)
-> ([LimOffWithPath sch t] -> Maybe (Maybe r))
-> [LimOffWithPath sch t]
-> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe r -> Bool) -> [Maybe r] -> Maybe (Maybe r)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find Maybe r -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe r] -> Maybe (Maybe r))
-> ([LimOffWithPath sch t] -> [Maybe r])
-> [LimOffWithPath sch t]
-> Maybe (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LimOffWithPath sch t -> Maybe r)
-> [LimOffWithPath sch t] -> [Maybe r]
forall a b. (a -> b) -> [a] -> [b]
L.map ((LO -> r) -> [Text] -> LimOffWithPath sch t -> Maybe r
forall {k} (sch :: k) (t :: NameNSK) r.
(LO -> r) -> [Text] -> LimOffWithPath sch t -> Maybe r
withLOWithPath LO -> r
f [Text]
p)

lowp :: forall sch t. forall (path::[Symbol]) ->
  (ToStar path, TabPath sch t path
  , Snd (TabOnPath2 sch t path) ~ RelMany) => LO -> LimOffWithPath sch t
lowp :: forall {k} (sch :: k) (t :: NameNSK).
forall (path :: [Symbol]) ->
(ToStar path, TabPath sch t path,
 Snd (TabOnPath2 sch t path) ~ 'RelMany) =>
LO -> LimOffWithPath sch t
lowp p = forall (path :: [Symbol]) (sch :: k) (t :: NameNSK).
(TabPath sch t path, ToStar path,
 Snd (TabOnPath2 sch t path) ~ 'RelMany) =>
LO -> LimOffWithPath sch t
forall {k} (path :: [Symbol]) (sch :: k) (t :: NameNSK).
(TabPath sch t path, ToStar path,
 Snd (TabOnPath2 sch t path) ~ 'RelMany) =>
LO -> LimOffWithPath sch t
LimOffWithPath @p

rootLO :: forall sch t. LO -> LimOffWithPath sch t
rootLO :: forall {k} (sch :: k) (t :: NameNSK). LO -> LimOffWithPath sch t
rootLO = lowp []

convLO :: LO -> Text
convLO :: LO -> Text
convLO (LO Maybe Natural
ml Maybe Natural
mo) =
  Text -> (Natural -> Text) -> Maybe Natural -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
" limit " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Natural -> Text) -> Natural -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Text
forall b a. (IsString b, Show a) => a -> b
show') Maybe Natural
ml
   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Natural -> Text) -> Maybe Natural -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
" offset " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Natural -> Text) -> Natural -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Text
forall b a. (IsString b, Show a) => a -> b
show') Maybe Natural
mo

loByPath :: forall sch t. [Text] -> [LimOffWithPath sch t] -> Text
loByPath :: forall {k} (sch :: k) (t :: NameNSK).
[Text] -> [LimOffWithPath sch t] -> Text
loByPath [Text]
p = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Maybe Text -> Text)
-> ([LimOffWithPath sch t] -> Maybe Text)
-> [LimOffWithPath sch t]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LO -> Text) -> [Text] -> [LimOffWithPath sch t] -> Maybe Text
forall {k} (sch :: k) (t :: NameNSK) r.
(LO -> r) -> [Text] -> [LimOffWithPath sch t] -> Maybe r
withLOsWithPath LO -> Text
convLO [Text]
p

runCond :: Int -> CondMonad a -> (a,[SomeToField])
runCond :: forall a. Int -> CondMonad a -> (a, [SomeToField])
runCond Int
n CondMonad a
x = CondMonad a -> (Text, NonEmpty Int) -> Int -> (a, [SomeToField])
forall r w s a. RWS r w s a -> r -> s -> (a, w)
evalRWS CondMonad a
x (Text
"q", Int -> NonEmpty Int
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n) Int
0

tabPref :: CondMonad Text
tabPref :: CondMonad Text
tabPref = ((Text, NonEmpty Int) -> Text) -> CondMonad Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks \case
  (Text
_, Int
n :| []) -> Text
"t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (IsString b, Show a) => a -> b
show' Int
n
  (Text
p, Int
n :| (Int
np : [Int]
_)) -> Text
"t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (IsString b, Show a) => a -> b
show' Int
np Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (IsString b, Show a) => a -> b
show' Int
n

qual :: forall (fld :: Symbol). ToStar fld => CondMonad Text
qual :: forall (fld :: Symbol). ToStar fld => CondMonad Text
qual = CondMonad Text
tabPref CondMonad Text -> (Text -> Text) -> CondMonad Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Symbol). (SingKind Symbol, SingI a) => Demote Symbol
demote @fld))

--
convCond :: forall sch t . Cond sch t -> CondMonad Text
convCond :: forall sch (t :: NameNSK). Cond sch t -> CondMonad Text
convCond = \case
  Cond sch t
EmptyCond -> Text -> CondMonad Text
forall a.
a -> RWST (Text, NonEmpty Int) [SomeToField] Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
forall a. Monoid a => a
mempty
  Cmp @n Cmp
cmp v
v -> do
    [SomeToField]
-> RWST (Text, NonEmpty Int) [SomeToField] Int Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [v -> SomeToField
forall a. (ToField a, Show a) => a -> SomeToField
SomeToField v
v]
    forall (fld :: Symbol). ToStar fld => CondMonad Text
qual @n CondMonad Text -> (Text -> Text) -> CondMonad Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Cmp -> Text
forall s. IsString s => Cmp -> s
showCmp Cmp
cmp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ?")
  In @n (NonEmpty v -> [v]
forall a. NonEmpty a -> [a]
NE.toList -> [v]
vs) -> do
    [SomeToField]
-> RWST (Text, NonEmpty Int) [SomeToField] Int Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [PGArray v -> SomeToField
forall a. (ToField a, Show a) => a -> SomeToField
SomeToField (PGArray v -> SomeToField) -> PGArray v -> SomeToField
forall a b. (a -> b) -> a -> b
$ [v] -> PGArray v
forall a. [a] -> PGArray a
PGArray [v]
vs]
    forall (fld :: Symbol). ToStar fld => CondMonad Text
qual @n CondMonad Text -> (Text -> Text) -> CondMonad Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = any(?::" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NameNS -> Text
qualName (forall {k} (sch :: k) (t :: NameNSK) (n :: Symbol).
ToStar (TDBFieldInfo sch t n) =>
FldDef' Text
forall sch (t :: NameNSK) (n :: Symbol).
ToStar (TDBFieldInfo sch t n) =>
FldDef' Text
getFldDef @sch @t @n).fdType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[])")
  InArr @n [v]
vs -> do
    [SomeToField]
-> RWST (Text, NonEmpty Int) [SomeToField] Int Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [PGArray v -> SomeToField
forall a. (ToField a, Show a) => a -> SomeToField
SomeToField (PGArray v -> SomeToField) -> PGArray v -> SomeToField
forall a b. (a -> b) -> a -> b
$ [v] -> PGArray v
forall a. [a] -> PGArray a
PGArray [v]
vs]
    forall (fld :: Symbol). ToStar fld => CondMonad Text
qual @n CondMonad Text -> (Text -> Text) -> CondMonad Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = any(?::" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NameNS -> Text
qualName (forall {k} (sch :: k) (t :: NameNSK) (n :: Symbol).
ToStar (TDBFieldInfo sch t n) =>
FldDef' Text
forall sch (t :: NameNSK) (n :: Symbol).
ToStar (TDBFieldInfo sch t n) =>
FldDef' Text
getFldDef @sch @t @n).fdType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[])")
  Null @n -> forall (fld :: Symbol). ToStar fld => CondMonad Text
qual @n CondMonad Text -> (Text -> Text) -> CondMonad Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is null")
  Not Cond sch t
c -> Text -> Text
forall {a}. (Eq a, Monoid a, IsString a) => a -> a
getNot (Text -> Text) -> CondMonad Text -> CondMonad Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cond sch t -> CondMonad Text
forall sch (t :: NameNSK). Cond sch t -> CondMonad Text
convCond Cond sch t
c
  BoolOp BoolOp
bo Cond sch t
c1 Cond sch t
c2 -> BoolOp -> Text -> Text -> Text
forall {a}. (Eq a, Monoid a, IsString a) => BoolOp -> a -> a -> a
getBoolOp BoolOp
bo (Text -> Text -> Text)
-> CondMonad Text
-> RWST
     (Text, NonEmpty Int) [SomeToField] Int Identity (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cond sch t -> CondMonad Text
forall sch (t :: NameNSK). Cond sch t -> CondMonad Text
convCond Cond sch t
c1 RWST (Text, NonEmpty Int) [SomeToField] Int Identity (Text -> Text)
-> CondMonad Text -> CondMonad Text
forall a b.
RWST (Text, NonEmpty Int) [SomeToField] Int Identity (a -> b)
-> RWST (Text, NonEmpty Int) [SomeToField] Int Identity a
-> RWST (Text, NonEmpty Int) [SomeToField] Int Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cond sch t -> CondMonad Text
forall sch (t :: NameNSK). Cond sch t -> CondMonad Text
convCond Cond sch t
c2
  Child @_ @ref TabParam sch (RdFrom (TRelDef sch ref))
tabParam Cond sch (RdFrom (TRelDef sch ref))
cond ->
    forall (tab :: NameNSK).
CTabDef sch tab =>
Bool
-> [(Text, Text)]
-> TabParam sch tab
-> Cond sch tab
-> CondMonad Text
getRef @(RdFrom (TRelDef sch ref)) Bool
True (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: RelDefK).
(SingKind RelDefK, SingI a) =>
Demote RelDefK
demote @(TRelDef sch ref)).rdCols
      TabParam sch (RdFrom (TRelDef sch ref))
tabParam Cond sch (RdFrom (TRelDef sch ref))
cond
  Parent @_ @ref Cond sch (RdTo (TRelDef sch ref))
cond ->
    forall (tab :: NameNSK).
CTabDef sch tab =>
Bool
-> [(Text, Text)]
-> TabParam sch tab
-> Cond sch tab
-> CondMonad Text
getRef @(RdTo (TRelDef sch ref)) Bool
False (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: RelDefK).
(SingKind RelDefK, SingI a) =>
Demote RelDefK
demote @(TRelDef sch ref)).rdCols
      TabParam sch (RdTo (TRelDef sch ref))
forall sch (tab :: NameNSK). TabParam sch tab
defTabParam Cond sch (RdTo (TRelDef sch ref))
cond
  UnsafeCond CondMonad Text
m -> CondMonad Text
m
  where
    getNot :: a -> a
getNot a
c
      | a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty = a
forall a. Monoid a => a
mempty
      | Bool
otherwise   = a
"not (" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
c a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
    getBoolOp :: BoolOp -> a -> a -> a
getBoolOp BoolOp
bo a
cc1 a
cc2
      | a
cc1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty = a
cc2 -- so EmptyCond works both with &&& and |||
      | a
cc2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty = a
cc1
      | Bool
otherwise = case BoolOp
bo of
        BoolOp
And -> a
cc1 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" and " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
cc2
        BoolOp
Or -> a
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
cc1 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" or " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
cc2 a -> a -> a
forall a. Semigroup a => a -> a -> a
<>  a
")"
    getRef
      :: forall tab. CTabDef sch tab
      => Bool -> [(Text, Text)] -> TabParam sch tab -> Cond sch tab
      -> CondMonad Text
    getRef :: forall (tab :: NameNSK).
CTabDef sch tab =>
Bool
-> [(Text, Text)]
-> TabParam sch tab
-> Cond sch tab
-> CondMonad Text
getRef Bool
isChild [(Text, Text)]
cols TabParam sch tab
tabParam Cond sch tab
cond = do
      tpp <- CondMonad Text
tabPref
      modify (+1)
      cnum <- get
      (tpc, condInt, TextI ordInt, condExt) <- local (second (cnum <|))
        $ (,,,) <$> tabPref <*> convCond tabParam.cond
          <*> convOrd tabParam.order <*> convCond cond
      pure $ mkExists tpp tpc condInt ordInt condExt
      where
        mkExists :: Text -> Text -> Text -> Text -> Text -> Text
mkExists Text
tpp Text
tpc Text
cin Text
oint Text
cout
          = Text
"exists (select 1 from (select * from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tpc
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" and " (
              (\(Text
ch,Text
pr) -> Text
tpc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ch Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tpp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pr)
              ((Text, Text) -> Text)
-> ((Text, Text) -> (Text, Text)) -> (Text, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
isChild then (Text, Text) -> (Text, Text)
forall a. a -> a
id else (Text, Text) -> (Text, Text)
forall a b. (a, b) -> (b, a)
swap)
            ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
cols)
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Text -> Bool
T.null Text
cin then Text
"" else Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cin)
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case TabParam sch tab
tabParam of
            TabParam Cond sch tab
EmptyCond [] (LO Maybe Natural
Nothing Maybe Natural
Nothing) -> Text
""
            TabParam Cond sch tab
_ [OrdFld sch tab]
_ (LO -> Text
convLO -> Text
loTxt) ->
              (if Text -> Bool
T.null Text
oint then Text
"" else Text
" order by " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
oint) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
loTxt
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tpc
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Text -> Bool
T.null Text
cout then Text
"" else Text
" where " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cout)
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          where
            tn :: Text
tn = NameNS -> Text
qualName (NameNS -> Text) -> NameNS -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: NameNSK).
(SingKind NameNSK, SingI a) =>
Demote NameNSK
demote @tab

pgCond :: forall sch t . Int -> Cond sch t -> (Text, [SomeToField])
pgCond :: forall sch (t :: NameNSK).
Int -> Cond sch t -> (Text, [SomeToField])
pgCond Int
n Cond sch t
cond = CondMonad Text
-> (Text, NonEmpty Int) -> Int -> (Text, [SomeToField])
forall r w s a. RWS r w s a -> r -> s -> (a, w)
evalRWS (Cond sch t -> CondMonad Text
forall sch (t :: NameNSK). Cond sch t -> CondMonad Text
convCond Cond sch t
cond) (Text
"q", Int -> NonEmpty Int
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n) Int
0

pgOrd :: forall sch t. Int -> [OrdFld sch t] -> (TextI ",", [SomeToField])
pgOrd :: forall {k} (sch :: k) (t :: NameNSK).
Int -> [OrdFld sch t] -> (TextI ",", [SomeToField])
pgOrd Int
n [OrdFld sch t]
ord = RWST (Text, NonEmpty Int) [SomeToField] Int Identity (TextI ",")
-> (Text, NonEmpty Int) -> Int -> (TextI ",", [SomeToField])
forall r w s a. RWS r w s a -> r -> s -> (a, w)
evalRWS ([OrdFld sch t]
-> RWST (Text, NonEmpty Int) [SomeToField] Int Identity (TextI ",")
forall {k} (sch :: k) (tab :: NameNSK).
[OrdFld sch tab]
-> RWST (Text, NonEmpty Int) [SomeToField] Int Identity (TextI ",")
convOrd [OrdFld sch t]
ord) (Text
"o", Int -> NonEmpty Int
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n) Int
0

pgDist :: forall sch t. Int -> Dist sch t -> (DistTexts, [SomeToField])
pgDist :: forall {k} (sch :: k) (t :: NameNSK).
Int -> Dist sch t -> (DistTexts, [SomeToField])
pgDist Int
n Dist sch t
dist = RWS (Text, NonEmpty Int) [SomeToField] Int DistTexts
-> (Text, NonEmpty Int) -> Int -> (DistTexts, [SomeToField])
forall r w s a. RWS r w s a -> r -> s -> (a, w)
evalRWS (Dist sch t -> RWS (Text, NonEmpty Int) [SomeToField] Int DistTexts
forall {k} (sch :: k) (tab :: NameNSK).
Dist sch tab
-> RWS (Text, NonEmpty Int) [SomeToField] Int DistTexts
convDist Dist sch t
dist) (Text
"o", Int -> NonEmpty Int
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n) Int
0

withCondWithPath :: forall sch t r. (forall t'. Cond sch t' -> r) ->
  [Text] -> CondWithPath sch t -> Maybe r
withCondWithPath :: forall sch (t :: NameNSK) r.
(forall (t' :: NameNSK). Cond sch t' -> r)
-> [Text] -> CondWithPath sch t -> Maybe r
withCondWithPath forall (t' :: NameNSK). Cond sch t' -> r
f [Text]
p (CondWithPath @p' Cond sch (TabOnPath sch t path)
cond) = Cond sch (TabOnPath sch t path) -> r
forall (t' :: NameNSK). Cond sch t' -> r
f Cond sch (TabOnPath sch t path)
cond r -> Maybe () -> Maybe r
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Text]
p [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== forall (a :: [Symbol]).
(SingKind [Symbol], SingI a) =>
Demote [Symbol]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @p')

withCondsWithPath :: forall sch t r. (forall t'. Cond sch t' -> r) ->
  [Text] -> [CondWithPath sch t] -> Maybe r
withCondsWithPath :: forall sch (t :: NameNSK) r.
(forall (t' :: NameNSK). Cond sch t' -> r)
-> [Text] -> [CondWithPath sch t] -> Maybe r
withCondsWithPath forall (t' :: NameNSK). Cond sch t' -> r
f [Text]
p = Maybe (Maybe r) -> Maybe r
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe r) -> Maybe r)
-> ([CondWithPath sch t] -> Maybe (Maybe r))
-> [CondWithPath sch t]
-> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe r -> Bool) -> [Maybe r] -> Maybe (Maybe r)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find Maybe r -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe r] -> Maybe (Maybe r))
-> ([CondWithPath sch t] -> [Maybe r])
-> [CondWithPath sch t]
-> Maybe (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CondWithPath sch t -> Maybe r)
-> [CondWithPath sch t] -> [Maybe r]
forall a b. (a -> b) -> [a] -> [b]
L.map ((forall (t' :: NameNSK). Cond sch t' -> r)
-> [Text] -> CondWithPath sch t -> Maybe r
forall sch (t :: NameNSK) r.
(forall (t' :: NameNSK). Cond sch t' -> r)
-> [Text] -> CondWithPath sch t -> Maybe r
withCondWithPath Cond sch t' -> r
forall (t' :: NameNSK). Cond sch t' -> r
f [Text]
p)

cwp :: forall path -> forall sch t t1.
  (t1 ~ TabOnPath sch t path, ToStar path) => Cond sch t1 -> CondWithPath sch t
cwp :: forall (path :: [Symbol]) ->
forall sch (t :: NameNSK) (t1 :: NameNSK).
(t1 ~ TabOnPath sch t path, ToStar path) =>
Cond sch t1 -> CondWithPath sch t
cwp p = forall (path :: [Symbol]) sch (t :: NameNSK).
ToStar path =>
Cond sch (TabOnPath sch t path) -> CondWithPath sch t
CondWithPath @p

rootCond :: Cond sch t -> CondWithPath sch t
rootCond :: forall sch (t :: NameNSK). Cond sch t -> CondWithPath sch t
rootCond = cwp []

condByPath :: Int -> [Text] -> [CondWithPath sch t] -> (Text, [SomeToField])
condByPath :: forall sch (t :: NameNSK).
Int -> [Text] -> [CondWithPath sch t] -> (Text, [SomeToField])
condByPath Int
num [Text]
p = Maybe (Text, [SomeToField]) -> (Text, [SomeToField])
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (Maybe (Text, [SomeToField]) -> (Text, [SomeToField]))
-> ([CondWithPath sch t] -> Maybe (Text, [SomeToField]))
-> [CondWithPath sch t]
-> (Text, [SomeToField])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t' :: NameNSK). Cond sch t' -> (Text, [SomeToField]))
-> [Text] -> [CondWithPath sch t] -> Maybe (Text, [SomeToField])
forall sch (t :: NameNSK) r.
(forall (t' :: NameNSK). Cond sch t' -> r)
-> [Text] -> [CondWithPath sch t] -> Maybe r
withCondsWithPath (Int -> Cond sch t' -> (Text, [SomeToField])
forall sch (t :: NameNSK).
Int -> Cond sch t -> (Text, [SomeToField])
pgCond Int
num) [Text]
p

ordByPath :: Int -> [Text] -> [OrdWithPath sch t] -> (TextI ",", [SomeToField])
ordByPath :: forall {k} (sch :: k) (t :: NameNSK).
Int -> [Text] -> [OrdWithPath sch t] -> (TextI ",", [SomeToField])
ordByPath Int
num [Text]
p = Maybe (TextI ",", [SomeToField]) -> (TextI ",", [SomeToField])
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (Maybe (TextI ",", [SomeToField]) -> (TextI ",", [SomeToField]))
-> ([OrdWithPath sch t] -> Maybe (TextI ",", [SomeToField]))
-> [OrdWithPath sch t]
-> (TextI ",", [SomeToField])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t' :: NameNSK).
 [OrdFld sch t'] -> (TextI ",", [SomeToField]))
-> [Text]
-> [OrdWithPath sch t]
-> Maybe (TextI ",", [SomeToField])
forall {k} (sch :: k) (t :: NameNSK) r.
(forall (t' :: NameNSK). [OrdFld sch t'] -> r)
-> [Text] -> [OrdWithPath sch t] -> Maybe r
withOrdsWithPath (Int -> [OrdFld sch t'] -> (TextI ",", [SomeToField])
forall {k} (sch :: k) (t :: NameNSK).
Int -> [OrdFld sch t] -> (TextI ",", [SomeToField])
pgOrd Int
num) [Text]
p

distByPath :: Int -> [Text] -> [DistWithPath sch t] -> (DistTexts, [SomeToField])
distByPath :: forall {k} (sch :: k) (t :: NameNSK).
Int -> [Text] -> [DistWithPath sch t] -> (DistTexts, [SomeToField])
distByPath Int
num [Text]
p = Maybe (DistTexts, [SomeToField]) -> (DistTexts, [SomeToField])
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (Maybe (DistTexts, [SomeToField]) -> (DistTexts, [SomeToField]))
-> ([DistWithPath sch t] -> Maybe (DistTexts, [SomeToField]))
-> [DistWithPath sch t]
-> (DistTexts, [SomeToField])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t' :: NameNSK). Dist sch t' -> (DistTexts, [SomeToField]))
-> [Text]
-> [DistWithPath sch t]
-> Maybe (DistTexts, [SomeToField])
forall {k} (sch :: k) (t :: NameNSK) r.
(forall (t' :: NameNSK). Dist sch t' -> r)
-> [Text] -> [DistWithPath sch t] -> Maybe r
withDistsWithPath (Int -> Dist sch t' -> (DistTexts, [SomeToField])
forall {k} (sch :: k) (t :: NameNSK).
Int -> Dist sch t -> (DistTexts, [SomeToField])
pgDist Int
num) [Text]
p

withOrdWithPath :: forall sch t r. (forall t'. [OrdFld sch t'] -> r) ->
  [Text] -> OrdWithPath sch t -> Maybe r
withOrdWithPath :: forall {k} (sch :: k) (t :: NameNSK) r.
(forall (t' :: NameNSK). [OrdFld sch t'] -> r)
-> [Text] -> OrdWithPath sch t -> Maybe r
withOrdWithPath forall (t' :: NameNSK). [OrdFld sch t'] -> r
f [Text]
p (OrdWithPath @p [OrdFld sch (TabOnPath sch t path)]
ord) = [OrdFld sch (TabOnPath sch t path)] -> r
forall (t' :: NameNSK). [OrdFld sch t'] -> r
f [OrdFld sch (TabOnPath sch t path)]
ord r -> Maybe () -> Maybe r
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Text]
p [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== forall (a :: [Symbol]).
(SingKind [Symbol], SingI a) =>
Demote [Symbol]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @p)

withDistWithPath :: forall sch t r. (forall t'. Dist sch t' -> r) ->
  [Text] -> DistWithPath sch t -> Maybe r
withDistWithPath :: forall {k} (sch :: k) (t :: NameNSK) r.
(forall (t' :: NameNSK). Dist sch t' -> r)
-> [Text] -> DistWithPath sch t -> Maybe r
withDistWithPath forall (t' :: NameNSK). Dist sch t' -> r
f [Text]
p (DistWithPath @p Dist sch (TabOnPath sch t path)
dist) = Dist sch (TabOnPath sch t path) -> r
forall (t' :: NameNSK). Dist sch t' -> r
f Dist sch (TabOnPath sch t path)
dist r -> Maybe () -> Maybe r
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Text]
p [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== forall (a :: [Symbol]).
(SingKind [Symbol], SingI a) =>
Demote [Symbol]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @p)

--
withOrdsWithPath :: forall sch t r . (forall t'. [OrdFld sch t'] -> r) ->
  [Text] -> [OrdWithPath sch t] -> Maybe r
withOrdsWithPath :: forall {k} (sch :: k) (t :: NameNSK) r.
(forall (t' :: NameNSK). [OrdFld sch t'] -> r)
-> [Text] -> [OrdWithPath sch t] -> Maybe r
withOrdsWithPath forall (t' :: NameNSK). [OrdFld sch t'] -> r
f [Text]
p = Maybe (Maybe r) -> Maybe r
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe r) -> Maybe r)
-> ([OrdWithPath sch t] -> Maybe (Maybe r))
-> [OrdWithPath sch t]
-> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe r -> Bool) -> [Maybe r] -> Maybe (Maybe r)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find Maybe r -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe r] -> Maybe (Maybe r))
-> ([OrdWithPath sch t] -> [Maybe r])
-> [OrdWithPath sch t]
-> Maybe (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OrdWithPath sch t -> Maybe r) -> [OrdWithPath sch t] -> [Maybe r]
forall a b. (a -> b) -> [a] -> [b]
L.map ((forall (t' :: NameNSK). [OrdFld sch t'] -> r)
-> [Text] -> OrdWithPath sch t -> Maybe r
forall {k} (sch :: k) (t :: NameNSK) r.
(forall (t' :: NameNSK). [OrdFld sch t'] -> r)
-> [Text] -> OrdWithPath sch t -> Maybe r
withOrdWithPath [OrdFld sch t'] -> r
forall (t' :: NameNSK). [OrdFld sch t'] -> r
f [Text]
p)

withDistsWithPath :: forall sch t r . (forall t'. Dist sch t' -> r) ->
  [Text] -> [DistWithPath sch t] -> Maybe r
withDistsWithPath :: forall {k} (sch :: k) (t :: NameNSK) r.
(forall (t' :: NameNSK). Dist sch t' -> r)
-> [Text] -> [DistWithPath sch t] -> Maybe r
withDistsWithPath forall (t' :: NameNSK). Dist sch t' -> r
f [Text]
p = Maybe (Maybe r) -> Maybe r
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe r) -> Maybe r)
-> ([DistWithPath sch t] -> Maybe (Maybe r))
-> [DistWithPath sch t]
-> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe r -> Bool) -> [Maybe r] -> Maybe (Maybe r)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find Maybe r -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe r] -> Maybe (Maybe r))
-> ([DistWithPath sch t] -> [Maybe r])
-> [DistWithPath sch t]
-> Maybe (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DistWithPath sch t -> Maybe r)
-> [DistWithPath sch t] -> [Maybe r]
forall a b. (a -> b) -> [a] -> [b]
L.map ((forall (t' :: NameNSK). Dist sch t' -> r)
-> [Text] -> DistWithPath sch t -> Maybe r
forall {k} (sch :: k) (t :: NameNSK) r.
(forall (t' :: NameNSK). Dist sch t' -> r)
-> [Text] -> DistWithPath sch t -> Maybe r
withDistWithPath Dist sch t' -> r
forall (t' :: NameNSK). Dist sch t' -> r
f [Text]
p)

owp :: forall path -> forall sch t t'.
  (ToStar path, TabOnPath sch t path ~ t') =>
  [OrdFld sch t'] -> OrdWithPath sch t
owp :: forall {k}.
forall (path :: [Symbol]) ->
forall (sch :: k) (t :: NameNSK) (t' :: NameNSK).
(ToStar path, TabOnPath sch t path ~ t') =>
[OrdFld sch t'] -> OrdWithPath sch t
owp p = forall (path :: [Symbol]) (sch :: k) (t :: NameNSK).
ToStar path =>
[OrdFld sch (TabOnPath sch t path)] -> OrdWithPath sch t
forall {k} (path :: [Symbol]) (sch :: k) (t :: NameNSK).
ToStar path =>
[OrdFld sch (TabOnPath sch t path)] -> OrdWithPath sch t
OrdWithPath @p

rootOrd :: forall sch t. [OrdFld sch t] -> OrdWithPath sch t
rootOrd :: forall {k} (sch :: k) (t :: NameNSK).
[OrdFld sch t] -> OrdWithPath sch t
rootOrd = owp []

dwp :: forall path -> forall sch t t'.
  (ToStar path, TabOnPath2 sch t path ~ '(t', 'RelMany)) =>
  Dist sch t' -> DistWithPath sch t
dwp :: forall {k}.
forall (path :: [Symbol]) ->
forall (sch :: k) (t :: NameNSK) (t' :: NameNSK).
(ToStar path, TabOnPath2 sch t path ~ '(t', 'RelMany)) =>
Dist sch t' -> DistWithPath sch t
dwp p = forall (path :: [Symbol]) (sch :: k) (t :: NameNSK).
ToStar path =>
Dist sch (TabOnPath sch t path) -> DistWithPath sch t
forall {k} (path :: [Symbol]) (sch :: k) (t :: NameNSK).
ToStar path =>
Dist sch (TabOnPath sch t path) -> DistWithPath sch t
DistWithPath @p

rootDist :: forall sch t. Dist sch t -> DistWithPath sch t
rootDist :: forall {k} (sch :: k) (t :: NameNSK).
Dist sch t -> DistWithPath sch t
rootDist = dwp []

convPreOrd :: forall sch tab. [OrdFld sch tab] -> CondMonad [(Text, OrdDirection)]
convPreOrd :: forall {k} (sch :: k) (tab :: NameNSK).
[OrdFld sch tab] -> CondMonad [(Text, OrdDirection)]
convPreOrd = (OrdFld sch tab
 -> RWST
      (Text, NonEmpty Int)
      [SomeToField]
      Int
      Identity
      (Text, OrdDirection))
-> [OrdFld sch tab] -> CondMonad [(Text, OrdDirection)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse OrdFld sch tab
-> RWST
     (Text, NonEmpty Int)
     [SomeToField]
     Int
     Identity
     (Text, OrdDirection)
forall {k} {sch :: k} {tab :: NameNSK}.
OrdFld sch tab
-> RWST
     (Text, NonEmpty Int)
     [SomeToField]
     Int
     Identity
     (Text, OrdDirection)
processFld
  where
    processFld :: OrdFld sch tab
-> RWST
     (Text, NonEmpty Int)
     [SomeToField]
     Int
     Identity
     (Text, OrdDirection)
processFld = \case
      OrdFld @fld OrdDirection
od -> (, OrdDirection
od) (Text -> (Text, OrdDirection))
-> CondMonad Text
-> RWST
     (Text, NonEmpty Int)
     [SomeToField]
     Int
     Identity
     (Text, OrdDirection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (fld :: Symbol). ToStar fld => CondMonad Text
qual @fld
      UnsafeOrd RWST
  (Text, NonEmpty Int)
  [SomeToField]
  Int
  Identity
  (Text, OrdDirection)
m -> RWST
  (Text, NonEmpty Int)
  [SomeToField]
  Int
  Identity
  (Text, OrdDirection)
m

renderOrd :: [(Text, OrdDirection)] -> TextI ","
renderOrd :: [(Text, OrdDirection)] -> TextI ","
renderOrd = ((Text, OrdDirection) -> TextI ",")
-> [(Text, OrdDirection)] -> TextI ","
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> TextI ","
forall (s :: Symbol). Text -> TextI s
TextI (Text -> TextI ",")
-> ((Text, OrdDirection) -> Text)
-> (Text, OrdDirection)
-> TextI ","
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, OrdDirection) -> Text
forall {a} {a}. (IsString a, Show a, Semigroup a) => (a, a) -> a
render)
  where
    render :: (a, a) -> a
render (a
t, a -> a
forall b a. (IsString b, Show a) => a -> b
show' -> a
od) = a
t a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
od a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" nulls last"

convOrd :: forall sch tab. [OrdFld sch tab] -> CondMonad (TextI ",")
convOrd :: forall {k} (sch :: k) (tab :: NameNSK).
[OrdFld sch tab]
-> RWST (Text, NonEmpty Int) [SomeToField] Int Identity (TextI ",")
convOrd = ([(Text, OrdDirection)] -> TextI ",")
-> CondMonad [(Text, OrdDirection)]
-> RWST (Text, NonEmpty Int) [SomeToField] Int Identity (TextI ",")
forall a b.
(a -> b)
-> RWST (Text, NonEmpty Int) [SomeToField] Int Identity a
-> RWST (Text, NonEmpty Int) [SomeToField] Int Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, OrdDirection)] -> TextI ","
renderOrd (CondMonad [(Text, OrdDirection)]
 -> RWST
      (Text, NonEmpty Int) [SomeToField] Int Identity (TextI ","))
-> ([OrdFld sch tab] -> CondMonad [(Text, OrdDirection)])
-> [OrdFld sch tab]
-> RWST (Text, NonEmpty Int) [SomeToField] Int Identity (TextI ",")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OrdFld sch tab] -> CondMonad [(Text, OrdDirection)]
forall {k} (sch :: k) (tab :: NameNSK).
[OrdFld sch tab] -> CondMonad [(Text, OrdDirection)]
convPreOrd

data DistTexts = DistTexts
  { DistTexts -> Any
distinct :: Any
  , DistTexts -> TextI ","
distinctOn :: TextI ","
  , DistTexts -> TextI ","
orderBy :: TextI "," }
  deriving (forall x. DistTexts -> Rep DistTexts x)
-> (forall x. Rep DistTexts x -> DistTexts) -> Generic DistTexts
forall x. Rep DistTexts x -> DistTexts
forall x. DistTexts -> Rep DistTexts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DistTexts -> Rep DistTexts x
from :: forall x. DistTexts -> Rep DistTexts x
$cto :: forall x. Rep DistTexts x -> DistTexts
to :: forall x. Rep DistTexts x -> DistTexts
Generic
  deriving (NonEmpty DistTexts -> DistTexts
DistTexts -> DistTexts -> DistTexts
(DistTexts -> DistTexts -> DistTexts)
-> (NonEmpty DistTexts -> DistTexts)
-> (forall b. Integral b => b -> DistTexts -> DistTexts)
-> Semigroup DistTexts
forall b. Integral b => b -> DistTexts -> DistTexts
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: DistTexts -> DistTexts -> DistTexts
<> :: DistTexts -> DistTexts -> DistTexts
$csconcat :: NonEmpty DistTexts -> DistTexts
sconcat :: NonEmpty DistTexts -> DistTexts
$cstimes :: forall b. Integral b => b -> DistTexts -> DistTexts
stimes :: forall b. Integral b => b -> DistTexts -> DistTexts
Semigroup, Semigroup DistTexts
DistTexts
Semigroup DistTexts =>
DistTexts
-> (DistTexts -> DistTexts -> DistTexts)
-> ([DistTexts] -> DistTexts)
-> Monoid DistTexts
[DistTexts] -> DistTexts
DistTexts -> DistTexts -> DistTexts
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: DistTexts
mempty :: DistTexts
$cmappend :: DistTexts -> DistTexts -> DistTexts
mappend :: DistTexts -> DistTexts -> DistTexts
$cmconcat :: [DistTexts] -> DistTexts
mconcat :: [DistTexts] -> DistTexts
Monoid) via (Generically DistTexts)

convDist :: forall sch tab. Dist sch tab -> CondMonad DistTexts
convDist :: forall {k} (sch :: k) (tab :: NameNSK).
Dist sch tab
-> RWS (Text, NonEmpty Int) [SomeToField] Int DistTexts
convDist = \case
  Dist sch tab
Distinct -> DistTexts -> RWS (Text, NonEmpty Int) [SomeToField] Int DistTexts
forall a.
a -> RWST (Text, NonEmpty Int) [SomeToField] Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DistTexts -> RWS (Text, NonEmpty Int) [SomeToField] Int DistTexts)
-> DistTexts
-> RWS (Text, NonEmpty Int) [SomeToField] Int DistTexts
forall a b. (a -> b) -> a -> b
$ DistTexts
forall a. Monoid a => a
mempty { distinct = Any True }
  DistinctOn [OrdFld sch tab]
ofs -> [OrdFld sch tab] -> CondMonad [(Text, OrdDirection)]
forall {k} (sch :: k) (tab :: NameNSK).
[OrdFld sch tab] -> CondMonad [(Text, OrdDirection)]
convPreOrd [OrdFld sch tab]
ofs CondMonad [(Text, OrdDirection)]
-> ([(Text, OrdDirection)] -> DistTexts)
-> RWS (Text, NonEmpty Int) [SomeToField] Int DistTexts
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[(Text, OrdDirection)]
xs -> DistTexts
forall a. Monoid a => a
mempty
    { distinctOn = foldMap (TextI . fst) xs
    , orderBy = renderOrd xs }