module Opaleye.SQLite.Internal.PrimQuery where

import           Prelude hiding (product)

import qualified Data.List.NonEmpty as NEL
import qualified Opaleye.SQLite.Internal.HaskellDB.PrimQuery as HPQ
import           Opaleye.SQLite.Internal.HaskellDB.PrimQuery (Symbol)

data LimitOp = LimitOp Int | OffsetOp Int | LimitOffsetOp Int Int
             deriving Int -> LimitOp -> ShowS
[LimitOp] -> ShowS
LimitOp -> String
(Int -> LimitOp -> ShowS)
-> (LimitOp -> String) -> ([LimitOp] -> ShowS) -> Show LimitOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LimitOp] -> ShowS
$cshowList :: [LimitOp] -> ShowS
show :: LimitOp -> String
$cshow :: LimitOp -> String
showsPrec :: Int -> LimitOp -> ShowS
$cshowsPrec :: Int -> LimitOp -> 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 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

-- In the future it may make sense to introduce this datatype
-- type Bindings a = [(Symbol, a)]

-- We use a 'NEL.NonEmpty' for Product because otherwise we'd have to check
-- for emptiness explicity in the SQL generation phase.
data PrimQuery = Unit
               | BaseTable String [(Symbol, HPQ.PrimExpr)]
               | Product (NEL.NonEmpty PrimQuery) [HPQ.PrimExpr]
               | Aggregate [(Symbol, (Maybe HPQ.AggrOp, HPQ.PrimExpr))] PrimQuery
               | Order [HPQ.OrderExpr] PrimQuery
               | Limit LimitOp PrimQuery
               | Join JoinType HPQ.PrimExpr PrimQuery PrimQuery
               | Values [Symbol] [[HPQ.PrimExpr]]
               | Binary BinOp [(Symbol, (HPQ.PrimExpr, HPQ.PrimExpr))] (PrimQuery, PrimQuery)
                 deriving Int -> PrimQuery -> ShowS
[PrimQuery] -> ShowS
PrimQuery -> String
(Int -> PrimQuery -> ShowS)
-> (PrimQuery -> String)
-> ([PrimQuery] -> ShowS)
-> Show PrimQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimQuery] -> ShowS
$cshowList :: [PrimQuery] -> ShowS
show :: PrimQuery -> String
$cshow :: PrimQuery -> String
showsPrec :: Int -> PrimQuery -> ShowS
$cshowsPrec :: Int -> PrimQuery -> ShowS
Show

type PrimQueryFold p = ( p
                       , String -> [(Symbol, HPQ.PrimExpr)] -> p
                       , NEL.NonEmpty p -> [HPQ.PrimExpr] -> p
                       , [(Symbol, (Maybe HPQ.AggrOp, HPQ.PrimExpr))] -> p -> p
                       , [HPQ.OrderExpr] -> p -> p
                       , LimitOp -> p -> p
                       , JoinType -> HPQ.PrimExpr -> p -> p -> p
                       , [Symbol] -> [[HPQ.PrimExpr]] -> p
                       , BinOp -> [(Symbol, (HPQ.PrimExpr, HPQ.PrimExpr))] -> (p, p) -> p
                       )

foldPrimQuery :: PrimQueryFold p -> PrimQuery -> p
foldPrimQuery :: PrimQueryFold p -> PrimQuery -> p
foldPrimQuery (p
unit, String -> [(Symbol, PrimExpr)] -> p
baseTable, NonEmpty p -> [PrimExpr] -> p
product, [(Symbol, (Maybe AggrOp, PrimExpr))] -> p -> p
aggregate, [OrderExpr] -> p -> p
order, LimitOp -> p -> p
limit, JoinType -> PrimExpr -> p -> p -> p
join, [Symbol] -> [[PrimExpr]] -> p
values,
               BinOp -> [(Symbol, (PrimExpr, PrimExpr))] -> (p, p) -> p
binary) = ((PrimQuery -> p) -> PrimQuery -> p) -> PrimQuery -> p
forall t. (t -> t) -> t
fix (PrimQuery -> p) -> PrimQuery -> p
fold
  where fold :: (PrimQuery -> p) -> PrimQuery -> p
fold PrimQuery -> p
self PrimQuery
primQ = case PrimQuery
primQ of
          PrimQuery
Unit                       -> p
unit
          BaseTable String
n [(Symbol, PrimExpr)]
s              -> String -> [(Symbol, PrimExpr)] -> p
baseTable String
n [(Symbol, PrimExpr)]
s
          Product NonEmpty PrimQuery
pqs [PrimExpr]
pes            -> NonEmpty p -> [PrimExpr] -> p
product ((PrimQuery -> p) -> NonEmpty PrimQuery -> NonEmpty p
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrimQuery -> p
self NonEmpty PrimQuery
pqs) [PrimExpr]
pes
          Aggregate [(Symbol, (Maybe AggrOp, PrimExpr))]
aggrs PrimQuery
pq         -> [(Symbol, (Maybe AggrOp, PrimExpr))] -> p -> p
aggregate [(Symbol, (Maybe AggrOp, PrimExpr))]
aggrs (PrimQuery -> p
self PrimQuery
pq)
          Order [OrderExpr]
pes PrimQuery
pq               -> [OrderExpr] -> p -> p
order [OrderExpr]
pes (PrimQuery -> p
self PrimQuery
pq)
          Limit LimitOp
op PrimQuery
pq                -> LimitOp -> p -> p
limit LimitOp
op (PrimQuery -> p
self PrimQuery
pq)
          Join JoinType
j PrimExpr
cond PrimQuery
q1 PrimQuery
q2          -> JoinType -> PrimExpr -> p -> p -> p
join JoinType
j PrimExpr
cond (PrimQuery -> p
self PrimQuery
q1) (PrimQuery -> p
self PrimQuery
q2)
          Values [Symbol]
ss [[PrimExpr]]
pes              -> [Symbol] -> [[PrimExpr]] -> p
values [Symbol]
ss [[PrimExpr]]
pes
          Binary BinOp
binop [(Symbol, (PrimExpr, PrimExpr))]
pes (PrimQuery
pq, PrimQuery
pq') -> BinOp -> [(Symbol, (PrimExpr, PrimExpr))] -> (p, p) -> p
binary BinOp
binop [(Symbol, (PrimExpr, PrimExpr))]
pes (PrimQuery -> p
self PrimQuery
pq, PrimQuery -> p
self PrimQuery
pq')
        fix :: (t -> t) -> t
fix t -> t
f = let x :: t
x = t -> t
f t
x in t
x

times :: PrimQuery -> PrimQuery -> PrimQuery
times :: PrimQuery -> PrimQuery -> PrimQuery
times PrimQuery
q PrimQuery
q' = NonEmpty PrimQuery -> [PrimExpr] -> PrimQuery
Product (PrimQuery
q PrimQuery -> [PrimQuery] -> NonEmpty PrimQuery
forall a. a -> [a] -> NonEmpty a
NEL.:| [PrimQuery
q']) []

restrict :: HPQ.PrimExpr -> PrimQuery -> PrimQuery
restrict :: PrimExpr -> PrimQuery -> PrimQuery
restrict PrimExpr
cond PrimQuery
primQ = NonEmpty PrimQuery -> [PrimExpr] -> PrimQuery
Product (PrimQuery -> NonEmpty PrimQuery
forall (m :: * -> *) a. Monad m => a -> m a
return PrimQuery
primQ) [PrimExpr
cond]

isUnit :: PrimQuery -> Bool
isUnit :: PrimQuery -> Bool
isUnit PrimQuery
Unit = Bool
True
isUnit PrimQuery
_    = Bool
False