{-# 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 (Show)

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

infixl 3 &&.

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

infixl 2 ||.

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

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

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

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

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

isNull :: Field -> WhereClauseExpr
isNull = WhereIsNull

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

allEntries :: WhereClauseExpr
allEntries = All

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

byIdColumn :: WhereClauseExpr
byIdColumn = ByIdColumn

sqlFun :: String -> Field -> Field
sqlFun fun (Field funs name) = Field (fun : funs) name

infixl 1 `orderBy`

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

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

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


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

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

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

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

whereClauseValues :: WhereClauseExpr -> [SqlValue]
whereClauseValues (Where _ _ v) = [toSql v]
whereClauseValues (And e1 e2) = whereClauseValues e1 ++ whereClauseValues e2
whereClauseValues (Or e1 e2) = whereClauseValues e1 ++ whereClauseValues e2
whereClauseValues (Not e) = whereClauseValues e
whereClauseValues (WhereBetween _ (v1, v2)) = [toSql v1, toSql v2]
whereClauseValues (WhereIn _ v) = map toSql v
whereClauseValues (WhereIsNull _) = []
whereClauseValues All = []
whereClauseValues (ById eid) = [toSql eid]
whereClauseValues ByIdColumn = []
whereClauseValues (OrderBy clause _) = whereClauseValues clause
whereClauseValues (Limit clause _) = whereClauseValues clause
whereClauseValues (LimitOffset clause _ _) = whereClauseValues clause

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