{-# LANGUAGE AllowAmbiguousTypes #-}

module Database.GP.Query
  ( WhereClauseExpr,
    Field,
    field,
    whereClauseExprToSql,
    whereClauseValues,
    (&&.),
    (||.),
    (=.),
    (>.),
    (<.),
    (>=.),
    (<=.),
    (<>.),
    like,
    contains,
    between,
    in',
    isNull,
    not',
    params,
    sqlFun,
    allEntries,
    idColumn,
    byId,
  )
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)

data CompareOp = Eq | Gt | Lt | GtEq | LtEq | NotEq | Like | Contains
  deriving (Int -> CompareOp -> ShowS
[CompareOp] -> ShowS
CompareOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompareOp] -> ShowS
$cshowList :: [CompareOp] -> ShowS
show :: CompareOp -> String
$cshow :: CompareOp -> String
showsPrec :: Int -> CompareOp -> ShowS
$cshowsPrec :: Int -> CompareOp -> ShowS
Show, CompareOp -> CompareOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompareOp -> CompareOp -> Bool
$c/= :: CompareOp -> CompareOp -> Bool
== :: CompareOp -> CompareOp -> Bool
$c== :: CompareOp -> CompareOp -> Bool
Eq)

data Field = Field [String] String
  deriving (Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show, Field -> Field -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq)

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
  deriving (Int -> WhereClauseExpr -> ShowS
[WhereClauseExpr] -> ShowS
WhereClauseExpr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WhereClauseExpr] -> ShowS
$cshowList :: [WhereClauseExpr] -> ShowS
show :: WhereClauseExpr -> String
$cshow :: WhereClauseExpr -> String
showsPrec :: Int -> WhereClauseExpr -> ShowS
$cshowsPrec :: Int -> WhereClauseExpr -> ShowS
Show, WhereClauseExpr -> WhereClauseExpr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WhereClauseExpr -> WhereClauseExpr -> Bool
$c/= :: WhereClauseExpr -> WhereClauseExpr -> Bool
== :: WhereClauseExpr -> WhereClauseExpr -> Bool
$c== :: WhereClauseExpr -> WhereClauseExpr -> Bool
Eq)

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

getName :: Field -> String
getName :: Field -> String
getName (Field [String]
_fns String
n) = String
n

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'`, `contains`

(=.), (>.), (<.), (>=.), (<=.), (<>.), 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)

contains :: Convertible a SqlValue => Field -> a -> WhereClauseExpr
Field
a contains :: forall b. Convertible b SqlValue => Field -> b -> WhereClauseExpr
`contains` a
b = Field -> CompareOp -> SqlValue -> WhereClauseExpr
Where Field
a CompareOp
Contains (forall a. Convertible a SqlValue => a -> SqlValue
toSql a
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

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

whereClauseExprToSql :: forall a. (Entity a) => WhereClauseExpr -> String
whereClauseExprToSql :: forall a. Entity a => WhereClauseExpr -> String
whereClauseExprToSql (Where Field
f CompareOp
op SqlValue
_) = String
column forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ CompareOp -> String
opToSql CompareOp
op forall a. [a] -> [a] -> [a]
++ String
" ?"
  where
    column :: String
column = Field -> ShowS
expandFunctions Field
f forall a b. (a -> b) -> a -> b
$ forall a. Entity a => ShowS
columnNameFor @a (Field -> String
getName Field
f)

    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"
    opToSql CompareOp
Contains = String
"CONTAINS"
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 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)) = String
column forall a. [a] -> [a] -> [a]
++ String
" BETWEEN ? AND ?"
  where
    column :: String
column = Field -> ShowS
expandFunctions Field
f forall a b. (a -> b) -> a -> b
$ forall a. Entity a => ShowS
columnNameFor @a (Field -> String
getName Field
f)
whereClauseExprToSql (WhereIn Field
f [SqlValue]
v) = String
column forall a. [a] -> [a] -> [a]
++ String
" IN (" forall a. [a] -> [a] -> [a]
++ String
args forall a. [a] -> [a] -> [a]
++ String
")"
  where
    column :: String
column = Field -> ShowS
expandFunctions Field
f forall a b. (a -> b) -> a -> b
$ forall a. Entity a => ShowS
columnNameFor @a (Field -> String
getName Field
f)
    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) = String
column forall a. [a] -> [a] -> [a]
++ String
" IS NULL"
  where
    column :: String
column = Field -> ShowS
expandFunctions Field
f forall a b. (a -> b) -> a -> b
$ forall a. Entity a => ShowS
columnNameFor @a (Field -> String
getName Field
f)
whereClauseExprToSql WhereClauseExpr
All = String
"1=1"
whereClauseExprToSql (ById SqlValue
_eid) = String
column forall a. [a] -> [a] -> [a]
++ String
" = ?"
  where
    column :: String
column = forall a. Entity a => String
idColumn @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 :: Field -> String -> String
expandFunctions :: Field -> ShowS
expandFunctions (Field [] String
_name) String
col = String
col
expandFunctions (Field (String
f : [String]
fs) String
name) String
col = String
f forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ Field -> ShowS
expandFunctions ([String] -> String -> Field
Field [String]
fs String
name) String
col 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]

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