{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Opaleye.Internal.Sql where
import Prelude hiding (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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Select] -> ShowS
$cshowList :: [Select] -> ShowS
show :: Select -> String
$cshow :: Select -> String
showsPrec :: Int -> Select -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectAttrs] -> ShowS
$cshowList :: [SelectAttrs] -> ShowS
show :: SelectAttrs -> String
$cshow :: SelectAttrs -> String
showsPrec :: Int -> SelectAttrs -> ShowS
$cshowsPrec :: Int -> SelectAttrs -> ShowS
Show
data From = From {
From -> SelectAttrs
attrs :: SelectAttrs,
From -> [(Lateral, Select)]
tables :: [(Lateral, Select)],
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [From] -> ShowS
$cshowList :: [From] -> ShowS
show :: From -> String
$cshow :: From -> String
showsPrec :: Int -> From -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Join] -> ShowS
$cshowList :: [Join] -> ShowS
show :: Join -> String
$cshow :: Join -> String
showsPrec :: Int -> Join -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Semijoin] -> ShowS
$cshowList :: [Semijoin] -> ShowS
show :: Semijoin -> String
$cshow :: Semijoin -> String
showsPrec :: Int -> Semijoin -> ShowS
$cshowsPrec :: Int -> Semijoin -> ShowS
Show
data Values = Values {
Values -> SelectAttrs
vAttrs :: SelectAttrs,
Values -> [[SqlExpr]]
vValues :: [[HSql.SqlExpr]]
} deriving Int -> Values -> ShowS
[Values] -> ShowS
Values -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Values] -> ShowS
$cshowList :: [Values] -> ShowS
show :: Values -> String
$cshow :: Values -> String
showsPrec :: Int -> Values -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binary] -> ShowS
$cshowList :: [Binary] -> ShowS
show :: Binary -> String
$cshow :: Binary -> String
showsPrec :: Int -> Binary -> ShowS
$cshowsPrec :: Int -> Binary -> 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 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 Lateral = Lateral | NonLateral 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
data LockStrength = Update deriving Int -> LockStrength -> ShowS
[LockStrength] -> ShowS
LockStrength -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LockStrength] -> ShowS
$cshowList :: [LockStrength] -> ShowS
show :: LockStrength -> String
$cshow :: LockStrength -> String
showsPrec :: Int -> LockStrength -> ShowS
$cshowsPrec :: Int -> LockStrength -> ShowS
Show
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
data With = With {
With -> SqlTable
wTable :: HSql.SqlTable,
With -> [SqlColumn]
wCols :: [HSql.SqlColumn],
With -> Recursive
wRecursive :: Recursive,
With -> Select
wWith :: Select,
With -> Select
wSelect :: Select
} deriving Int -> With -> ShowS
[With] -> ShowS
With -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [With] -> ShowS
$cshowList :: [With] -> ShowS
show :: With -> String
$cshow :: With -> String
showsPrec :: Int -> With -> ShowS
$cshowsPrec :: Int -> With -> ShowS
Show
data Label = Label {
Label -> String
lLabel :: String,
Label -> Select
lSelect :: Select
} deriving Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exists] -> ShowS
$cshowList :: [Exists] -> ShowS
show :: Exists -> String
$cshow :: Exists -> String
showsPrec :: Int -> Exists -> ShowS
$cshowsPrec :: Int -> 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 = 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 (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
-> Select -> Select
PQ.aggregate = Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
-> Select -> Select
aggregate
, 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 -> Bindings PrimExpr -> Select
PQ.relExpr = PrimExpr -> Bindings PrimExpr -> 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 -> Symbol -> [Symbol] -> Select -> Select -> Select
PQ.with = Recursive -> 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 forall a b. (a -> b) -> a -> b
$ From
newSelect { attrs :: SelectAttrs
attrs = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrs (forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns ([PrimExpr] -> [(SqlExpr, Maybe SqlColumn)]
makeAttrs [PrimExpr]
pes))
, tables :: [(Lateral, Select)]
tables = forall t. t -> [(Lateral, t)]
oneTable Select
pqSelect }
where pqSelect :: Select
pqSelect = forall a p. PrimQueryFold' a p -> PrimQuery' a -> p
PQ.foldPrimQuery PrimQueryFold' Void Select
sqlQueryGenerator PrimQuery' Void
pq
makeAttrs :: [PrimExpr] -> [(SqlExpr, Maybe SqlColumn)]
makeAttrs = forall a b c. (a -> b -> c) -> b -> a -> c
flip (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" forall a. [a] -> [a] -> [a]
++ 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
attrs = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrs (forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns []) }
empty :: V.Void -> select
empty :: forall select. Void -> select
empty = forall select. Void -> select
V.absurd
oneTable :: t -> [(Lateral, t)]
oneTable :: forall t. t -> [(Lateral, t)]
oneTable t
t = [(Lateral
NonLateral, t
t)]
baseTable :: PQ.TableIdentifier -> [(Symbol, HPQ.PrimExpr)] -> Select
baseTable :: TableIdentifier -> Bindings PrimExpr -> Select
baseTable TableIdentifier
ti Bindings PrimExpr
columns = From -> Select
SelectFrom forall a b. (a -> b) -> a -> b
$
From
newSelect { attrs :: SelectAttrs
attrs = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrs (forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns (forall a b. (a -> b) -> [a] -> [b]
map (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding Bindings PrimExpr
columns))
, tables :: [(Lateral, Select)]
tables = forall t. t -> [(Lateral, t)]
oneTable (SqlTable -> Select
Table (Maybe String -> String -> SqlTable
HSql.SqlTable (TableIdentifier -> Maybe String
PQ.tiSchemaName TableIdentifier
ti) (TableIdentifier -> String
PQ.tiTableName TableIdentifier
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 forall a b. (a -> b) -> a -> b
$
From
newSelect { tables :: [(Lateral, Select)]
tables = forall a. NonEmpty a -> [a]
NEL.toList NonEmpty (Lateral, Select)
ss'
, criteria :: [SqlExpr]
criteria = forall a b. (a -> b) -> [a] -> [b]
map PrimExpr -> SqlExpr
sqlExpr [PrimExpr]
pes }
where ss' :: NonEmpty (Lateral, Select)
ss' = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (Lateral, Select)
ss forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arr.first forall a b. (a -> b) -> a -> b
$ \case
Lateral
PQ.Lateral -> Lateral
Lateral
Lateral
PQ.NonLateral -> Lateral
NonLateral
aggregate :: [(Symbol,
(Maybe (HPQ.AggrOp, [HPQ.OrderExpr], HPQ.AggrDistinct),
HPQ.Symbol))]
-> Select
-> Select
aggregate :: Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
-> Select -> Select
aggregate Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
aggrs' Select
s =
From -> Select
SelectFrom forall a b. (a -> b) -> a -> b
$ From
newSelect { attrs :: SelectAttrs
attrs = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrs (forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns (forall a b. (a -> b) -> [a] -> [b]
map (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))
-> (SqlExpr, Maybe SqlColumn)
attr [(Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))]
aggrs))
, tables :: [(Lateral, Select)]
tables = forall t. t -> [(Lateral, t)]
oneTable Select
s
, groupBy :: Maybe (NonEmpty SqlExpr)
groupBy = (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall symbol aggrOp.
[(symbol, (Maybe aggrOp, PrimExpr))] -> NonEmpty SqlExpr
groupBy') [(Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))]
aggrs }
where
handleEmpty :: [HSql.SqlExpr] -> NEL.NonEmpty HSql.SqlExpr
handleEmpty :: [SqlExpr] -> NonEmpty SqlExpr
handleEmpty = forall a. (SqlExpr -> a) -> [a] -> NonEmpty a
ensureColumnsGen SqlExpr -> SqlExpr
SP.deliteral
aggrs :: [(Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))]
aggrs = (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arr.second forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arr.second) Symbol -> PrimExpr
HPQ.AttrExpr Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
aggrs'
groupBy' :: [(symbol, (Maybe aggrOp, HPQ.PrimExpr))]
-> NEL.NonEmpty HSql.SqlExpr
groupBy' :: forall symbol aggrOp.
[(symbol, (Maybe aggrOp, PrimExpr))] -> NonEmpty SqlExpr
groupBy' = [SqlExpr] -> NonEmpty SqlExpr
handleEmpty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map PrimExpr -> SqlExpr
sqlExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {b}. (a, (a, b)) -> b
expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
M.isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a} {b}. (a, (a, b)) -> a
aggrOp)
attr :: (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))
-> (SqlExpr, Maybe SqlColumn)
attr = (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arr.second (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe (AggrOp, [OrderExpr], AggrDistinct) -> PrimExpr -> PrimExpr
aggrExpr)
expr :: (a, (a, b)) -> b
expr (a
_, (a
_, b
e)) = b
e
aggrOp :: (a, (a, b)) -> a
aggrOp (a
_, (a
x, b
_)) = a
x
aggrExpr :: Maybe (HPQ.AggrOp, [HPQ.OrderExpr], HPQ.AggrDistinct) -> HPQ.PrimExpr -> HPQ.PrimExpr
aggrExpr :: Maybe (AggrOp, [OrderExpr], AggrDistinct) -> PrimExpr -> PrimExpr
aggrExpr = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\(AggrOp
op, [OrderExpr]
ord, AggrDistinct
distinct) PrimExpr
e -> AggrDistinct -> AggrOp -> PrimExpr -> [OrderExpr] -> PrimExpr
HPQ.AggrExpr AggrDistinct
distinct AggrOp
op PrimExpr
e [OrderExpr]
ord)
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 forall a b. (a -> b) -> a -> b
$ From
newSelect
{ tables :: [(Lateral, Select)]
tables = forall t. t -> [(Lateral, t)]
oneTable Select
s
, distinctOn :: Maybe (NonEmpty SqlExpr)
distinctOn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SqlGenerator -> PrimExpr -> SqlExpr
SG.sqlExpr SqlGenerator
SD.defaultSqlGenerator) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty PrimExpr)
distinctExprs
, orderBy :: [(SqlExpr, SqlOrder)]
orderBy = forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> OrderExpr -> (SqlExpr, SqlOrder)
SD.toSqlOrder SqlGenerator
SD.defaultSqlGenerator) forall a b. (a -> b) -> a -> b
$
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. (a -> b) -> [a] -> [b]
map (OrderOp -> PrimExpr -> OrderExpr
HPQ.OrderExpr OrderOp
ascOp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NEL.toList) Maybe (NonEmpty PrimExpr)
distinctExprs forall a. [a] -> [a] -> [a]
++ [OrderExpr]
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 forall a b. (a -> b) -> a -> b
$ From
newSelect { tables :: [(Lateral, Select)]
tables = forall t. t -> [(Lateral, t)]
oneTable Select
s
, limit :: Maybe Int
limit = Maybe Int
limit'
, offset :: Maybe Int
offset = Maybe Int
offset' }
where (Maybe Int
limit', Maybe Int
offset') = case LimitOp
lo of
PQ.LimitOp Int
n -> (forall a. a -> Maybe a
Just Int
n, forall a. Maybe a
Nothing)
PQ.OffsetOp Int
n -> (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just Int
n)
PQ.LimitOffsetOp Int
l Int
o -> (forall a. a -> Maybe a
Just Int
l, 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 = (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arr.first Lateral -> Lateral
lat (Lateral, Select)
s1, 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 = forall a. NonEmpty a -> [a]
NEL.toList ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) PrimExpr -> SqlExpr
sqlExpr NonEmpty [PrimExpr]
pes) }
where mkColumns :: [Symbol] -> NonEmpty (SqlExpr, Maybe SqlColumn)
mkColumns = forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b c. ((a, b) -> c) -> a -> b -> c
curry ((Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding forall b c a. (b -> c) -> (a -> b) -> a -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"column" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> Symbol -> [Symbol]-> Select -> Select -> Select
with :: Recursive -> Symbol -> [Symbol] -> Select -> Select -> Select
with Recursive
recursive Symbol
name [Symbol]
cols Select
wWith Select
wSelect = With -> Select
SelectWith forall a b. (a -> b) -> a -> b
$ With {[SqlColumn]
SqlTable
Recursive
Select
wCols :: [SqlColumn]
wRecursive :: Recursive
wTable :: SqlTable
wSelect :: Select
wWith :: Select
wSelect :: Select
wWith :: Select
wRecursive :: Recursive
wCols :: [SqlColumn]
wTable :: SqlTable
..}
where
wTable :: SqlTable
wTable = Maybe String -> String -> SqlTable
HSql.SqlTable 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
wCols :: [SqlColumn]
wCols = forall a b. (a -> b) -> [a] -> [b]
map (String -> SqlColumn
HSql.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)]
tables = [],
criteria :: [SqlExpr]
criteria = [],
groupBy :: Maybe (NonEmpty SqlExpr)
groupBy = forall a. Maybe a
Nothing,
orderBy :: [(SqlExpr, SqlOrder)]
orderBy = [],
distinctOn :: Maybe (NonEmpty SqlExpr)
distinctOn = forall a. Maybe a
Nothing,
limit :: Maybe Int
limit = forall a. Maybe a
Nothing,
offset :: Maybe Int
offset = forall a. Maybe a
Nothing,
for :: Maybe LockStrength
for = 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, 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 = forall a. (SqlExpr -> a) -> [a] -> NonEmpty a
ensureColumnsGen (\SqlExpr
x -> (SqlExpr
x,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 = forall a. a -> Maybe a -> a
M.fromMaybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlExpr -> a
f forall a b. (a -> b) -> a -> b
$ String -> SqlExpr
HSql.ConstSqlExpr String
"0")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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, HPQ.PrimExpr)] -> Select
relExpr :: PrimExpr -> Bindings PrimExpr -> Select
relExpr PrimExpr
pe Bindings PrimExpr
columns = From -> Select
SelectFrom forall a b. (a -> b) -> a -> b
$
From
newSelect { attrs :: SelectAttrs
attrs = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrs (forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns (forall a b. (a -> b) -> [a] -> [b]
map (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding Bindings PrimExpr
columns))
, tables :: [(Lateral, Select)]
tables = forall t. t -> [(Lateral, t)]
oneTable (SqlExpr -> Select
RelExpr (PrimExpr -> SqlExpr
sqlExpr PrimExpr
pe))
}
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
attrs = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
selectAttrs (forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns (forall a b. (a -> b) -> [a] -> [b]
map (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding Bindings PrimExpr
pes))
, tables :: [(Lateral, Select)]
tables = forall t. t -> [(Lateral, t)]
oneTable Select
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 :: [(Lateral, Select)]
tables = [(Lateral
NonLateral, Select
s)]
, for :: Maybe LockStrength
for = forall a. a -> Maybe a
Just LockStrength
Update
}