{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

module Opaleye.Internal.Sql where

import           Prelude hiding (filter, product)

import qualified Opaleye.Internal.PrimQuery as PQ

import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
import           Opaleye.Internal.HaskellDB.PrimQuery (Symbol(Symbol))
import qualified Opaleye.Internal.HaskellDB.Sql as HSql
import qualified Opaleye.Internal.HaskellDB.Sql.Default as SD
import qualified Opaleye.Internal.HaskellDB.Sql.Print as SP
import qualified Opaleye.Internal.HaskellDB.Sql.Generate as SG
import qualified Opaleye.Internal.Tag as T

import qualified Data.List.NonEmpty as NEL
import qualified Data.Maybe as M
import qualified Data.Void as V

import qualified Control.Arrow as Arr

data Select = SelectFrom From
            | Table HSql.SqlTable
            | RelExpr HSql.SqlExpr
            -- ^ A relation-valued expression
            | SelectJoin Join
            | SelectSemijoin Semijoin
            | SelectValues Values
            | SelectBinary Binary
            | SelectLabel Label
            | SelectExists Exists
            | SelectWith With
            deriving Int -> Select -> ShowS
[Select] -> ShowS
Select -> String
(Int -> Select -> ShowS)
-> (Select -> String) -> ([Select] -> ShowS) -> Show Select
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Select -> ShowS
showsPrec :: Int -> Select -> ShowS
$cshow :: Select -> String
show :: Select -> String
$cshowList :: [Select] -> ShowS
showList :: [Select] -> ShowS
Show

data SelectAttrs =
    Star
  | SelectAttrs (NEL.NonEmpty (HSql.SqlExpr, Maybe HSql.SqlColumn))
  | SelectAttrsStar (NEL.NonEmpty (HSql.SqlExpr, Maybe HSql.SqlColumn))
  deriving Int -> SelectAttrs -> ShowS
[SelectAttrs] -> ShowS
SelectAttrs -> String
(Int -> SelectAttrs -> ShowS)
-> (SelectAttrs -> String)
-> ([SelectAttrs] -> ShowS)
-> Show SelectAttrs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectAttrs -> ShowS
showsPrec :: Int -> SelectAttrs -> ShowS
$cshow :: SelectAttrs -> String
show :: SelectAttrs -> String
$cshowList :: [SelectAttrs] -> ShowS
showList :: [SelectAttrs] -> ShowS
Show

data From = From {
  From -> SelectAttrs
attrs      :: SelectAttrs,
  From -> [(Lateral, Select, Maybe [SqlColumn])]
tables     :: [(Lateral, Select, Maybe [HSql.SqlColumn])],
  From -> [SqlExpr]
criteria   :: [HSql.SqlExpr],
  From -> Maybe (NonEmpty SqlExpr)
groupBy    :: Maybe (NEL.NonEmpty HSql.SqlExpr),
  From -> [(SqlExpr, SqlOrder)]
orderBy    :: [(HSql.SqlExpr, HSql.SqlOrder)],
  From -> Maybe (NonEmpty SqlExpr)
distinctOn :: Maybe (NEL.NonEmpty HSql.SqlExpr),
  From -> Maybe Int
limit      :: Maybe Int,
  From -> Maybe Int
offset     :: Maybe Int,
  From -> Maybe LockStrength
for        :: Maybe LockStrength
  }
          deriving Int -> From -> ShowS
[From] -> ShowS
From -> String
(Int -> From -> ShowS)
-> (From -> String) -> ([From] -> ShowS) -> Show From
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> From -> ShowS
showsPrec :: Int -> From -> ShowS
$cshow :: From -> String
show :: From -> String
$cshowList :: [From] -> ShowS
showList :: [From] -> ShowS
Show

data Join = Join {
  Join -> JoinType
jJoinType   :: JoinType,
  Join -> ((Lateral, Select), (Lateral, Select))
jTables     :: ((Lateral, Select), (Lateral, Select)),
  Join -> SqlExpr
jCond       :: HSql.SqlExpr
  }
                deriving Int -> Join -> ShowS
[Join] -> ShowS
Join -> String
(Int -> Join -> ShowS)
-> (Join -> String) -> ([Join] -> ShowS) -> Show Join
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Join -> ShowS
showsPrec :: Int -> Join -> ShowS
$cshow :: Join -> String
show :: Join -> String
$cshowList :: [Join] -> ShowS
showList :: [Join] -> ShowS
Show

data Semijoin = Semijoin
  { Semijoin -> SemijoinType
sjType     :: SemijoinType
  , Semijoin -> Select
sjTable    :: Select
  , Semijoin -> Select
sjCriteria :: Select
  } deriving Int -> Semijoin -> ShowS
[Semijoin] -> ShowS
Semijoin -> String
(Int -> Semijoin -> ShowS)
-> (Semijoin -> String) -> ([Semijoin] -> ShowS) -> Show Semijoin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Semijoin -> ShowS
showsPrec :: Int -> Semijoin -> ShowS
$cshow :: Semijoin -> String
show :: Semijoin -> String
$cshowList :: [Semijoin] -> ShowS
showList :: [Semijoin] -> ShowS
Show

data Values = Values {
  Values -> SelectAttrs
vAttrs  :: SelectAttrs,
  Values -> [[SqlExpr]]
vValues :: [[HSql.SqlExpr]]
} deriving Int -> Values -> ShowS
[Values] -> ShowS
Values -> String
(Int -> Values -> ShowS)
-> (Values -> String) -> ([Values] -> ShowS) -> Show Values
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Values -> ShowS
showsPrec :: Int -> Values -> ShowS
$cshow :: Values -> String
show :: Values -> String
$cshowList :: [Values] -> ShowS
showList :: [Values] -> ShowS
Show

data Binary = Binary {
  Binary -> BinOp
bOp :: BinOp,
  Binary -> Select
bSelect1 :: Select,
  Binary -> Select
bSelect2 :: Select
} deriving Int -> Binary -> ShowS
[Binary] -> ShowS
Binary -> String
(Int -> Binary -> ShowS)
-> (Binary -> String) -> ([Binary] -> ShowS) -> Show Binary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Binary -> ShowS
showsPrec :: Int -> Binary -> ShowS
$cshow :: Binary -> String
show :: Binary -> String
$cshowList :: [Binary] -> ShowS
showList :: [Binary] -> ShowS
Show

data JoinType = LeftJoin | RightJoin | FullJoin deriving Int -> JoinType -> ShowS
[JoinType] -> ShowS
JoinType -> String
(Int -> JoinType -> ShowS)
-> (JoinType -> String) -> ([JoinType] -> ShowS) -> Show JoinType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoinType -> ShowS
showsPrec :: Int -> JoinType -> ShowS
$cshow :: JoinType -> String
show :: JoinType -> String
$cshowList :: [JoinType] -> ShowS
showList :: [JoinType] -> ShowS
Show
data SemijoinType = Semi | Anti deriving Int -> SemijoinType -> ShowS
[SemijoinType] -> ShowS
SemijoinType -> String
(Int -> SemijoinType -> ShowS)
-> (SemijoinType -> String)
-> ([SemijoinType] -> ShowS)
-> Show SemijoinType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SemijoinType -> ShowS
showsPrec :: Int -> SemijoinType -> ShowS
$cshow :: SemijoinType -> String
show :: SemijoinType -> String
$cshowList :: [SemijoinType] -> ShowS
showList :: [SemijoinType] -> ShowS
Show
data BinOp = Except | ExceptAll | Union | UnionAll | Intersect | IntersectAll deriving Int -> BinOp -> ShowS
[BinOp] -> ShowS
BinOp -> String
(Int -> BinOp -> ShowS)
-> (BinOp -> String) -> ([BinOp] -> ShowS) -> Show BinOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinOp -> ShowS
showsPrec :: Int -> BinOp -> ShowS
$cshow :: BinOp -> String
show :: BinOp -> String
$cshowList :: [BinOp] -> ShowS
showList :: [BinOp] -> ShowS
Show
data Lateral = Lateral | NonLateral deriving Int -> Lateral -> ShowS
[Lateral] -> ShowS
Lateral -> String
(Int -> Lateral -> ShowS)
-> (Lateral -> String) -> ([Lateral] -> ShowS) -> Show Lateral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lateral -> ShowS
showsPrec :: Int -> Lateral -> ShowS
$cshow :: Lateral -> String
show :: Lateral -> String
$cshowList :: [Lateral] -> ShowS
showList :: [Lateral] -> ShowS
Show
data LockStrength = Update deriving Int -> LockStrength -> ShowS
[LockStrength] -> ShowS
LockStrength -> String
(Int -> LockStrength -> ShowS)
-> (LockStrength -> String)
-> ([LockStrength] -> ShowS)
-> Show LockStrength
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LockStrength -> ShowS
showsPrec :: Int -> LockStrength -> ShowS
$cshow :: LockStrength -> String
show :: LockStrength -> String
$cshowList :: [LockStrength] -> ShowS
showList :: [LockStrength] -> ShowS
Show
data Recursive = NonRecursive | Recursive deriving Int -> Recursive -> ShowS
[Recursive] -> ShowS
Recursive -> String
(Int -> Recursive -> ShowS)
-> (Recursive -> String)
-> ([Recursive] -> ShowS)
-> Show Recursive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Recursive -> ShowS
showsPrec :: Int -> Recursive -> ShowS
$cshow :: Recursive -> String
show :: Recursive -> String
$cshowList :: [Recursive] -> ShowS
showList :: [Recursive] -> ShowS
Show
data Materialized = Materialized | NotMaterialized deriving Int -> Materialized -> ShowS
[Materialized] -> ShowS
Materialized -> String
(Int -> Materialized -> ShowS)
-> (Materialized -> String)
-> ([Materialized] -> ShowS)
-> Show Materialized
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Materialized -> ShowS
showsPrec :: Int -> Materialized -> ShowS
$cshow :: Materialized -> String
show :: Materialized -> String
$cshowList :: [Materialized] -> ShowS
showList :: [Materialized] -> ShowS
Show
data With = With {
  With -> SqlTable
wTable        :: HSql.SqlTable, -- The name of the result, i.e. WITH <name> AS
  With -> [SqlColumn]
wCols         :: [HSql.SqlColumn],
  With -> Recursive
wRecursive    :: Recursive,
  With -> Maybe Materialized
wMaterialized :: Maybe Materialized,
  With -> Select
wWith         :: Select,
  With -> Select
wSelect       :: Select
} deriving Int -> With -> ShowS
[With] -> ShowS
With -> String
(Int -> With -> ShowS)
-> (With -> String) -> ([With] -> ShowS) -> Show With
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> With -> ShowS
showsPrec :: Int -> With -> ShowS
$cshow :: With -> String
show :: With -> String
$cshowList :: [With] -> ShowS
showList :: [With] -> ShowS
Show


data Label = Label {
  Label -> String
lLabel  :: String,
  Label -> Select
lSelect :: Select
} deriving Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
(Int -> Label -> ShowS)
-> (Label -> String) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Label -> ShowS
showsPrec :: Int -> Label -> ShowS
$cshow :: Label -> String
show :: Label -> String
$cshowList :: [Label] -> ShowS
showList :: [Label] -> ShowS
Show

data Returning a = Returning a (NEL.NonEmpty HSql.SqlExpr)

data Exists = Exists
  { Exists -> Symbol
existsBinding :: Symbol
  , Exists -> Select
existsTable :: Select
  } deriving Int -> Exists -> ShowS
[Exists] -> ShowS
Exists -> String
(Int -> Exists -> ShowS)
-> (Exists -> String) -> ([Exists] -> ShowS) -> Show Exists
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Exists -> ShowS
showsPrec :: Int -> Exists -> ShowS
$cshow :: Exists -> String
show :: Exists -> String
$cshowList :: [Exists] -> ShowS
showList :: [Exists] -> ShowS
Show

sqlQueryGenerator :: PQ.PrimQueryFold' V.Void Select
sqlQueryGenerator :: PrimQueryFold' Void Select
sqlQueryGenerator = PQ.PrimQueryFold
  { unit :: Select
PQ.unit              = Select
unit
  , empty :: Void -> Select
PQ.empty             = Void -> Select
forall select. Void -> select
empty
  , baseTable :: TableIdentifier -> Bindings PrimExpr -> Select
PQ.baseTable         = TableIdentifier -> Bindings PrimExpr -> Select
baseTable
  , product :: NonEmpty (Lateral, Select) -> [PrimExpr] -> Select
PQ.product           = NonEmpty (Lateral, Select) -> [PrimExpr] -> Select
product
  , aggregate :: Bindings Aggregate -> Select -> Select
PQ.aggregate         = Bindings Aggregate -> Select -> Select
aggregate
  , window :: Bindings (WndwOp, Partition) -> Select -> Select
PQ.window            = Bindings (WndwOp, Partition) -> Select -> Select
window
  , distinctOnOrderBy :: Maybe (NonEmpty PrimExpr) -> [OrderExpr] -> Select -> Select
PQ.distinctOnOrderBy = Maybe (NonEmpty PrimExpr) -> [OrderExpr] -> Select -> Select
distinctOnOrderBy
  , limit :: LimitOp -> Select -> Select
PQ.limit             = LimitOp -> Select -> Select
limit_
  , join :: JoinType
-> PrimExpr -> (Lateral, Select) -> (Lateral, Select) -> Select
PQ.join              = JoinType
-> PrimExpr -> (Lateral, Select) -> (Lateral, Select) -> Select
join
  , semijoin :: SemijoinType -> Select -> Select -> Select
PQ.semijoin          = SemijoinType -> Select -> Select -> Select
semijoin
  , values :: [Symbol] -> NonEmpty [PrimExpr] -> Select
PQ.values            = [Symbol] -> NonEmpty [PrimExpr] -> Select
values
  , binary :: BinOp -> (Select, Select) -> Select
PQ.binary            = BinOp -> (Select, Select) -> Select
binary
  , label :: String -> Select -> Select
PQ.label             = String -> Select -> Select
label
  , relExpr :: PrimExpr -> [Symbol] -> Select
PQ.relExpr           = PrimExpr -> [Symbol] -> Select
relExpr
  , exists :: Symbol -> Select -> Select
PQ.exists            = Symbol -> Select -> Select
exists
  , rebind :: Bool -> Bindings PrimExpr -> Select -> Select
PQ.rebind            = Bool -> Bindings PrimExpr -> Select -> Select
rebind
  , forUpdate :: Select -> Select
PQ.forUpdate         = Select -> Select
forUpdate
  , with :: Recursive
-> Maybe Materialized
-> Symbol
-> [Symbol]
-> Select
-> Select
-> Select
PQ.with              = Recursive
-> Maybe Materialized
-> Symbol
-> [Symbol]
-> Select
-> Select
-> Select
with
  }

exists :: Symbol -> Select -> Select
exists :: Symbol -> Select -> Select
exists Symbol
binding Select
table = Exists -> Select
SelectExists (Symbol -> Select -> Exists
Exists Symbol
binding Select
table)

sql :: ([HPQ.PrimExpr], PQ.PrimQuery' V.Void, T.Tag) -> Select
sql :: ([PrimExpr], PrimQuery' Void, Tag) -> Select
sql ([PrimExpr]
pes, PrimQuery' Void
pq, Tag
t) = From -> Select
SelectFrom (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$ From
newSelect { attrs = SelectAttrs (ensureColumns (makeAttrs pes))
                                          , tables = oneTable pqSelect }
  where pqSelect :: Select
pqSelect = PrimQueryFold' Void Select -> PrimQuery' Void -> Select
forall a p. PrimQueryFold' a p -> PrimQuery' a -> p
PQ.foldPrimQuery PrimQueryFold' Void Select
sqlQueryGenerator PrimQuery' Void
pq
        makeAttrs :: [PrimExpr] -> [(SqlExpr, Maybe SqlColumn)]
makeAttrs = ([PrimExpr] -> [Int] -> [(SqlExpr, Maybe SqlColumn)])
-> [Int] -> [PrimExpr] -> [(SqlExpr, Maybe SqlColumn)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((PrimExpr -> Int -> (SqlExpr, Maybe SqlColumn))
-> [PrimExpr] -> [Int] -> [(SqlExpr, Maybe SqlColumn)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith PrimExpr -> Int -> (SqlExpr, Maybe SqlColumn)
makeAttr) [Int
1..]
        makeAttr :: PrimExpr -> Int -> (SqlExpr, Maybe SqlColumn)
makeAttr PrimExpr
pe Int
i = (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding (String -> Tag -> Symbol
Symbol (String
"result" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
i :: Int)) Tag
t, PrimExpr
pe)

unit :: Select
unit :: Select
unit = From -> Select
SelectFrom From
newSelect { attrs  = SelectAttrs (ensureColumns []) }

empty :: V.Void -> select
empty :: forall select. Void -> select
empty = Void -> select
forall select. Void -> select
V.absurd

oneTable :: t -> [(Lateral, t, Maybe a)]
oneTable :: forall t a. t -> [(Lateral, t, Maybe a)]
oneTable t
t = [(Lateral
NonLateral, t
t, Maybe a
forall a. Maybe a
Nothing)]

baseTable :: PQ.TableIdentifier -> [(Symbol, HPQ.PrimExpr)] -> Select
baseTable :: TableIdentifier -> Bindings PrimExpr -> Select
baseTable TableIdentifier
ti Bindings PrimExpr
columns = From -> Select
SelectFrom (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$
    From
newSelect { attrs = SelectAttrs (ensureColumns (map sqlBinding columns))
              , tables = oneTable (Table (HSql.SqlTable (PQ.tiSchemaName ti) (PQ.tiTableName ti))) }

product :: NEL.NonEmpty (PQ.Lateral, Select) -> [HPQ.PrimExpr] -> Select
product :: NonEmpty (Lateral, Select) -> [PrimExpr] -> Select
product NonEmpty (Lateral, Select)
ss [PrimExpr]
pes = From -> Select
SelectFrom (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$
    From
newSelect { tables = NEL.toList ss'
              , criteria = map sqlExpr pes }
  where ss' :: NonEmpty (Lateral, Select, Maybe a)
ss' = (((Lateral, Select) -> (Lateral, Select, Maybe a))
 -> NonEmpty (Lateral, Select)
 -> NonEmpty (Lateral, Select, Maybe a))
-> NonEmpty (Lateral, Select)
-> ((Lateral, Select) -> (Lateral, Select, Maybe a))
-> NonEmpty (Lateral, Select, Maybe a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Lateral, Select) -> (Lateral, Select, Maybe a))
-> NonEmpty (Lateral, Select)
-> NonEmpty (Lateral, Select, Maybe a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (Lateral, Select)
ss (((Lateral, Select) -> (Lateral, Select, Maybe a))
 -> NonEmpty (Lateral, Select, Maybe a))
-> ((Lateral, Select) -> (Lateral, Select, Maybe a))
-> NonEmpty (Lateral, Select, Maybe a)
forall a b. (a -> b) -> a -> b
$ (\Lateral -> Lateral
f (Lateral
a, Select
b) -> (Lateral -> Lateral
f Lateral
a, Select
b, Maybe a
forall a. Maybe a
Nothing)) ((Lateral -> Lateral)
 -> (Lateral, Select) -> (Lateral, Select, Maybe a))
-> (Lateral -> Lateral)
-> (Lateral, Select)
-> (Lateral, Select, Maybe a)
forall a b. (a -> b) -> a -> b
$ \case
          Lateral
PQ.Lateral    -> Lateral
Lateral
          Lateral
PQ.NonLateral -> Lateral
NonLateral

aggregate :: PQ.Bindings HPQ.Aggregate
          -> Select
          -> Select
aggregate :: Bindings Aggregate -> Select -> Select
aggregate Bindings Aggregate
aggrs' Select
s =
  From -> Select
SelectFrom (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$ From
newSelect { attrs = SelectAttrs (ensureColumns (map attr aggrs))
                         , tables = oneTable s
                         , groupBy = Just (groupBy' aggrs) }
  where --- Although in the presence of an aggregation function,
        --- grouping by an empty list is equivalent to omitting group
        --- by, the equivalence does not hold in the absence of an
        --- aggregation function.  In the absence of an aggregation
        --- function, group by of an empty list will return a single
        --- row (if there are any and zero rows otherwise).  A query
        --- without group by will return all rows.  This is a weakness
        --- of SQL.  Really there ought to be a separate SELECT
        --- AGGREGATE operation.
        ---
        --- Syntactically one cannot group by an empty list in SQL.
        --- We take the conservative approach of explicitly grouping
        --- by a constant if we are provided with an empty list of
        --- group bys.  This yields a single group.  (Alternatively,
        --- we could check whether any aggregation functions have been
        --- applied and only group by a constant in the case where
        --- none have.  That would make the generated SQL less noisy.)
        ---
        --- "GROUP BY 0" means group by the zeroth column so we
        --- instead use an expression rather than a constant.
        handleEmpty :: [HSql.SqlExpr] -> NEL.NonEmpty HSql.SqlExpr
        handleEmpty :: [SqlExpr] -> NonEmpty SqlExpr
handleEmpty = (SqlExpr -> SqlExpr) -> [SqlExpr] -> NonEmpty SqlExpr
forall a. (SqlExpr -> a) -> [a] -> NonEmpty a
ensureColumnsGen SqlExpr -> SqlExpr
SP.deliteral

        aggrs :: [(Symbol, HPQ.Aggregate)]
        aggrs :: Bindings Aggregate
aggrs = Bindings Aggregate
aggrs'

        groupBy' :: [(symbol, HPQ.Aggregate)]
                 -> NEL.NonEmpty HSql.SqlExpr
        groupBy' :: forall symbol. [(symbol, Aggregate)] -> NonEmpty SqlExpr
groupBy' [(symbol, Aggregate)]
aggs = [SqlExpr] -> NonEmpty SqlExpr
handleEmpty ([SqlExpr] -> NonEmpty SqlExpr) -> [SqlExpr] -> NonEmpty SqlExpr
forall a b. (a -> b) -> a -> b
$ do
          (symbol
_, HPQ.GroupBy PrimExpr
e) <- [(symbol, Aggregate)]
aggs
          SqlExpr -> [SqlExpr]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr -> [SqlExpr]) -> SqlExpr -> [SqlExpr]
forall a b. (a -> b) -> a -> b
$ PrimExpr -> SqlExpr
sqlExpr PrimExpr
e

        attr :: (Symbol, Aggregate) -> (SqlExpr, Maybe SqlColumn)
attr = (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding ((Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn))
-> ((Symbol, Aggregate) -> (Symbol, PrimExpr))
-> (Symbol, Aggregate)
-> (SqlExpr, Maybe SqlColumn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Aggregate -> PrimExpr)
-> (Symbol, Aggregate) -> (Symbol, PrimExpr)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arr.second Aggregate -> PrimExpr
aggrExpr

aggrExpr :: HPQ.Aggregate -> HPQ.PrimExpr
aggrExpr :: Aggregate -> PrimExpr
aggrExpr = \case
  HPQ.GroupBy PrimExpr
e -> PrimExpr
e
  HPQ.Aggregate Aggr' PrimExpr
aggr -> Aggr' PrimExpr -> PrimExpr
HPQ.AggrExpr Aggr' PrimExpr
aggr

window :: PQ.Bindings (HPQ.WndwOp, HPQ.Partition) -> Select -> Select
window :: Bindings (WndwOp, Partition) -> Select -> Select
window Bindings (WndwOp, Partition)
wndws' Select
s = From -> Select
SelectFrom (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$ From
newSelect
  { attrs = SelectAttrsStar (ensureColumns (map (sqlBinding . fmap (uncurry HPQ.WndwExpr)) wndws'))
  , tables = oneTable s
  }

distinctOnOrderBy :: Maybe (NEL.NonEmpty HPQ.PrimExpr) -> [HPQ.OrderExpr] -> Select -> Select
distinctOnOrderBy :: Maybe (NonEmpty PrimExpr) -> [OrderExpr] -> Select -> Select
distinctOnOrderBy Maybe (NonEmpty PrimExpr)
distinctExprs [OrderExpr]
orderExprs Select
s = From -> Select
SelectFrom (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$ From
newSelect
    { tables     = oneTable s
    , distinctOn = fmap (SG.sqlExpr SD.defaultSqlGenerator) <$> distinctExprs
    , orderBy    = map (SD.toSqlOrder SD.defaultSqlGenerator) $
        -- Postgres requires all 'DISTINCT ON' expressions to appear before any other
        -- 'ORDER BY' expressions if there are any.
        maybe [] (map (HPQ.OrderExpr ascOp) . NEL.toList) distinctExprs ++ orderExprs
    }
    where
        ascOp :: OrderOp
ascOp = HPQ.OrderOp
            { orderDirection :: OrderDirection
HPQ.orderDirection = OrderDirection
HPQ.OpAsc
            , orderNulls :: OrderNulls
HPQ.orderNulls     = OrderNulls
HPQ.NullsLast }

limit_ :: PQ.LimitOp -> Select -> Select
limit_ :: LimitOp -> Select -> Select
limit_ LimitOp
lo Select
s = From -> Select
SelectFrom (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$ From
newSelect { tables = oneTable s
                                     , limit = limit'
                                     , offset = offset' }
  where (Maybe Int
limit', Maybe Int
offset') = case LimitOp
lo of
          PQ.LimitOp Int
n         -> (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n, Maybe Int
forall a. Maybe a
Nothing)
          PQ.OffsetOp Int
n        -> (Maybe Int
forall a. Maybe a
Nothing, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
          PQ.LimitOffsetOp Int
l Int
o -> (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
l, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
o)

join :: PQ.JoinType
     -> HPQ.PrimExpr
     -> (PQ.Lateral, Select)
     -> (PQ.Lateral, Select)
     -> Select
join :: JoinType
-> PrimExpr -> (Lateral, Select) -> (Lateral, Select) -> Select
join JoinType
j PrimExpr
cond (Lateral, Select)
s1 (Lateral, Select)
s2 =
  Join -> Select
SelectJoin Join { jJoinType :: JoinType
jJoinType = JoinType -> JoinType
joinType JoinType
j
                  , jTables :: ((Lateral, Select), (Lateral, Select))
jTables   = ((Lateral -> Lateral) -> (Lateral, Select) -> (Lateral, Select)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arr.first Lateral -> Lateral
lat (Lateral, Select)
s1, (Lateral -> Lateral) -> (Lateral, Select) -> (Lateral, Select)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arr.first Lateral -> Lateral
lat (Lateral, Select)
s2)
                  , jCond :: SqlExpr
jCond     = PrimExpr -> SqlExpr
sqlExpr PrimExpr
cond }
  where lat :: Lateral -> Lateral
lat = \case
          Lateral
PQ.Lateral -> Lateral
Lateral
          Lateral
PQ.NonLateral -> Lateral
NonLateral

semijoin :: PQ.SemijoinType -> Select -> Select -> Select
semijoin :: SemijoinType -> Select -> Select -> Select
semijoin SemijoinType
t Select
q1 Select
q2 = Semijoin -> Select
SelectSemijoin (SemijoinType -> Select -> Select -> Semijoin
Semijoin (SemijoinType -> SemijoinType
semijoinType SemijoinType
t) Select
q1 Select
q2)


-- Postgres seems to name columns of VALUES clauses "column1",
-- "column2", ... . I'm not sure to what extent it is customisable or
-- how robust it is to rely on this
values :: [Symbol] -> NEL.NonEmpty [HPQ.PrimExpr] -> Select
values :: [Symbol] -> NonEmpty [PrimExpr] -> Select
values [Symbol]
columns NonEmpty [PrimExpr]
pes = Values -> Select
SelectValues Values { vAttrs :: SelectAttrs
vAttrs  = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrs ([Symbol] -> NonEmpty (SqlExpr, Maybe SqlColumn)
mkColumns [Symbol]
columns)
                                         , vValues :: [[SqlExpr]]
vValues = NonEmpty [SqlExpr] -> [[SqlExpr]]
forall a. NonEmpty a -> [a]
NEL.toList ((([PrimExpr] -> [SqlExpr])
-> NonEmpty [PrimExpr] -> NonEmpty [SqlExpr]
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([PrimExpr] -> [SqlExpr])
 -> NonEmpty [PrimExpr] -> NonEmpty [SqlExpr])
-> ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr])
-> (PrimExpr -> SqlExpr)
-> NonEmpty [PrimExpr]
-> NonEmpty [SqlExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map) PrimExpr -> SqlExpr
sqlExpr NonEmpty [PrimExpr]
pes) }
  where mkColumns :: [Symbol] -> NonEmpty (SqlExpr, Maybe SqlColumn)
mkColumns = [(SqlExpr, Maybe SqlColumn)] -> NonEmpty (SqlExpr, Maybe SqlColumn)
forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns ([(SqlExpr, Maybe SqlColumn)]
 -> NonEmpty (SqlExpr, Maybe SqlColumn))
-> ([Symbol] -> [(SqlExpr, Maybe SqlColumn)])
-> [Symbol]
-> NonEmpty (SqlExpr, Maybe SqlColumn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Symbol -> (SqlExpr, Maybe SqlColumn))
-> [Int] -> [Symbol] -> [(SqlExpr, Maybe SqlColumn)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Symbol -> Int -> (SqlExpr, Maybe SqlColumn))
-> Int -> Symbol -> (SqlExpr, Maybe SqlColumn)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Symbol, Int) -> (SqlExpr, Maybe SqlColumn))
-> Symbol -> Int -> (SqlExpr, Maybe SqlColumn)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry ((Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding ((Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn))
-> ((Symbol, Int) -> (Symbol, PrimExpr))
-> (Symbol, Int)
-> (SqlExpr, Maybe SqlColumn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> PrimExpr) -> (Symbol, Int) -> (Symbol, PrimExpr)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arr.second Int -> PrimExpr
mkColumn))) [Int
1..]
        mkColumn :: Int -> PrimExpr
mkColumn Int
i = (String -> PrimExpr
HPQ.BaseTableAttrExpr (String -> PrimExpr) -> (Int -> String) -> Int -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"column" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) (Int
i::Int)

binary :: PQ.BinOp -> (Select, Select) -> Select
binary :: BinOp -> (Select, Select) -> Select
binary BinOp
op (Select
select1, Select
select2) = Binary -> Select
SelectBinary Binary {
  bOp :: BinOp
bOp = BinOp -> BinOp
binOp BinOp
op,
  bSelect1 :: Select
bSelect1 = Select
select1,
  bSelect2 :: Select
bSelect2 = Select
select2
  }

with :: PQ.Recursive -> Maybe PQ.Materialized -> Symbol -> [Symbol] -> Select -> Select -> Select
with :: Recursive
-> Maybe Materialized
-> Symbol
-> [Symbol]
-> Select
-> Select
-> Select
with Recursive
recursive Maybe Materialized
materialized Symbol
name [Symbol]
cols Select
wWith Select
wSelect =
  From -> Select
SelectFrom
    From
newSelect
      { attrs = Star
      , tables = [(NonLateral, SelectWith $ With {..}, Nothing)]
      }
  where
   wTable :: SqlTable
wTable = Maybe String -> String -> SqlTable
HSql.SqlTable Maybe String
forall a. Maybe a
Nothing (Symbol -> String
sqlSymbol Symbol
name)
   wRecursive :: Recursive
wRecursive = case Recursive
recursive of
     Recursive
PQ.NonRecursive -> Recursive
NonRecursive
     Recursive
PQ.Recursive -> Recursive
Recursive
   wMaterialized :: Maybe Materialized
wMaterialized = case Maybe Materialized
materialized of
     Maybe Materialized
Nothing -> Maybe Materialized
forall a. Maybe a
Nothing
     Just Materialized
PQ.Materialized -> Materialized -> Maybe Materialized
forall a. a -> Maybe a
Just Materialized
Materialized
     Just Materialized
PQ.NotMaterialized -> Materialized -> Maybe Materialized
forall a. a -> Maybe a
Just Materialized
NotMaterialized
   wCols :: [SqlColumn]
wCols = (Symbol -> SqlColumn) -> [Symbol] -> [SqlColumn]
forall a b. (a -> b) -> [a] -> [b]
map (String -> SqlColumn
HSql.SqlColumn (String -> SqlColumn) -> (Symbol -> String) -> Symbol -> SqlColumn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> String
sqlSymbol) [Symbol]
cols


joinType :: PQ.JoinType -> JoinType
joinType :: JoinType -> JoinType
joinType JoinType
PQ.LeftJoin = JoinType
LeftJoin
joinType JoinType
PQ.RightJoin = JoinType
RightJoin
joinType JoinType
PQ.FullJoin = JoinType
FullJoin

semijoinType :: PQ.SemijoinType -> SemijoinType
semijoinType :: SemijoinType -> SemijoinType
semijoinType SemijoinType
PQ.Semi = SemijoinType
Semi
semijoinType SemijoinType
PQ.Anti = SemijoinType
Anti

binOp :: PQ.BinOp -> BinOp
binOp :: BinOp -> BinOp
binOp BinOp
o = case BinOp
o of
  BinOp
PQ.Except       -> BinOp
Except
  BinOp
PQ.ExceptAll    -> BinOp
ExceptAll
  BinOp
PQ.Union        -> BinOp
Union
  BinOp
PQ.UnionAll     -> BinOp
UnionAll
  BinOp
PQ.Intersect    -> BinOp
Intersect
  BinOp
PQ.IntersectAll -> BinOp
IntersectAll

newSelect :: From
newSelect :: From
newSelect = From {
  attrs :: SelectAttrs
attrs      = SelectAttrs
Star,
  tables :: [(Lateral, Select, Maybe [SqlColumn])]
tables     = [],
  criteria :: [SqlExpr]
criteria   = [],
  groupBy :: Maybe (NonEmpty SqlExpr)
groupBy    = Maybe (NonEmpty SqlExpr)
forall a. Maybe a
Nothing,
  orderBy :: [(SqlExpr, SqlOrder)]
orderBy    = [],
  distinctOn :: Maybe (NonEmpty SqlExpr)
distinctOn = Maybe (NonEmpty SqlExpr)
forall a. Maybe a
Nothing,
  limit :: Maybe Int
limit      = Maybe Int
forall a. Maybe a
Nothing,
  offset :: Maybe Int
offset     = Maybe Int
forall a. Maybe a
Nothing,
  for :: Maybe LockStrength
for        = Maybe LockStrength
forall a. Maybe a
Nothing
  }

sqlExpr :: HPQ.PrimExpr -> HSql.SqlExpr
sqlExpr :: PrimExpr -> SqlExpr
sqlExpr = SqlGenerator -> PrimExpr -> SqlExpr
SG.sqlExpr SqlGenerator
SD.defaultSqlGenerator

sqlSymbol :: Symbol -> String
sqlSymbol :: Symbol -> String
sqlSymbol (Symbol String
sym Tag
t) = Tag -> ShowS
T.tagWith Tag
t String
sym

sqlBinding :: (Symbol, HPQ.PrimExpr) -> (HSql.SqlExpr, Maybe HSql.SqlColumn)
sqlBinding :: (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding (Symbol
s, PrimExpr
pe) = (PrimExpr -> SqlExpr
sqlExpr PrimExpr
pe, SqlColumn -> Maybe SqlColumn
forall a. a -> Maybe a
Just (String -> SqlColumn
HSql.SqlColumn (Symbol -> String
sqlSymbol Symbol
s)))

ensureColumns :: [(HSql.SqlExpr, Maybe a)]
             -> NEL.NonEmpty (HSql.SqlExpr, Maybe a)
ensureColumns :: forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns = (SqlExpr -> (SqlExpr, Maybe a))
-> [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
forall a. (SqlExpr -> a) -> [a] -> NonEmpty a
ensureColumnsGen (\SqlExpr
x -> (SqlExpr
x,Maybe a
forall a. Maybe a
Nothing))

-- | For ensuring that we have at least one column in a SELECT or RETURNING
ensureColumnsGen :: (HSql.SqlExpr -> a)
              -> [a]
              -> NEL.NonEmpty a
ensureColumnsGen :: forall a. (SqlExpr -> a) -> [a] -> NonEmpty a
ensureColumnsGen SqlExpr -> a
f = NonEmpty a -> Maybe (NonEmpty a) -> NonEmpty a
forall a. a -> Maybe a -> a
M.fromMaybe (a -> NonEmpty a
forall a. a -> NonEmpty a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> NonEmpty a) -> (SqlExpr -> a) -> SqlExpr -> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlExpr -> a
f (SqlExpr -> NonEmpty a) -> SqlExpr -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ String -> SqlExpr
HSql.ConstSqlExpr String
"0")
                   (Maybe (NonEmpty a) -> NonEmpty a)
-> ([a] -> Maybe (NonEmpty a)) -> [a] -> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty

label :: String -> Select -> Select
label :: String -> Select -> Select
label String
l Select
s = Label -> Select
SelectLabel (String -> Select -> Label
Label String
l Select
s)

-- Very similar to 'baseTable'
relExpr :: HPQ.PrimExpr -> [Symbol] -> Select
relExpr :: PrimExpr -> [Symbol] -> Select
relExpr PrimExpr
pe [Symbol]
columns = From -> Select
SelectFrom (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$
    From
newSelect { attrs = Star
              , tables = [(NonLateral, RelExpr (sqlExpr pe), Just columns')]
              }
  where
    columns' :: [SqlColumn]
columns' = String -> SqlColumn
HSql.SqlColumn (String -> SqlColumn) -> (Symbol -> String) -> Symbol -> SqlColumn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> String
sqlSymbol (Symbol -> SqlColumn) -> [Symbol] -> [SqlColumn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
columns

rebind :: Bool -> [(Symbol, HPQ.PrimExpr)] -> Select -> Select
rebind :: Bool -> Bindings PrimExpr -> Select -> Select
rebind Bool
star Bindings PrimExpr
pes Select
select = From -> Select
SelectFrom From
newSelect
  { attrs = selectAttrs (ensureColumns (map sqlBinding pes))
  , tables = oneTable select
  }
  where selectAttrs :: NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
selectAttrs = case Bool
star of
          Bool
True  -> NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrsStar
          Bool
False -> NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrs

forUpdate :: Select -> Select
forUpdate :: Select -> Select
forUpdate Select
s = From -> Select
SelectFrom From
newSelect {
    tables = [(NonLateral, s, Nothing)]
  , for = Just Update
  }