module Opaleye.SQLite.Internal.Sql where

import           Prelude hiding (product)

import qualified Opaleye.SQLite.Internal.PrimQuery as PQ

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

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

import qualified Control.Arrow as Arr

data Select = SelectFrom From
            | Table HSql.SqlTable
            | SelectJoin Join
            | SelectValues Values
            | SelectBinary Binary
            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))
  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 -> [Select]
tables    :: [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 Int
limit     :: Maybe Int,
  From -> Maybe Int
offset    :: Maybe Int
  }
          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 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 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 BinOp = Except | Union | UnionAll 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 TableName = String

data Returning a = Returning a [HSql.SqlExpr]

sqlQueryGenerator :: PQ.PrimQueryFold Select
sqlQueryGenerator :: PrimQueryFold Select
sqlQueryGenerator = (Select
unit, String -> [(Symbol, PrimExpr)] -> Select
baseTable, NonEmpty Select -> [PrimExpr] -> Select
product, [(Symbol, (Maybe AggrOp, PrimExpr))] -> Select -> Select
aggregate, [OrderExpr] -> Select -> Select
order, LimitOp -> Select -> Select
limit_, JoinType -> PrimExpr -> Select -> Select -> Select
join,
                     [Symbol] -> [[PrimExpr]] -> Select
values, BinOp
-> [(Symbol, (PrimExpr, PrimExpr))] -> (Select, Select) -> Select
binary)

sql :: ([HPQ.PrimExpr], PQ.PrimQuery, T.Tag) -> Select
sql :: ([PrimExpr], PrimQuery, Tag) -> Select
sql ([PrimExpr]
pes, PrimQuery
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 :: [Select]
tables = [Select
pqSelect] }
  where pqSelect :: Select
pqSelect = PrimQueryFold Select -> PrimQuery -> Select
forall p. PrimQueryFold p -> PrimQuery -> p
PQ.foldPrimQuery PrimQueryFold Select
sqlQueryGenerator PrimQuery
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 []) }

baseTable :: String -> [(Symbol, HPQ.PrimExpr)] -> Select
baseTable :: String -> [(Symbol, PrimExpr)] -> Select
baseTable String
name [(Symbol, 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))
-> [(Symbol, PrimExpr)] -> [(SqlExpr, Maybe SqlColumn)]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding [(Symbol, PrimExpr)]
columns))
              , tables :: [Select]
tables = [SqlTable -> Select
Table (String -> SqlTable
HSql.SqlTable String
name)] }

product :: NEL.NonEmpty Select -> [HPQ.PrimExpr] -> Select
product :: NonEmpty Select -> [PrimExpr] -> Select
product NonEmpty Select
ss [PrimExpr]
pes = From -> Select
SelectFrom (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$
    From
newSelect { tables :: [Select]
tables = NonEmpty Select -> [Select]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Select
ss
              , criteria :: [SqlExpr]
criteria = (PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map PrimExpr -> SqlExpr
sqlExpr [PrimExpr]
pes }

aggregate :: [(Symbol, (Maybe HPQ.AggrOp, HPQ.PrimExpr))] -> Select -> Select
aggregate :: [(Symbol, (Maybe AggrOp, PrimExpr))] -> Select -> Select
aggregate [(Symbol, (Maybe AggrOp, PrimExpr))]
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, PrimExpr)) -> (SqlExpr, Maybe SqlColumn))
-> [(Symbol, (Maybe AggrOp, PrimExpr))]
-> [(SqlExpr, Maybe SqlColumn)]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol, (Maybe AggrOp, PrimExpr)) -> (SqlExpr, Maybe SqlColumn)
attr [(Symbol, (Maybe AggrOp, PrimExpr))]
aggrs))
                                           , tables :: [Select]
tables = [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, PrimExpr))] -> NonEmpty SqlExpr)
-> [(Symbol, (Maybe AggrOp, PrimExpr))]
-> Maybe (NonEmpty SqlExpr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Symbol, (Maybe AggrOp, PrimExpr))] -> NonEmpty SqlExpr
forall symbol aggrOp.
[(symbol, (Maybe aggrOp, PrimExpr))] -> NonEmpty SqlExpr
groupBy') [(Symbol, (Maybe AggrOp, PrimExpr))]
aggrs }
  where --- Grouping by an empty list is not the identity function!
        --- In fact it forms one single group.  Syntactically one
        --- cannot group by nothing in SQL, so we just group by a
        --- constant instead.  Because "GROUP BY 0" means group by the
        --- zeroth column, 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

        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, PrimExpr)) -> (SqlExpr, Maybe SqlColumn)
attr = (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding ((Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn))
-> ((Symbol, (Maybe AggrOp, PrimExpr)) -> (Symbol, PrimExpr))
-> (Symbol, (Maybe AggrOp, PrimExpr))
-> (SqlExpr, Maybe SqlColumn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe AggrOp, PrimExpr) -> PrimExpr)
-> (Symbol, (Maybe AggrOp, PrimExpr)) -> (Symbol, PrimExpr)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arr.second ((Maybe AggrOp -> PrimExpr -> PrimExpr)
-> (Maybe AggrOp, PrimExpr) -> PrimExpr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe AggrOp -> 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.PrimExpr -> HPQ.PrimExpr
aggrExpr :: Maybe AggrOp -> PrimExpr -> PrimExpr
aggrExpr = (PrimExpr -> PrimExpr)
-> (AggrOp -> PrimExpr -> PrimExpr)
-> Maybe AggrOp
-> PrimExpr
-> PrimExpr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PrimExpr -> PrimExpr
forall a. a -> a
id AggrOp -> PrimExpr -> PrimExpr
HPQ.AggrExpr

order :: [HPQ.OrderExpr] -> Select -> Select
order :: [OrderExpr] -> Select -> Select
order [OrderExpr]
oes Select
s = From -> Select
SelectFrom (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$
    From
newSelect { tables :: [Select]
tables = [Select
s]
              , 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]
oes }

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 :: [Select]
tables = [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 -> Select -> Select -> Select
join :: JoinType -> PrimExpr -> Select -> Select -> Select
join JoinType
j PrimExpr
cond 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 = (Select
s1, Select
s2)
                                    , jCond :: SqlExpr
jCond = PrimExpr -> SqlExpr
sqlExpr PrimExpr
cond }

-- 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] -> [[HPQ.PrimExpr]] -> Select
values :: [Symbol] -> [[PrimExpr]] -> Select
values [Symbol]
columns [[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 = (([PrimExpr] -> [SqlExpr]) -> [[PrimExpr]] -> [[SqlExpr]]
forall a b. (a -> b) -> [a] -> [b]
map (([PrimExpr] -> [SqlExpr]) -> [[PrimExpr]] -> [[SqlExpr]])
-> ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr])
-> (PrimExpr -> SqlExpr)
-> [[PrimExpr]]
-> [[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]]
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 -> [(Symbol, (HPQ.PrimExpr, HPQ.PrimExpr))]
       -> (Select, Select) -> Select
binary :: BinOp
-> [(Symbol, (PrimExpr, PrimExpr))] -> (Select, Select) -> Select
binary BinOp
op [(Symbol, (PrimExpr, PrimExpr))]
pes (Select
select1, Select
select2) = Binary -> Select
SelectBinary Binary :: BinOp -> Select -> Select -> Binary
Binary {
  bOp :: BinOp
bOp = BinOp -> BinOp
binOp BinOp
op,
  bSelect1 :: Select
bSelect1 = 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, PrimExpr)) -> (SqlExpr, Maybe SqlColumn))
-> [(Symbol, (PrimExpr, PrimExpr))] -> [(SqlExpr, Maybe SqlColumn)]
forall a b. (a -> b) -> [a] -> [b]
map (((PrimExpr, PrimExpr) -> PrimExpr)
-> (Symbol, (PrimExpr, PrimExpr)) -> (SqlExpr, Maybe SqlColumn)
forall b.
(b -> PrimExpr) -> (Symbol, b) -> (SqlExpr, Maybe SqlColumn)
mkColumn (PrimExpr, PrimExpr) -> PrimExpr
forall a b. (a, b) -> a
fst) [(Symbol, (PrimExpr, PrimExpr))]
pes)),
                                    tables :: [Select]
tables = [Select
select1] },
  bSelect2 :: Select
bSelect2 = 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, PrimExpr)) -> (SqlExpr, Maybe SqlColumn))
-> [(Symbol, (PrimExpr, PrimExpr))] -> [(SqlExpr, Maybe SqlColumn)]
forall a b. (a -> b) -> [a] -> [b]
map (((PrimExpr, PrimExpr) -> PrimExpr)
-> (Symbol, (PrimExpr, PrimExpr)) -> (SqlExpr, Maybe SqlColumn)
forall b.
(b -> PrimExpr) -> (Symbol, b) -> (SqlExpr, Maybe SqlColumn)
mkColumn (PrimExpr, PrimExpr) -> PrimExpr
forall a b. (a, b) -> b
snd) [(Symbol, (PrimExpr, PrimExpr))]
pes)),
                                    tables :: [Select]
tables = [Select
select2] }
  }
  where mkColumn :: (b -> PrimExpr) -> (Symbol, b) -> (SqlExpr, Maybe SqlColumn)
mkColumn b -> PrimExpr
e = (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding ((Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn))
-> ((Symbol, b) -> (Symbol, PrimExpr))
-> (Symbol, b)
-> (SqlExpr, Maybe SqlColumn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> PrimExpr) -> (Symbol, b) -> (Symbol, PrimExpr)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arr.second b -> PrimExpr
e

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

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

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

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

sqlBinding :: (Symbol, HPQ.PrimExpr) -> (HSql.SqlExpr, Maybe HSql.SqlColumn)
sqlBinding :: (Symbol, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
sqlBinding (Symbol String
sym Tag
t, PrimExpr
pe) =
  (PrimExpr -> SqlExpr
sqlExpr PrimExpr
pe, SqlColumn -> Maybe SqlColumn
forall a. a -> Maybe a
Just (String -> SqlColumn
HSql.SqlColumn (Tag -> ShowS
T.tagWith Tag
t String
sym)))

ensureColumns :: [(HSql.SqlExpr, Maybe a)]
              -> NEL.NonEmpty (HSql.SqlExpr, Maybe a)
ensureColumns :: [(SqlExpr, Maybe a)] -> NonEmpty (SqlExpr, Maybe a)
ensureColumns = NonEmpty (SqlExpr, Maybe a)
-> Maybe (NonEmpty (SqlExpr, Maybe a))
-> NonEmpty (SqlExpr, Maybe a)
forall a. a -> Maybe a -> a
M.fromMaybe ((SqlExpr, Maybe a) -> NonEmpty (SqlExpr, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SqlExpr
HSql.ConstSqlExpr String
"0", Maybe a
forall a. Maybe a
Nothing))
                (Maybe (NonEmpty (SqlExpr, Maybe a))
 -> NonEmpty (SqlExpr, Maybe a))
-> ([(SqlExpr, Maybe a)] -> Maybe (NonEmpty (SqlExpr, Maybe a)))
-> [(SqlExpr, Maybe a)]
-> NonEmpty (SqlExpr, Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SqlExpr, Maybe a)] -> Maybe (NonEmpty (SqlExpr, Maybe a))
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty