{-# 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
| 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))
| (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,
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
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) $
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)
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))
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)
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
}