{-# LANGUAGE LambdaCase #-}

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
            -- ^ A relation-valued expression
            | SelectJoin Join
            | SelectSemijoin Semijoin
            | SelectValues Values
            | SelectBinary Binary
            | SelectLabel Label
            | SelectExists Exists
            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
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))
  | 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
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
(Int -> From -> ShowS)
-> (From -> String) -> ([From] -> ShowS) -> Show From
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 -> (Select, Select)
jTables     :: (Select, 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
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
(Int -> Semijoin -> ShowS)
-> (Semijoin -> String) -> ([Semijoin] -> ShowS) -> Show Semijoin
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
(Int -> Values -> ShowS)
-> (Values -> String) -> ([Values] -> ShowS) -> Show Values
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
(Int -> Binary -> ShowS)
-> (Binary -> String) -> ([Binary] -> ShowS) -> Show Binary
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
(Int -> JoinType -> ShowS)
-> (JoinType -> String) -> ([JoinType] -> ShowS) -> Show JoinType
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
(Int -> SemijoinType -> ShowS)
-> (SemijoinType -> String)
-> ([SemijoinType] -> ShowS)
-> Show SemijoinType
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
(Int -> BinOp -> ShowS)
-> (BinOp -> String) -> ([BinOp] -> ShowS) -> Show BinOp
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
(Int -> Lateral -> ShowS)
-> (Lateral -> String) -> ([Lateral] -> ShowS) -> Show Lateral
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
(Int -> LockStrength -> ShowS)
-> (LockStrength -> String)
-> ([LockStrength] -> ShowS)
-> Show LockStrength
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 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
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
(Int -> Exists -> ShowS)
-> (Exists -> String) -> ([Exists] -> ShowS) -> Show Exists
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 = PrimQueryFold :: forall a p.
p
-> (a -> p)
-> (TableIdentifier -> Bindings PrimExpr -> p)
-> (NonEmpty (Lateral, p) -> [PrimExpr] -> p)
-> (Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
    -> p -> p)
-> (Maybe (NonEmpty PrimExpr) -> [OrderExpr] -> p -> p)
-> (LimitOp -> p -> p)
-> (JoinType
    -> PrimExpr
    -> Bindings PrimExpr
    -> Bindings PrimExpr
    -> p
    -> p
    -> p)
-> (SemijoinType -> p -> p -> p)
-> (Symbol -> p -> p)
-> ([Symbol] -> NonEmpty [PrimExpr] -> p)
-> (BinOp -> (p, p) -> p)
-> (String -> p -> p)
-> (PrimExpr -> Bindings PrimExpr -> p)
-> (Bool -> Bindings PrimExpr -> p -> p)
-> (p -> p)
-> PrimQueryFold' a p
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 (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
-> Bindings PrimExpr
-> Bindings PrimExpr
-> Select
-> Select
-> Select
PQ.join              = JoinType
-> PrimExpr
-> Bindings PrimExpr
-> Bindings PrimExpr
-> Select
-> 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
  }

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
attrs = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrs ([(SqlExpr, Maybe SqlColumn)] -> NonEmpty (SqlExpr, Maybe SqlColumn)
forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns ([PrimExpr] -> [(SqlExpr, Maybe SqlColumn)]
makeAttrs [PrimExpr]
pes))
                                          , tables :: [(Lateral, Select)]
tables = Select -> [(Lateral, Select)]
forall t. t -> [(Lateral, t)]
oneTable Select
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
attrs  = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrs ([(SqlExpr, Maybe SqlColumn)] -> NonEmpty (SqlExpr, Maybe SqlColumn)
forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns []) }

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

oneTable :: t -> [(Lateral, t)]
oneTable :: 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 (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$
    From
newSelect { attrs :: SelectAttrs
attrs = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrs ([(SqlExpr, Maybe SqlColumn)] -> NonEmpty (SqlExpr, Maybe SqlColumn)
forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns (((Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn))
-> Bindings PrimExpr -> [(SqlExpr, Maybe SqlColumn)]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding Bindings PrimExpr
columns))
              , tables :: [(Lateral, Select)]
tables = Select -> [(Lateral, Select)]
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 (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$
    From
newSelect { tables :: [(Lateral, Select)]
tables = NonEmpty (Lateral, Select) -> [(Lateral, Select)]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty (Lateral, Select)
ss'
              , criteria :: [SqlExpr]
criteria = (PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map PrimExpr -> SqlExpr
sqlExpr [PrimExpr]
pes }
  where ss' :: NonEmpty (Lateral, Select)
ss' = (((Lateral, Select) -> (Lateral, Select))
 -> NonEmpty (Lateral, Select) -> NonEmpty (Lateral, Select))
-> NonEmpty (Lateral, Select)
-> ((Lateral, Select) -> (Lateral, Select))
-> NonEmpty (Lateral, Select)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Lateral, Select) -> (Lateral, Select))
-> NonEmpty (Lateral, Select) -> NonEmpty (Lateral, Select)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (Lateral, Select)
ss (((Lateral, Select) -> (Lateral, Select))
 -> NonEmpty (Lateral, Select))
-> ((Lateral, Select) -> (Lateral, Select))
-> NonEmpty (Lateral, Select)
forall a b. (a -> b) -> a -> b
$ (Lateral -> Lateral) -> (Lateral, Select) -> (Lateral, Select)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arr.first ((Lateral -> Lateral) -> (Lateral, Select) -> (Lateral, Select))
-> (Lateral -> Lateral) -> (Lateral, Select) -> (Lateral, Select)
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 (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$ From
newSelect { attrs :: SelectAttrs
attrs = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrs ([(SqlExpr, Maybe SqlColumn)] -> NonEmpty (SqlExpr, Maybe SqlColumn)
forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns (((Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))
 -> (SqlExpr, Maybe SqlColumn))
-> [(Symbol,
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))]
-> [(SqlExpr, Maybe SqlColumn)]
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 = Select -> [(Lateral, Select)]
forall t. t -> [(Lateral, t)]
oneTable Select
s
                         , groupBy :: Maybe (NonEmpty SqlExpr)
groupBy = (NonEmpty SqlExpr -> Maybe (NonEmpty SqlExpr)
forall a. a -> Maybe a
Just (NonEmpty SqlExpr -> Maybe (NonEmpty SqlExpr))
-> ([(Symbol,
      (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))]
    -> NonEmpty SqlExpr)
-> [(Symbol,
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))]
-> Maybe (NonEmpty SqlExpr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))]
-> NonEmpty SqlExpr
forall symbol aggrOp.
[(symbol, (Maybe aggrOp, PrimExpr))] -> NonEmpty SqlExpr
groupBy') [(Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))]
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 =
          NonEmpty SqlExpr -> Maybe (NonEmpty SqlExpr) -> NonEmpty SqlExpr
forall a. a -> Maybe a -> a
M.fromMaybe (SqlExpr -> NonEmpty SqlExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlExpr -> SqlExpr
SP.deliteral (String -> SqlExpr
HSql.ConstSqlExpr String
"0")))
          (Maybe (NonEmpty SqlExpr) -> NonEmpty SqlExpr)
-> ([SqlExpr] -> Maybe (NonEmpty SqlExpr))
-> [SqlExpr]
-> NonEmpty SqlExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SqlExpr] -> Maybe (NonEmpty SqlExpr)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty

        aggrs :: [(Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))]
aggrs = (((Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol))
 -> (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)))
-> Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
-> [(Symbol,
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))]
forall a b. (a -> b) -> [a] -> [b]
map (((Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol))
  -> (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)))
 -> Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
 -> [(Symbol,
      (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))])
-> ((Symbol -> PrimExpr)
    -> (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol))
    -> (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)))
-> (Symbol -> PrimExpr)
-> Bindings (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
-> [(Symbol,
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
 -> (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))
-> (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol))
-> (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arr.second (((Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
  -> (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))
 -> (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol))
 -> (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)))
-> ((Symbol -> PrimExpr)
    -> (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
    -> (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))
-> (Symbol -> PrimExpr)
-> (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol))
-> (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> PrimExpr)
-> (Maybe (AggrOp, [OrderExpr], AggrDistinct), Symbol)
-> (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
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' :: [(symbol, (Maybe aggrOp, PrimExpr))] -> NonEmpty SqlExpr
groupBy' = [SqlExpr] -> NonEmpty SqlExpr
handleEmpty
                   ([SqlExpr] -> NonEmpty SqlExpr)
-> ([(symbol, (Maybe aggrOp, PrimExpr))] -> [SqlExpr])
-> [(symbol, (Maybe aggrOp, 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
                   ([PrimExpr] -> [SqlExpr])
-> ([(symbol, (Maybe aggrOp, PrimExpr))] -> [PrimExpr])
-> [(symbol, (Maybe aggrOp, PrimExpr))]
-> [SqlExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((symbol, (Maybe aggrOp, PrimExpr)) -> PrimExpr)
-> [(symbol, (Maybe aggrOp, PrimExpr))] -> [PrimExpr]
forall a b. (a -> b) -> [a] -> [b]
map (symbol, (Maybe aggrOp, PrimExpr)) -> PrimExpr
forall a a b. (a, (a, b)) -> b
expr
                   ([(symbol, (Maybe aggrOp, PrimExpr))] -> [PrimExpr])
-> ([(symbol, (Maybe aggrOp, PrimExpr))]
    -> [(symbol, (Maybe aggrOp, PrimExpr))])
-> [(symbol, (Maybe aggrOp, PrimExpr))]
-> [PrimExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((symbol, (Maybe aggrOp, PrimExpr)) -> Bool)
-> [(symbol, (Maybe aggrOp, PrimExpr))]
-> [(symbol, (Maybe aggrOp, PrimExpr))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe aggrOp -> Bool
forall a. Maybe a -> Bool
M.isNothing (Maybe aggrOp -> Bool)
-> ((symbol, (Maybe aggrOp, PrimExpr)) -> Maybe aggrOp)
-> (symbol, (Maybe aggrOp, PrimExpr))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (symbol, (Maybe aggrOp, PrimExpr)) -> Maybe aggrOp
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 ((Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn))
-> ((Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))
    -> (Symbol, PrimExpr))
-> (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))
-> (SqlExpr, Maybe SqlColumn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) -> PrimExpr)
-> (Symbol, (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr))
-> (Symbol, PrimExpr)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arr.second ((Maybe (AggrOp, [OrderExpr], AggrDistinct) -> PrimExpr -> PrimExpr)
-> (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
-> PrimExpr
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 = (PrimExpr -> PrimExpr)
-> ((AggrOp, [OrderExpr], AggrDistinct) -> PrimExpr -> PrimExpr)
-> Maybe (AggrOp, [OrderExpr], AggrDistinct)
-> PrimExpr
-> PrimExpr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PrimExpr -> PrimExpr
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 (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$ From
newSelect
    { tables :: [(Lateral, Select)]
tables     = Select -> [(Lateral, Select)]
forall t. t -> [(Lateral, t)]
oneTable Select
s
    , distinctOn :: Maybe (NonEmpty SqlExpr)
distinctOn = (PrimExpr -> SqlExpr) -> NonEmpty PrimExpr -> NonEmpty SqlExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SqlGenerator -> PrimExpr -> SqlExpr
SG.sqlExpr SqlGenerator
SD.defaultSqlGenerator) (NonEmpty PrimExpr -> NonEmpty SqlExpr)
-> Maybe (NonEmpty PrimExpr) -> Maybe (NonEmpty SqlExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty PrimExpr)
distinctExprs
    , orderBy :: [(SqlExpr, SqlOrder)]
orderBy    = (OrderExpr -> (SqlExpr, SqlOrder))
-> [OrderExpr] -> [(SqlExpr, SqlOrder)]
forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> OrderExpr -> (SqlExpr, SqlOrder)
SD.toSqlOrder SqlGenerator
SD.defaultSqlGenerator) ([OrderExpr] -> [(SqlExpr, SqlOrder)])
-> [OrderExpr] -> [(SqlExpr, SqlOrder)]
forall a b. (a -> b) -> a -> b
$
        -- Postgres requires all 'DISTINCT ON' expressions to appear before any other
        -- 'ORDER BY' expressions if there are any.
        [OrderExpr]
-> (NonEmpty PrimExpr -> [OrderExpr])
-> Maybe (NonEmpty PrimExpr)
-> [OrderExpr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((PrimExpr -> OrderExpr) -> [PrimExpr] -> [OrderExpr]
forall a b. (a -> b) -> [a] -> [b]
map (OrderOp -> PrimExpr -> OrderExpr
HPQ.OrderExpr OrderOp
ascOp) ([PrimExpr] -> [OrderExpr])
-> (NonEmpty PrimExpr -> [PrimExpr])
-> NonEmpty PrimExpr
-> [OrderExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty PrimExpr -> [PrimExpr]
forall a. NonEmpty a -> [a]
NEL.toList) Maybe (NonEmpty PrimExpr)
distinctExprs [OrderExpr] -> [OrderExpr] -> [OrderExpr]
forall a. [a] -> [a] -> [a]
++ [OrderExpr]
orderExprs
    }
    where
        ascOp :: OrderOp
ascOp = OrderOp :: OrderDirection -> OrderNulls -> OrderOp
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 :: [(Lateral, Select)]
tables = Select -> [(Lateral, Select)]
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         -> (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.Bindings HPQ.PrimExpr
     -> PQ.Bindings HPQ.PrimExpr
     -> Select
     -> Select
     -> Select
join :: JoinType
-> PrimExpr
-> Bindings PrimExpr
-> Bindings PrimExpr
-> Select
-> Select
-> Select
join JoinType
j PrimExpr
cond Bindings PrimExpr
pes1 Bindings PrimExpr
pes2 Select
s1 Select
s2 =
  Join -> Select
SelectJoin Join :: JoinType -> (Select, Select) -> SqlExpr -> Join
Join { jJoinType :: JoinType
jJoinType = JoinType -> JoinType
joinType JoinType
j
                  , jTables :: (Select, Select)
jTables   = (Bindings PrimExpr -> Select -> Select
selectFrom Bindings PrimExpr
pes1 Select
s1, Bindings PrimExpr -> Select -> Select
selectFrom Bindings PrimExpr
pes2 Select
s2)
                  , jCond :: SqlExpr
jCond     = PrimExpr -> SqlExpr
sqlExpr PrimExpr
cond }
  where selectFrom :: Bindings PrimExpr -> Select -> Select
selectFrom Bindings PrimExpr
pes Select
s = From -> Select
SelectFrom (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$ From
newSelect {
            attrs :: SelectAttrs
attrs  = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrsStar ([(SqlExpr, Maybe SqlColumn)] -> NonEmpty (SqlExpr, Maybe SqlColumn)
forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns (((Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn))
-> Bindings PrimExpr -> [(SqlExpr, Maybe SqlColumn)]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding Bindings PrimExpr
pes))
          , tables :: [(Lateral, Select)]
tables = Select -> [(Lateral, Select)]
forall t. t -> [(Lateral, t)]
oneTable Select
s
          }

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 :: SelectAttrs -> [[SqlExpr]] -> Values
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 (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 (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 :: BinOp -> Select -> Select -> Binary
Binary {
  bOp :: BinOp
bOp = BinOp -> BinOp
binOp BinOp
op,
  bSelect1 :: Select
bSelect1 = Select
select1,
  bSelect2 :: Select
bSelect2 = Select
select2
  }

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 :: SelectAttrs
-> [(Lateral, Select)]
-> [SqlExpr]
-> Maybe (NonEmpty SqlExpr)
-> [(SqlExpr, SqlOrder)]
-> Maybe (NonEmpty SqlExpr)
-> Maybe Int
-> Maybe Int
-> Maybe LockStrength
-> From
From {
  attrs :: SelectAttrs
attrs      = SelectAttrs
Star,
  tables :: [(Lateral, Select)]
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 :: [(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 :: (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 (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, HPQ.PrimExpr)] -> Select
relExpr :: PrimExpr -> Bindings PrimExpr -> Select
relExpr PrimExpr
pe Bindings PrimExpr
columns = From -> Select
SelectFrom (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$
    From
newSelect { attrs :: SelectAttrs
attrs = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
SelectAttrs ([(SqlExpr, Maybe SqlColumn)] -> NonEmpty (SqlExpr, Maybe SqlColumn)
forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns (((Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn))
-> Bindings PrimExpr -> [(SqlExpr, Maybe SqlColumn)]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding Bindings PrimExpr
columns))
              , tables :: [(Lateral, Select)]
tables = Select -> [(Lateral, Select)]
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 ([(SqlExpr, Maybe SqlColumn)] -> NonEmpty (SqlExpr, Maybe SqlColumn)
forall a. [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns (((Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn))
-> Bindings PrimExpr -> [(SqlExpr, Maybe SqlColumn)]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding Bindings PrimExpr
pes))
  , tables :: [(Lateral, Select)]
tables = Select -> [(Lateral, Select)]
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 = LockStrength -> Maybe LockStrength
forall a. a -> Maybe a
Just LockStrength
Update
  }