{-# LANGUAGE LambdaCase #-}

module Opaleye.Internal.PrimQuery where

import           Prelude hiding (product)

import qualified Data.List.NonEmpty as NEL
import           Data.Semigroup (Semigroup, (<>))
import qualified Opaleye.Internal.HaskellDB.Sql as HSql
import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
import           Opaleye.Internal.HaskellDB.PrimQuery (Symbol)

data LimitOp = LimitOp Int | OffsetOp Int | LimitOffsetOp Int Int
             deriving Int -> LimitOp -> ShowS
[LimitOp] -> ShowS
LimitOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LimitOp] -> ShowS
$cshowList :: [LimitOp] -> ShowS
show :: LimitOp -> String
$cshow :: LimitOp -> String
showsPrec :: Int -> LimitOp -> ShowS
$cshowsPrec :: Int -> LimitOp -> ShowS
Show

data BinOp = Except
           | ExceptAll
           | Union
           | UnionAll
           | Intersect
           | IntersectAll
             deriving Int -> BinOp -> ShowS
[BinOp] -> ShowS
BinOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinOp] -> ShowS
$cshowList :: [BinOp] -> ShowS
show :: BinOp -> String
$cshow :: BinOp -> String
showsPrec :: Int -> BinOp -> ShowS
$cshowsPrec :: Int -> BinOp -> ShowS
Show

data JoinType = LeftJoin | RightJoin | FullJoin deriving Int -> JoinType -> ShowS
[JoinType] -> ShowS
JoinType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoinType] -> ShowS
$cshowList :: [JoinType] -> ShowS
show :: JoinType -> String
$cshow :: JoinType -> String
showsPrec :: Int -> JoinType -> ShowS
$cshowsPrec :: Int -> JoinType -> ShowS
Show

data SemijoinType = Semi | Anti deriving Int -> SemijoinType -> ShowS
[SemijoinType] -> ShowS
SemijoinType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemijoinType] -> ShowS
$cshowList :: [SemijoinType] -> ShowS
show :: SemijoinType -> String
$cshow :: SemijoinType -> String
showsPrec :: Int -> SemijoinType -> ShowS
$cshowsPrec :: Int -> SemijoinType -> ShowS
Show

data TableIdentifier = TableIdentifier
  { TableIdentifier -> Maybe String
tiSchemaName :: Maybe String
  , TableIdentifier -> String
tiTableName  :: String
  } deriving Int -> TableIdentifier -> ShowS
[TableIdentifier] -> ShowS
TableIdentifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableIdentifier] -> ShowS
$cshowList :: [TableIdentifier] -> ShowS
show :: TableIdentifier -> String
$cshow :: TableIdentifier -> String
showsPrec :: Int -> TableIdentifier -> ShowS
$cshowsPrec :: Int -> TableIdentifier -> ShowS
Show

tiToSqlTable :: TableIdentifier -> HSql.SqlTable
tiToSqlTable :: TableIdentifier -> SqlTable
tiToSqlTable TableIdentifier
ti = HSql.SqlTable { sqlTableSchemaName :: Maybe String
HSql.sqlTableSchemaName = TableIdentifier -> Maybe String
tiSchemaName TableIdentifier
ti
                                , sqlTableName :: String
HSql.sqlTableName       = TableIdentifier -> String
tiTableName TableIdentifier
ti }

type Bindings a = [(Symbol, a)]

data Lateral = NonLateral | Lateral
  deriving Int -> Lateral -> ShowS
[Lateral] -> ShowS
Lateral -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lateral] -> ShowS
$cshowList :: [Lateral] -> ShowS
show :: Lateral -> String
$cshow :: Lateral -> String
showsPrec :: Int -> Lateral -> ShowS
$cshowsPrec :: Int -> Lateral -> ShowS
Show

instance Semigroup Lateral where
  Lateral
NonLateral <> :: Lateral -> Lateral -> Lateral
<> Lateral
NonLateral = Lateral
NonLateral
  Lateral
_ <> Lateral
_ = Lateral
Lateral

instance Monoid Lateral where
  mappend :: Lateral -> Lateral -> Lateral
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: Lateral
mempty = Lateral
NonLateral

data Recursive = NonRecursive | Recursive
  deriving Int -> Recursive -> ShowS
[Recursive] -> ShowS
Recursive -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Recursive] -> ShowS
$cshowList :: [Recursive] -> ShowS
show :: Recursive -> String
$cshow :: Recursive -> String
showsPrec :: Int -> Recursive -> ShowS
$cshowsPrec :: Int -> Recursive -> ShowS
Show

aLeftJoin :: HPQ.PrimExpr -> PrimQuery -> PrimQueryArr
aLeftJoin :: PrimExpr -> PrimQuery -> PrimQueryArr
aLeftJoin PrimExpr
cond PrimQuery
primQuery' = (Lateral -> PrimQuery -> PrimQuery) -> PrimQueryArr
PrimQueryArr forall a b. (a -> b) -> a -> b
$ \Lateral
lat PrimQuery
primQueryL ->
  forall a.
JoinType
-> PrimExpr
-> (Lateral, PrimQuery' a)
-> (Lateral, PrimQuery' a)
-> PrimQuery' a
Join JoinType
LeftJoin PrimExpr
cond (Lateral
NonLateral, PrimQuery
primQueryL) (Lateral
lat, PrimQuery
primQuery')

aProduct :: PrimQuery -> PrimQueryArr
aProduct :: PrimQuery -> PrimQueryArr
aProduct PrimQuery
pq = (Lateral -> PrimQuery -> PrimQuery) -> PrimQueryArr
PrimQueryArr (\Lateral
lat PrimQuery
primQuery -> Lateral -> PrimQuery -> PrimQuery -> PrimQuery
times Lateral
lat PrimQuery
primQuery PrimQuery
pq)

aSemijoin :: SemijoinType -> PrimQuery -> PrimQueryArr
aSemijoin :: SemijoinType -> PrimQuery -> PrimQueryArr
aSemijoin SemijoinType
joint PrimQuery
existsQ = (Lateral -> PrimQuery -> PrimQuery) -> PrimQueryArr
PrimQueryArr forall a b. (a -> b) -> a -> b
$ \Lateral
_ PrimQuery
primQ -> forall a.
SemijoinType -> PrimQuery' a -> PrimQuery' a -> PrimQuery' a
Semijoin SemijoinType
joint PrimQuery
primQ PrimQuery
existsQ

aRebind :: Bindings HPQ.PrimExpr -> PrimQueryArr
aRebind :: Bindings PrimExpr -> PrimQueryArr
aRebind Bindings PrimExpr
bindings = (Lateral -> PrimQuery -> PrimQuery) -> PrimQueryArr
PrimQueryArr forall a b. (a -> b) -> a -> b
$ \Lateral
_ -> forall a. Bool -> Bindings PrimExpr -> PrimQuery' a -> PrimQuery' a
Rebind Bool
True Bindings PrimExpr
bindings

aRestrict :: HPQ.PrimExpr -> PrimQueryArr
aRestrict :: PrimExpr -> PrimQueryArr
aRestrict PrimExpr
predicate = (Lateral -> PrimQuery -> PrimQuery) -> PrimQueryArr
PrimQueryArr forall a b. (a -> b) -> a -> b
$ \Lateral
_ -> PrimExpr -> PrimQuery -> PrimQuery
restrict PrimExpr
predicate

aLabel :: String -> PrimQueryArr
aLabel :: String -> PrimQueryArr
aLabel String
l = (Lateral -> PrimQuery -> PrimQuery) -> PrimQueryArr
PrimQueryArr forall a b. (a -> b) -> a -> b
$ \Lateral
_ PrimQuery
primQ -> forall a. String -> PrimQuery' a -> PrimQuery' a
Label String
l PrimQuery
primQ

-- The function 'Lateral -> PrimQuery -> PrimQuery' represents a
-- select arrow in the following way:
--
--    Lateral
-- -- ^ Whether to join me laterally
-- -> PrimQuery
-- -- ^ The query that I will be joined after.  If I refer to columns
-- -- in here in a way that is only valid when I am joined laterally,
-- -- then Lateral must be passed in as the argument above.
-- -> PrimQuery
-- -- ^ The result after joining me
--
-- It is *always* valid to pass Lateral as the first argument.  So why
-- wouldn't we do that?  Because we don't want to generate lateral
-- subqueries if they are not needed; it might have performance
-- implications.  Even though there is good evidence that it *doesn't*
-- have performance implications
-- (https://github.com/tomjaguarpaw/haskell-opaleye/pull/480) we still
-- want to be cautious.
--
-- Not every function of type `Lateral -> PrimQuery -> PrimQuery` is
-- valid to be a PrimQuery.  I think the condition that they must
-- satisfy for validity is
--
--     q == lateral (aProduct (toPrimQuery q)
--
-- where == is observable equivalence, i.e. both queries must give the
-- same results when combined with other queries and then run.
newtype PrimQueryArr =
  PrimQueryArr { PrimQueryArr -> Lateral -> PrimQuery -> PrimQuery
runPrimQueryArr :: Lateral -> PrimQuery -> PrimQuery }

instance Semigroup PrimQueryArr where
  PrimQueryArr Lateral -> PrimQuery -> PrimQuery
f1 <> :: PrimQueryArr -> PrimQueryArr -> PrimQueryArr
<> PrimQueryArr Lateral -> PrimQuery -> PrimQuery
f2 = (Lateral -> PrimQuery -> PrimQuery) -> PrimQueryArr
PrimQueryArr (\Lateral
lat -> Lateral -> PrimQuery -> PrimQuery
f2 Lateral
lat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lateral -> PrimQuery -> PrimQuery
f1 Lateral
lat)

instance Monoid PrimQueryArr where
  mappend :: PrimQueryArr -> PrimQueryArr -> PrimQueryArr
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: PrimQueryArr
mempty = (Lateral -> PrimQuery -> PrimQuery) -> PrimQueryArr
PrimQueryArr (\Lateral
_ -> forall a. a -> a
id)

lateral :: PrimQueryArr -> PrimQueryArr
lateral :: PrimQueryArr -> PrimQueryArr
lateral (PrimQueryArr Lateral -> PrimQuery -> PrimQuery
pq) = (Lateral -> PrimQuery -> PrimQuery) -> PrimQueryArr
PrimQueryArr (\Lateral
_ -> Lateral -> PrimQuery -> PrimQuery
pq Lateral
Lateral)

toPrimQuery :: PrimQueryArr -> PrimQuery
toPrimQuery :: PrimQueryArr -> PrimQuery
toPrimQuery (PrimQueryArr Lateral -> PrimQuery -> PrimQuery
f) = Lateral -> PrimQuery -> PrimQuery
f Lateral
NonLateral forall a. PrimQuery' a
Unit

-- We use a 'NEL.NonEmpty' for Product because otherwise we'd have to check
-- for emptiness explicitly in the SQL generation phase.

-- The type parameter 'a' is used to control whether the 'Empty'
-- constructor can appear.  If 'a' = '()' then it can appear.  If 'a'
-- = 'Void' then it cannot.  When we create queries it is more
-- convenient to allow 'Empty', but it is hard to represent 'Empty' in
-- SQL so we remove it in 'Optimize' and set 'a = Void'.
data PrimQuery' a = Unit
                  -- Remove the Empty constructor in 0.10
                  | Empty     a
                  | BaseTable TableIdentifier (Bindings HPQ.PrimExpr)
                  | Product   (NEL.NonEmpty (Lateral, PrimQuery' a)) [HPQ.PrimExpr]
                  -- | The subqueries to take the product of and the
                  --   restrictions to apply
                  | Aggregate (Bindings (Maybe (HPQ.AggrOp,
                                                [HPQ.OrderExpr],
                                                HPQ.AggrDistinct),
                                          HPQ.Symbol))
                              (PrimQuery' a)
                  -- | Represents both @DISTINCT ON@ and @ORDER BY@
                  --   clauses. In order to represent valid SQL only,
                  --   @DISTINCT ON@ expressions are always
                  --   interpreted as the first @ORDER BY@s when
                  --   present, preceding any in the provided list.
                  --   See 'Opaleye.Internal.Sql.distinctOnOrderBy'.
                  | DistinctOnOrderBy (Maybe (NEL.NonEmpty HPQ.PrimExpr))
                                      [HPQ.OrderExpr]
                                      (PrimQuery' a)
                  | Limit     LimitOp (PrimQuery' a)
                  | Join      JoinType
                              HPQ.PrimExpr
                              (Lateral, PrimQuery' a)
                              (Lateral, PrimQuery' a)
                  | Semijoin  SemijoinType (PrimQuery' a) (PrimQuery' a)
                  | Exists    Symbol (PrimQuery' a)
                  | Values    [Symbol] (NEL.NonEmpty [HPQ.PrimExpr])
                  | Binary    BinOp
                              (PrimQuery' a, PrimQuery' a)
                  | Label     String (PrimQuery' a)
                  | RelExpr   HPQ.PrimExpr (Bindings HPQ.PrimExpr)
                  | Rebind    Bool
                              (Bindings HPQ.PrimExpr)
                              (PrimQuery' a)
                  | ForUpdate (PrimQuery' a)
                  -- We may support more locking clauses than just
                  -- ForUpdate in the future
                  --
                  -- https://www.postgresql.org/docs/current/sql-select.html#SQL-FOR-UPDATE-SHARE
                  | With Recursive Symbol [Symbol] (PrimQuery' a) (PrimQuery' a)
                 deriving Int -> PrimQuery' a -> ShowS
forall a. Show a => Int -> PrimQuery' a -> ShowS
forall a. Show a => [PrimQuery' a] -> ShowS
forall a. Show a => PrimQuery' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimQuery' a] -> ShowS
$cshowList :: forall a. Show a => [PrimQuery' a] -> ShowS
show :: PrimQuery' a -> String
$cshow :: forall a. Show a => PrimQuery' a -> String
showsPrec :: Int -> PrimQuery' a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PrimQuery' a -> ShowS
Show

type PrimQuery = PrimQuery' ()
type PrimQueryFold p = PrimQueryFold' () p

type PrimQueryFold' a p = PrimQueryFoldP a p p

data PrimQueryFoldP a p p' = PrimQueryFold
  { forall a p p'. PrimQueryFoldP a p p' -> p'
unit              :: p'
  , forall a p p'. PrimQueryFoldP a p p' -> a -> p'
empty             :: a -> p'
  , forall a p p'.
PrimQueryFoldP a p p' -> TableIdentifier -> Bindings PrimExpr -> p'
baseTable         :: TableIdentifier -> Bindings HPQ.PrimExpr -> p'
  , forall a p p'.
PrimQueryFoldP a p p' -> NonEmpty (Lateral, p) -> [PrimExpr] -> p'
product           :: NEL.NonEmpty (Lateral, p) -> [HPQ.PrimExpr] -> p'
  , forall a p p'.
PrimQueryFoldP a p p'
-> Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
-> p
-> p'
aggregate         :: Bindings (Maybe
                             (HPQ.AggrOp, [HPQ.OrderExpr], HPQ.AggrDistinct),
                                   HPQ.Symbol)
                      -> p
                      -> p'
  , forall a p p'.
PrimQueryFoldP a p p'
-> Maybe (NonEmpty PrimExpr) -> [OrderExpr] -> p -> p'
distinctOnOrderBy :: Maybe (NEL.NonEmpty HPQ.PrimExpr)
                      -> [HPQ.OrderExpr]
                      -> p
                      -> p'
  , forall a p p'. PrimQueryFoldP a p p' -> LimitOp -> p -> p'
limit             :: LimitOp -> p -> p'
  , forall a p p'.
PrimQueryFoldP a p p'
-> JoinType -> PrimExpr -> (Lateral, p) -> (Lateral, p) -> p'
join              :: JoinType
                      -> HPQ.PrimExpr
                      -> (Lateral, p)
                      -> (Lateral, p)
                      -> p'
  , forall a p p'.
PrimQueryFoldP a p p' -> SemijoinType -> p -> p -> p'
semijoin          :: SemijoinType -> p -> p -> p'
  , forall a p p'. PrimQueryFoldP a p p' -> Symbol -> p -> p'
exists            :: Symbol -> p -> p'
  , forall a p p'.
PrimQueryFoldP a p p' -> [Symbol] -> NonEmpty [PrimExpr] -> p'
values            :: [Symbol] -> NEL.NonEmpty [HPQ.PrimExpr] -> p'
  , forall a p p'. PrimQueryFoldP a p p' -> BinOp -> (p, p) -> p'
binary            :: BinOp
                      -> (p, p)
                      -> p'
  , forall a p p'. PrimQueryFoldP a p p' -> String -> p -> p'
label             :: String -> p -> p'
  , forall a p p'.
PrimQueryFoldP a p p' -> PrimExpr -> Bindings PrimExpr -> p'
relExpr           :: HPQ.PrimExpr -> Bindings HPQ.PrimExpr -> p'
    -- ^ A relation-valued expression
  , forall a p p'.
PrimQueryFoldP a p p' -> Bool -> Bindings PrimExpr -> p -> p'
rebind            :: Bool -> Bindings HPQ.PrimExpr -> p -> p'
  , forall a p p'. PrimQueryFoldP a p p' -> p -> p'
forUpdate         :: p -> p'
  , forall a p p'.
PrimQueryFoldP a p p'
-> Recursive -> Symbol -> [Symbol] -> p -> p -> p'
with              :: Recursive -> Symbol -> [Symbol] -> p -> p -> p'
  }


primQueryFoldDefault :: PrimQueryFold' a (PrimQuery' a)
primQueryFoldDefault :: forall a. PrimQueryFold' a (PrimQuery' a)
primQueryFoldDefault = PrimQueryFold
  { unit :: PrimQuery' a
unit              = forall a. PrimQuery' a
Unit
  , empty :: a -> PrimQuery' a
empty             = forall a. a -> PrimQuery' a
Empty
  , baseTable :: TableIdentifier -> Bindings PrimExpr -> PrimQuery' a
baseTable         = forall a. TableIdentifier -> Bindings PrimExpr -> PrimQuery' a
BaseTable
  , product :: NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
product           = forall a.
NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
Product
  , aggregate :: Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
-> PrimQuery' a -> PrimQuery' a
aggregate         = forall a.
Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
-> PrimQuery' a -> PrimQuery' a
Aggregate
  , distinctOnOrderBy :: Maybe (NonEmpty PrimExpr)
-> [OrderExpr] -> PrimQuery' a -> PrimQuery' a
distinctOnOrderBy = forall a.
Maybe (NonEmpty PrimExpr)
-> [OrderExpr] -> PrimQuery' a -> PrimQuery' a
DistinctOnOrderBy
  , limit :: LimitOp -> PrimQuery' a -> PrimQuery' a
limit             = forall a. LimitOp -> PrimQuery' a -> PrimQuery' a
Limit
  , join :: JoinType
-> PrimExpr
-> (Lateral, PrimQuery' a)
-> (Lateral, PrimQuery' a)
-> PrimQuery' a
join              = forall a.
JoinType
-> PrimExpr
-> (Lateral, PrimQuery' a)
-> (Lateral, PrimQuery' a)
-> PrimQuery' a
Join
  , semijoin :: SemijoinType -> PrimQuery' a -> PrimQuery' a -> PrimQuery' a
semijoin          = forall a.
SemijoinType -> PrimQuery' a -> PrimQuery' a -> PrimQuery' a
Semijoin
  , values :: [Symbol] -> NonEmpty [PrimExpr] -> PrimQuery' a
values            = forall a. [Symbol] -> NonEmpty [PrimExpr] -> PrimQuery' a
Values
  , binary :: BinOp -> (PrimQuery' a, PrimQuery' a) -> PrimQuery' a
binary            = forall a. BinOp -> (PrimQuery' a, PrimQuery' a) -> PrimQuery' a
Binary
  , label :: String -> PrimQuery' a -> PrimQuery' a
label             = forall a. String -> PrimQuery' a -> PrimQuery' a
Label
  , relExpr :: PrimExpr -> Bindings PrimExpr -> PrimQuery' a
relExpr           = forall a. PrimExpr -> Bindings PrimExpr -> PrimQuery' a
RelExpr
  , exists :: Symbol -> PrimQuery' a -> PrimQuery' a
exists            = forall a. Symbol -> PrimQuery' a -> PrimQuery' a
Exists
  , rebind :: Bool -> Bindings PrimExpr -> PrimQuery' a -> PrimQuery' a
rebind            = forall a. Bool -> Bindings PrimExpr -> PrimQuery' a -> PrimQuery' a
Rebind
  , forUpdate :: PrimQuery' a -> PrimQuery' a
forUpdate         = forall a. PrimQuery' a -> PrimQuery' a
ForUpdate
  , with :: Recursive
-> Symbol
-> [Symbol]
-> PrimQuery' a
-> PrimQuery' a
-> PrimQuery' a
with              = forall a.
Recursive
-> Symbol
-> [Symbol]
-> PrimQuery' a
-> PrimQuery' a
-> PrimQuery' a
With
  }

dimapPrimQueryFold :: (q -> p)
                   -> (p' -> q')
                   -> PrimQueryFoldP a p p'
                   -> PrimQueryFoldP a q q'
dimapPrimQueryFold :: forall q p p' q' a.
(q -> p)
-> (p' -> q') -> PrimQueryFoldP a p p' -> PrimQueryFoldP a q q'
dimapPrimQueryFold q -> p
self p' -> q'
g PrimQueryFoldP a p p'
f = PrimQueryFold
  { unit :: q'
unit = p' -> q'
g (forall a p p'. PrimQueryFoldP a p p' -> p'
unit PrimQueryFoldP a p p'
f)
  , empty :: a -> q'
empty = p' -> q'
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a p p'. PrimQueryFoldP a p p' -> a -> p'
empty PrimQueryFoldP a p p'
f
  , baseTable :: TableIdentifier -> Bindings PrimExpr -> q'
baseTable = \TableIdentifier
ti Bindings PrimExpr
bs -> p' -> q'
g (forall a p p'.
PrimQueryFoldP a p p' -> TableIdentifier -> Bindings PrimExpr -> p'
baseTable PrimQueryFoldP a p p'
f TableIdentifier
ti Bindings PrimExpr
bs)
  , product :: NonEmpty (Lateral, q) -> [PrimExpr] -> q'
product = \NonEmpty (Lateral, q)
ps [PrimExpr]
conds -> p' -> q'
g (forall a p p'.
PrimQueryFoldP a p p' -> NonEmpty (Lateral, p) -> [PrimExpr] -> p'
product PrimQueryFoldP a p p'
f ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) q -> p
self NonEmpty (Lateral, q)
ps) [PrimExpr]
conds)
  , aggregate :: Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
-> q -> q'
aggregate = \Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
b q
p -> p' -> q'
g (forall a p p'.
PrimQueryFoldP a p p'
-> Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
-> p
-> p'
aggregate PrimQueryFoldP a p p'
f Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
b (q -> p
self q
p))
  , distinctOnOrderBy :: Maybe (NonEmpty PrimExpr) -> [OrderExpr] -> q -> q'
distinctOnOrderBy = \Maybe (NonEmpty PrimExpr)
m [OrderExpr]
os q
p -> p' -> q'
g (forall a p p'.
PrimQueryFoldP a p p'
-> Maybe (NonEmpty PrimExpr) -> [OrderExpr] -> p -> p'
distinctOnOrderBy PrimQueryFoldP a p p'
f Maybe (NonEmpty PrimExpr)
m [OrderExpr]
os (q -> p
self q
p))
  , limit :: LimitOp -> q -> q'
limit = \LimitOp
l q
p -> p' -> q'
g (forall a p p'. PrimQueryFoldP a p p' -> LimitOp -> p -> p'
limit PrimQueryFoldP a p p'
f LimitOp
l (q -> p
self q
p))
  , join :: JoinType -> PrimExpr -> (Lateral, q) -> (Lateral, q) -> q'
join = \JoinType
j PrimExpr
pe (Lateral, q)
lp (Lateral, q)
lp' -> p' -> q'
g (forall a p p'.
PrimQueryFoldP a p p'
-> JoinType -> PrimExpr -> (Lateral, p) -> (Lateral, p) -> p'
join PrimQueryFoldP a p p'
f JoinType
j PrimExpr
pe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap q -> p
self (Lateral, q)
lp) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap q -> p
self (Lateral, q)
lp'))
  , semijoin :: SemijoinType -> q -> q -> q'
semijoin = \SemijoinType
j q
p1 q
p2 -> p' -> q'
g (forall a p p'.
PrimQueryFoldP a p p' -> SemijoinType -> p -> p -> p'
semijoin PrimQueryFoldP a p p'
f SemijoinType
j (q -> p
self q
p1) (q -> p
self q
p2))
  , exists :: Symbol -> q -> q'
exists = \Symbol
s q
p -> p' -> q'
g (forall a p p'. PrimQueryFoldP a p p' -> Symbol -> p -> p'
exists PrimQueryFoldP a p p'
f Symbol
s (q -> p
self q
p))
  , values :: [Symbol] -> NonEmpty [PrimExpr] -> q'
values = \[Symbol]
ss NonEmpty [PrimExpr]
nel -> p' -> q'
g (forall a p p'.
PrimQueryFoldP a p p' -> [Symbol] -> NonEmpty [PrimExpr] -> p'
values PrimQueryFoldP a p p'
f [Symbol]
ss NonEmpty [PrimExpr]
nel)
  , binary :: BinOp -> (q, q) -> q'
binary = \BinOp
bo (q
p1, q
p2) -> p' -> q'
g (forall a p p'. PrimQueryFoldP a p p' -> BinOp -> (p, p) -> p'
binary PrimQueryFoldP a p p'
f BinOp
bo (q -> p
self q
p1, q -> p
self q
p2))
  , label :: String -> q -> q'
label = \String
l q
p -> p' -> q'
g (forall a p p'. PrimQueryFoldP a p p' -> String -> p -> p'
label PrimQueryFoldP a p p'
f String
l (q -> p
self q
p))
  , relExpr :: PrimExpr -> Bindings PrimExpr -> q'
relExpr = \PrimExpr
pe Bindings PrimExpr
bs -> p' -> q'
g (forall a p p'.
PrimQueryFoldP a p p' -> PrimExpr -> Bindings PrimExpr -> p'
relExpr PrimQueryFoldP a p p'
f PrimExpr
pe Bindings PrimExpr
bs)
  , rebind :: Bool -> Bindings PrimExpr -> q -> q'
rebind = \Bool
s Bindings PrimExpr
bs q
p -> p' -> q'
g (forall a p p'.
PrimQueryFoldP a p p' -> Bool -> Bindings PrimExpr -> p -> p'
rebind PrimQueryFoldP a p p'
f Bool
s Bindings PrimExpr
bs (q -> p
self q
p))
  , forUpdate :: q -> q'
forUpdate = \q
p -> p' -> q'
g (forall a p p'. PrimQueryFoldP a p p' -> p -> p'
forUpdate PrimQueryFoldP a p p'
f (q -> p
self q
p))
  , with :: Recursive -> Symbol -> [Symbol] -> q -> q -> q'
with = \Recursive
r Symbol
s [Symbol]
ss q
p1 q
p2 -> p' -> q'
g (forall a p p'.
PrimQueryFoldP a p p'
-> Recursive -> Symbol -> [Symbol] -> p -> p -> p'
with PrimQueryFoldP a p p'
f Recursive
r Symbol
s [Symbol]
ss (q -> p
self q
p1) (q -> p
self q
p2))
  }

applyPrimQueryFoldF ::
  PrimQueryFoldP a (PrimQuery' a) p -> PrimQuery' a -> p
applyPrimQueryFoldF :: forall a p. PrimQueryFoldP a (PrimQuery' a) p -> PrimQuery' a -> p
applyPrimQueryFoldF PrimQueryFoldP a (PrimQuery' a) p
f = \case
  PrimQuery' a
Unit -> forall a p p'. PrimQueryFoldP a p p' -> p'
unit PrimQueryFoldP a (PrimQuery' a) p
f
  Empty a
a -> forall a p p'. PrimQueryFoldP a p p' -> a -> p'
empty PrimQueryFoldP a (PrimQuery' a) p
f a
a
  BaseTable TableIdentifier
ti Bindings PrimExpr
syms -> forall a p p'.
PrimQueryFoldP a p p' -> TableIdentifier -> Bindings PrimExpr -> p'
baseTable PrimQueryFoldP a (PrimQuery' a) p
f TableIdentifier
ti Bindings PrimExpr
syms
  Product NonEmpty (Lateral, PrimQuery' a)
qs [PrimExpr]
pes -> forall a p p'.
PrimQueryFoldP a p p' -> NonEmpty (Lateral, p) -> [PrimExpr] -> p'
product PrimQueryFoldP a (PrimQuery' a) p
f NonEmpty (Lateral, PrimQuery' a)
qs [PrimExpr]
pes
  Aggregate Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
aggrs PrimQuery' a
q -> forall a p p'.
PrimQueryFoldP a p p'
-> Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
-> p
-> p'
aggregate PrimQueryFoldP a (PrimQuery' a) p
f Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
aggrs PrimQuery' a
q
  DistinctOnOrderBy Maybe (NonEmpty PrimExpr)
dxs [OrderExpr]
oxs PrimQuery' a
q -> forall a p p'.
PrimQueryFoldP a p p'
-> Maybe (NonEmpty PrimExpr) -> [OrderExpr] -> p -> p'
distinctOnOrderBy PrimQueryFoldP a (PrimQuery' a) p
f Maybe (NonEmpty PrimExpr)
dxs [OrderExpr]
oxs PrimQuery' a
q
  Limit LimitOp
op PrimQuery' a
q -> forall a p p'. PrimQueryFoldP a p p' -> LimitOp -> p -> p'
limit PrimQueryFoldP a (PrimQuery' a) p
f LimitOp
op PrimQuery' a
q
  Join JoinType
j PrimExpr
cond (Lateral, PrimQuery' a)
q1 (Lateral, PrimQuery' a)
q2 -> forall a p p'.
PrimQueryFoldP a p p'
-> JoinType -> PrimExpr -> (Lateral, p) -> (Lateral, p) -> p'
join PrimQueryFoldP a (PrimQuery' a) p
f JoinType
j PrimExpr
cond (Lateral, PrimQuery' a)
q1 (Lateral, PrimQuery' a)
q2
  Semijoin SemijoinType
j PrimQuery' a
q1 PrimQuery' a
q2 -> forall a p p'.
PrimQueryFoldP a p p' -> SemijoinType -> p -> p -> p'
semijoin PrimQueryFoldP a (PrimQuery' a) p
f SemijoinType
j PrimQuery' a
q1 PrimQuery' a
q2
  Values [Symbol]
ss NonEmpty [PrimExpr]
pes -> forall a p p'.
PrimQueryFoldP a p p' -> [Symbol] -> NonEmpty [PrimExpr] -> p'
values PrimQueryFoldP a (PrimQuery' a) p
f [Symbol]
ss NonEmpty [PrimExpr]
pes
  Binary BinOp
binop (PrimQuery' a
q1, PrimQuery' a
q2) -> forall a p p'. PrimQueryFoldP a p p' -> BinOp -> (p, p) -> p'
binary PrimQueryFoldP a (PrimQuery' a) p
f BinOp
binop (PrimQuery' a
q1, PrimQuery' a
q2)
  Label String
l PrimQuery' a
pq -> forall a p p'. PrimQueryFoldP a p p' -> String -> p -> p'
label PrimQueryFoldP a (PrimQuery' a) p
f String
l PrimQuery' a
pq
  RelExpr PrimExpr
pe Bindings PrimExpr
syms -> forall a p p'.
PrimQueryFoldP a p p' -> PrimExpr -> Bindings PrimExpr -> p'
relExpr PrimQueryFoldP a (PrimQuery' a) p
f PrimExpr
pe Bindings PrimExpr
syms
  Exists Symbol
s PrimQuery' a
q -> forall a p p'. PrimQueryFoldP a p p' -> Symbol -> p -> p'
exists PrimQueryFoldP a (PrimQuery' a) p
f Symbol
s PrimQuery' a
q
  Rebind Bool
star Bindings PrimExpr
pes PrimQuery' a
q -> forall a p p'.
PrimQueryFoldP a p p' -> Bool -> Bindings PrimExpr -> p -> p'
rebind PrimQueryFoldP a (PrimQuery' a) p
f Bool
star Bindings PrimExpr
pes PrimQuery' a
q
  ForUpdate PrimQuery' a
q -> forall a p p'. PrimQueryFoldP a p p' -> p -> p'
forUpdate PrimQueryFoldP a (PrimQuery' a) p
f PrimQuery' a
q
  With Recursive
recursive Symbol
name [Symbol]
cols PrimQuery' a
a PrimQuery' a
b -> forall a p p'.
PrimQueryFoldP a p p'
-> Recursive -> Symbol -> [Symbol] -> p -> p -> p'
with PrimQueryFoldP a (PrimQuery' a) p
f Recursive
recursive Symbol
name [Symbol]
cols PrimQuery' a
a PrimQuery' a
b

primQueryFoldF ::
  PrimQueryFoldP a p p' -> (PrimQuery' a -> p) -> PrimQuery' a -> p'
primQueryFoldF :: forall a p p'.
PrimQueryFoldP a p p' -> (PrimQuery' a -> p) -> PrimQuery' a -> p'
primQueryFoldF PrimQueryFoldP a p p'
g PrimQuery' a -> p
self = forall a p. PrimQueryFoldP a (PrimQuery' a) p -> PrimQuery' a -> p
applyPrimQueryFoldF (forall q p p' q' a.
(q -> p)
-> (p' -> q') -> PrimQueryFoldP a p p' -> PrimQueryFoldP a q q'
dimapPrimQueryFold PrimQuery' a -> p
self forall a. a -> a
id PrimQueryFoldP a p p'
g)

foldPrimQuery :: PrimQueryFold' a p -> PrimQuery' a -> p
foldPrimQuery :: forall a p. PrimQueryFold' a p -> PrimQuery' a -> p
foldPrimQuery PrimQueryFold' a p
f = forall {t}. (t -> t) -> t
fix (forall a p p'.
PrimQueryFoldP a p p' -> (PrimQuery' a -> p) -> PrimQuery' a -> p'
primQueryFoldF PrimQueryFold' a p
f)
  where fix :: (t -> t) -> t
fix t -> t
g = let x :: t
x = t -> t
g t
x in t
x

-- Would be nice to show that this is associative
composePrimQueryFold ::
  PrimQueryFoldP a (PrimQuery' a) q ->
  PrimQueryFoldP a p (PrimQuery' a) ->
  PrimQueryFoldP a p q
composePrimQueryFold :: forall a q p.
PrimQueryFoldP a (PrimQuery' a) q
-> PrimQueryFoldP a p (PrimQuery' a) -> PrimQueryFoldP a p q
composePrimQueryFold = forall {p'} {q'} {a} {p}.
(p' -> q') -> PrimQueryFoldP a p p' -> PrimQueryFoldP a p q'
fmapPrimQueryFold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a p. PrimQueryFoldP a (PrimQuery' a) p -> PrimQuery' a -> p
applyPrimQueryFoldF
  where fmapPrimQueryFold :: (p' -> q') -> PrimQueryFoldP a p p' -> PrimQueryFoldP a p q'
fmapPrimQueryFold = forall q p p' q' a.
(q -> p)
-> (p' -> q') -> PrimQueryFoldP a p p' -> PrimQueryFoldP a q q'
dimapPrimQueryFold forall a. a -> a
id

times :: Lateral -> PrimQuery -> PrimQuery -> PrimQuery
times :: Lateral -> PrimQuery -> PrimQuery -> PrimQuery
times Lateral
lat PrimQuery
q PrimQuery
q' = forall a.
NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
Product (forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimQuery
q forall a. a -> [a] -> NonEmpty a
NEL.:| [(Lateral
lat, PrimQuery
q')]) []

restrict :: HPQ.PrimExpr -> PrimQuery -> PrimQuery
restrict :: PrimExpr -> PrimQuery -> PrimQuery
restrict PrimExpr
cond PrimQuery
primQ = forall a.
NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
Product (forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimQuery
primQ)) [PrimExpr
cond]

isUnit :: PrimQuery' a -> Bool
isUnit :: forall a. PrimQuery' a -> Bool
isUnit PrimQuery' a
Unit = Bool
True
isUnit PrimQuery' a
_    = Bool
False