{-# LANGUAGE AllowAmbiguousTypes #-}

module Database.GP.Query
  ( WhereClauseExpr,
    Field,
    field,
    whereClauseExprToSql,
    whereClauseValues,
    (&&.),
    (||.),
    (=.),
    (>.),
    (<.),
    (>=.),
    (<=.),
    (<>.),
    like,
    between,
    in',
    isNull,
    not',
    params,
    sqlFun,
    allEntries,
    idColumn,
    byId,
    byIdColumn,
    orderBy,
    SortOrder (..),
    limit,
    limitOffset,
    NonEmpty(..)
  )
where

{--
  This module defines a DSL for building SQL SELECT WHERE clauses.
  The DSL provides query operators like =., >., <. for the most common SQL comparison operators.
  The DSL also provides the ability to combine WHERE clauses using the &&. and ||. operators.
  And to negate a where clause using the not' operator.
  The DSL is used in the `select` function of the Database.GP.GenericPersistence module.
  Example:
  thirtySomethings <- select conn (field "age" `between` (30 :: Int, 39 :: Int))
--}

import           Data.Convertible   (Convertible)
import           Data.List          (intercalate)
import           Database.GP.Entity (Entity, columnNameFor, idField)
import           Database.HDBC      (SqlValue, toSql)
import qualified Data.List.NonEmpty as NE
import           Data.List.NonEmpty (NonEmpty(..))

data CompareOp = Eq | Gt | Lt | GtEq | LtEq | NotEq | Like 

data Field = Field [String] String

data WhereClauseExpr
  = Where Field CompareOp SqlValue
  | WhereBetween Field (SqlValue, SqlValue)
  | WhereIn Field [SqlValue]
  | WhereIsNull Field
  | And WhereClauseExpr WhereClauseExpr
  | Or WhereClauseExpr WhereClauseExpr
  | Not WhereClauseExpr
  | All
  | ById SqlValue
  | ByIdColumn
  | OrderBy WhereClauseExpr (NonEmpty (Field, SortOrder))
  | Limit WhereClauseExpr Int
  | LimitOffset WhereClauseExpr Int Int

data SortOrder = ASC | DESC 
  deriving (Int -> SortOrder -> ShowS
[SortOrder] -> ShowS
SortOrder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SortOrder] -> ShowS
$cshowList :: [SortOrder] -> ShowS
show :: SortOrder -> String
$cshow :: SortOrder -> String
showsPrec :: Int -> SortOrder -> ShowS
$cshowsPrec :: Int -> SortOrder -> ShowS
Show)

field :: String -> Field
field :: String -> Field
field = [String] -> String -> Field
Field []

infixl 3 &&.

(&&.) :: WhereClauseExpr -> WhereClauseExpr -> WhereClauseExpr
&&. :: WhereClauseExpr -> WhereClauseExpr -> WhereClauseExpr
(&&.) = WhereClauseExpr -> WhereClauseExpr -> WhereClauseExpr
And

infixl 2 ||.

(||.) :: WhereClauseExpr -> WhereClauseExpr -> WhereClauseExpr
||. :: WhereClauseExpr -> WhereClauseExpr -> WhereClauseExpr
(||.) = WhereClauseExpr -> WhereClauseExpr -> WhereClauseExpr
Or

infixl 4 =., >., <., >=., <=., <>., `like`, `between`, `in'` 

(=.), (>.), (<.), (>=.), (<=.), (<>.), like :: (Convertible b SqlValue) => Field -> b -> WhereClauseExpr
Field
a =. :: forall b. Convertible b SqlValue => Field -> b -> WhereClauseExpr
=. b
b = Field -> CompareOp -> SqlValue -> WhereClauseExpr
Where Field
a CompareOp
Eq (forall a. Convertible a SqlValue => a -> SqlValue
toSql b
b)
Field
a >. :: forall b. Convertible b SqlValue => Field -> b -> WhereClauseExpr
>. b
b = Field -> CompareOp -> SqlValue -> WhereClauseExpr
Where Field
a CompareOp
Gt (forall a. Convertible a SqlValue => a -> SqlValue
toSql b
b)
Field
a <. :: forall b. Convertible b SqlValue => Field -> b -> WhereClauseExpr
<. b
b = Field -> CompareOp -> SqlValue -> WhereClauseExpr
Where Field
a CompareOp
Lt (forall a. Convertible a SqlValue => a -> SqlValue
toSql b
b)
Field
a >=. :: forall b. Convertible b SqlValue => Field -> b -> WhereClauseExpr
>=. b
b = Field -> CompareOp -> SqlValue -> WhereClauseExpr
Where Field
a CompareOp
GtEq (forall a. Convertible a SqlValue => a -> SqlValue
toSql b
b)
Field
a <=. :: forall b. Convertible b SqlValue => Field -> b -> WhereClauseExpr
<=. b
b = Field -> CompareOp -> SqlValue -> WhereClauseExpr
Where Field
a CompareOp
LtEq (forall a. Convertible a SqlValue => a -> SqlValue
toSql b
b)
Field
a <>. :: forall b. Convertible b SqlValue => Field -> b -> WhereClauseExpr
<>. b
b = Field -> CompareOp -> SqlValue -> WhereClauseExpr
Where Field
a CompareOp
NotEq (forall a. Convertible a SqlValue => a -> SqlValue
toSql b
b)
Field
a like :: forall b. Convertible b SqlValue => Field -> b -> WhereClauseExpr
`like` b
b = Field -> CompareOp -> SqlValue -> WhereClauseExpr
Where Field
a CompareOp
Like (forall a. Convertible a SqlValue => a -> SqlValue
toSql b
b)

between :: (Convertible a1 SqlValue, Convertible a2 SqlValue) => Field -> (a1, a2) -> WhereClauseExpr
Field
a between :: forall a1 a2.
(Convertible a1 SqlValue, Convertible a2 SqlValue) =>
Field -> (a1, a2) -> WhereClauseExpr
`between` (a1
b, a2
c) = Field -> (SqlValue, SqlValue) -> WhereClauseExpr
WhereBetween Field
a (forall a. Convertible a SqlValue => a -> SqlValue
toSql a1
b, forall a. Convertible a SqlValue => a -> SqlValue
toSql a2
c)

in' :: (Convertible b SqlValue) => Field -> [b] -> WhereClauseExpr
Field
a in' :: forall b. Convertible b SqlValue => Field -> [b] -> WhereClauseExpr
`in'` [b]
b = Field -> [SqlValue] -> WhereClauseExpr
WhereIn Field
a (forall a b. (a -> b) -> [a] -> [b]
map forall a. Convertible a SqlValue => a -> SqlValue
toSql [b]
b)

isNull :: Field -> WhereClauseExpr
isNull :: Field -> WhereClauseExpr
isNull = Field -> WhereClauseExpr
WhereIsNull

not' :: WhereClauseExpr -> WhereClauseExpr
not' :: WhereClauseExpr -> WhereClauseExpr
not' = WhereClauseExpr -> WhereClauseExpr
Not

allEntries :: WhereClauseExpr
allEntries :: WhereClauseExpr
allEntries = WhereClauseExpr
All

byId :: (Convertible a SqlValue) => a -> WhereClauseExpr
byId :: forall a. Convertible a SqlValue => a -> WhereClauseExpr
byId = SqlValue -> WhereClauseExpr
ById forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Convertible a SqlValue => a -> SqlValue
toSql

byIdColumn :: WhereClauseExpr
byIdColumn :: WhereClauseExpr
byIdColumn = WhereClauseExpr
ByIdColumn

sqlFun :: String -> Field -> Field
sqlFun :: String -> Field -> Field
sqlFun String
fun (Field [String]
funs String
name) = [String] -> String -> Field
Field (String
fun forall a. a -> [a] -> [a]
: [String]
funs) String
name

infixl 1 `orderBy`

orderBy :: WhereClauseExpr -> NonEmpty (Field, SortOrder) -> WhereClauseExpr
orderBy :: WhereClauseExpr -> NonEmpty (Field, SortOrder) -> WhereClauseExpr
orderBy = WhereClauseExpr -> NonEmpty (Field, SortOrder) -> WhereClauseExpr
OrderBy

limit :: WhereClauseExpr -> Int -> WhereClauseExpr
limit :: WhereClauseExpr -> Int -> WhereClauseExpr
limit = WhereClauseExpr -> Int -> WhereClauseExpr
Limit 

limitOffset :: WhereClauseExpr -> (Int, Int) -> WhereClauseExpr
limitOffset :: WhereClauseExpr -> (Int, Int) -> WhereClauseExpr
limitOffset WhereClauseExpr
c (Int
offset, Int
lim) = WhereClauseExpr -> Int -> Int -> WhereClauseExpr
LimitOffset WhereClauseExpr
c Int
offset Int
lim


whereClauseExprToSql :: forall a. (Entity a) => WhereClauseExpr -> String
whereClauseExprToSql :: forall a. Entity a => WhereClauseExpr -> String
whereClauseExprToSql (Where Field
f CompareOp
op SqlValue
_) = forall a. Entity a => Field -> String
columnToSql @a Field
f forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ CompareOp -> String
opToSql CompareOp
op forall a. [a] -> [a] -> [a]
++ String
" ?"
whereClauseExprToSql (And WhereClauseExpr
e1 WhereClauseExpr
e2) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Entity a => WhereClauseExpr -> String
whereClauseExprToSql @a WhereClauseExpr
e1 forall a. [a] -> [a] -> [a]
++ String
") AND (" forall a. [a] -> [a] -> [a]
++ forall a. Entity a => WhereClauseExpr -> String
whereClauseExprToSql @a WhereClauseExpr
e2 forall a. [a] -> [a] -> [a]
++ String
")"
whereClauseExprToSql (Or WhereClauseExpr
e1 WhereClauseExpr
e2) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Entity a => WhereClauseExpr -> String
whereClauseExprToSql @a WhereClauseExpr
e1 forall a. [a] -> [a] -> [a]
++ String
") OR (" forall a. [a] -> [a] -> [a]
++ forall a. Entity a => WhereClauseExpr -> String
whereClauseExprToSql @a WhereClauseExpr
e2 forall a. [a] -> [a] -> [a]
++ String
")"
whereClauseExprToSql (Not (WhereIsNull Field
f)) = forall a. Entity a => Field -> String
columnToSql @a Field
f forall a. [a] -> [a] -> [a]
++ String
" IS NOT NULL"
whereClauseExprToSql (Not WhereClauseExpr
e) = String
"NOT (" forall a. [a] -> [a] -> [a]
++ forall a. Entity a => WhereClauseExpr -> String
whereClauseExprToSql @a WhereClauseExpr
e forall a. [a] -> [a] -> [a]
++ String
")"
whereClauseExprToSql (WhereBetween Field
f (SqlValue
_v1, SqlValue
_v2)) = forall a. Entity a => Field -> String
columnToSql @a Field
f forall a. [a] -> [a] -> [a]
++ String
" BETWEEN ? AND ?"
whereClauseExprToSql (WhereIn Field
f [SqlValue]
v) = forall a. Entity a => Field -> String
columnToSql @a Field
f forall a. [a] -> [a] -> [a]
++ String
" IN (" forall a. [a] -> [a] -> [a]
++ String
args forall a. [a] -> [a] -> [a]
++ String
")"
  where
    args :: String
args = forall a. [a] -> [[a]] -> [a]
intercalate String
", " (Int -> [String]
params (forall (t :: * -> *) a. Foldable t => t a -> Int
length [SqlValue]
v))
whereClauseExprToSql (WhereIsNull Field
f) = forall a. Entity a => Field -> String
columnToSql @a Field
f forall a. [a] -> [a] -> [a]
++ String
" IS NULL"
whereClauseExprToSql WhereClauseExpr
All = String
"1=1"
whereClauseExprToSql (ById SqlValue
_eid) = forall a. Entity a => String
idColumn @a forall a. [a] -> [a] -> [a]
++ String
" = ?"
whereClauseExprToSql WhereClauseExpr
ByIdColumn  = forall a. Entity a => String
idColumn @a forall a. [a] -> [a] -> [a]
++ String
" = ?"
whereClauseExprToSql (OrderBy WhereClauseExpr
clause NonEmpty (Field, SortOrder)
pairs) = forall a. Entity a => WhereClauseExpr -> String
whereClauseExprToSql @a WhereClauseExpr
clause forall a. [a] -> [a] -> [a]
++ String
" ORDER BY " forall a. [a] -> [a] -> [a]
++ NonEmpty (Field, SortOrder) -> String
renderedPairs NonEmpty (Field, SortOrder)
pairs
  where
    renderedPairs :: NonEmpty (Field, SortOrder) -> String
    renderedPairs :: NonEmpty (Field, SortOrder) -> String
renderedPairs NonEmpty (Field, SortOrder)
ne = forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a. NonEmpty a -> [a]
NE.toList (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\(Field
f,SortOrder
order) -> forall a. Entity a => Field -> String
columnToSql @a Field
f forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SortOrder
order) NonEmpty (Field, SortOrder)
ne))
whereClauseExprToSql (Limit WhereClauseExpr
clause Int
x) = forall a. Entity a => WhereClauseExpr -> String
whereClauseExprToSql @a WhereClauseExpr
clause forall a. [a] -> [a] -> [a]
++ String
" LIMIT " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
x
whereClauseExprToSql (LimitOffset WhereClauseExpr
clause Int
offset Int
lim) = forall a. Entity a => WhereClauseExpr -> String
whereClauseExprToSql @a WhereClauseExpr
clause forall a. [a] -> [a] -> [a]
++ String
" LIMIT " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
lim forall a. [a] -> [a] -> [a]
++ String
" OFFSET " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
offset 
    
opToSql :: CompareOp -> String
opToSql :: CompareOp -> String
opToSql CompareOp
Eq       = String
"="
opToSql CompareOp
Gt       = String
">"
opToSql CompareOp
Lt       = String
"<"
opToSql CompareOp
GtEq     = String
">="
opToSql CompareOp
LtEq     = String
"<="
opToSql CompareOp
NotEq    = String
"<>"
opToSql CompareOp
Like     = String
"LIKE"

columnToSql :: forall a. (Entity a) => Field -> String
columnToSql :: forall a. Entity a => Field -> String
columnToSql = forall a. Entity a => Field -> String
expandFunctions @a

idColumn :: forall a. (Entity a) => String
idColumn :: forall a. Entity a => String
idColumn = forall a. Entity a => ShowS
columnNameFor @a (forall a. Entity a => String
idField @a)

expandFunctions :: forall a. (Entity a) => Field -> String -- -> String
expandFunctions :: forall a. Entity a => Field -> String
expandFunctions (Field [] String
name) = forall a. Entity a => ShowS
columnNameFor @a String
name
expandFunctions (Field (String
f : [String]
fs) String
name) = String
f forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Entity a => Field -> String
expandFunctions @a ([String] -> String -> Field
Field [String]
fs String
name) forall a. [a] -> [a] -> [a]
++ String
")"

whereClauseValues :: WhereClauseExpr -> [SqlValue]
whereClauseValues :: WhereClauseExpr -> [SqlValue]
whereClauseValues (Where Field
_ CompareOp
_ SqlValue
v) = [forall a. Convertible a SqlValue => a -> SqlValue
toSql SqlValue
v]
whereClauseValues (And WhereClauseExpr
e1 WhereClauseExpr
e2) = WhereClauseExpr -> [SqlValue]
whereClauseValues WhereClauseExpr
e1 forall a. [a] -> [a] -> [a]
++ WhereClauseExpr -> [SqlValue]
whereClauseValues WhereClauseExpr
e2
whereClauseValues (Or WhereClauseExpr
e1 WhereClauseExpr
e2) = WhereClauseExpr -> [SqlValue]
whereClauseValues WhereClauseExpr
e1 forall a. [a] -> [a] -> [a]
++ WhereClauseExpr -> [SqlValue]
whereClauseValues WhereClauseExpr
e2
whereClauseValues (Not WhereClauseExpr
e) = WhereClauseExpr -> [SqlValue]
whereClauseValues WhereClauseExpr
e
whereClauseValues (WhereBetween Field
_ (SqlValue
v1, SqlValue
v2)) = [forall a. Convertible a SqlValue => a -> SqlValue
toSql SqlValue
v1, forall a. Convertible a SqlValue => a -> SqlValue
toSql SqlValue
v2]
whereClauseValues (WhereIn Field
_ [SqlValue]
v) = forall a b. (a -> b) -> [a] -> [b]
map forall a. Convertible a SqlValue => a -> SqlValue
toSql [SqlValue]
v
whereClauseValues (WhereIsNull Field
_) = []
whereClauseValues WhereClauseExpr
All = []
whereClauseValues (ById SqlValue
eid) = [forall a. Convertible a SqlValue => a -> SqlValue
toSql SqlValue
eid]
whereClauseValues WhereClauseExpr
ByIdColumn = []
whereClauseValues (OrderBy WhereClauseExpr
clause NonEmpty (Field, SortOrder)
_) = WhereClauseExpr -> [SqlValue]
whereClauseValues WhereClauseExpr
clause
whereClauseValues (Limit WhereClauseExpr
clause Int
_) = WhereClauseExpr -> [SqlValue]
whereClauseValues WhereClauseExpr
clause
whereClauseValues (LimitOffset WhereClauseExpr
clause Int
_ Int
_) = WhereClauseExpr -> [SqlValue]
whereClauseValues WhereClauseExpr
clause

params :: Int -> [String]
params :: Int -> [String]
params Int
n = forall a. Int -> a -> [a]
replicate Int
n String
"?"