--- --------------------------------------------------------------
--- This module contains datatype declarations, constructor functions
--- selectors and translation functions for complex select queries
--- in particular for those selecting (1 to 5) single columns.
---
--- @author Julia Krone
--- ----------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns #-}

module Database.CDBI.QueryTypes (
  SetOp(..),Join(..),innerJoin, crossJoin,
  ColumnSingleCollection(..), ColumnTupleCollection,
  ColumnTripleCollection, ColumnFourTupleCollection,
  ColumnFiveTupleCollection, ColumnSixTupleCollection,
  sum, avg, count, minV, maxV, none,
  caseThen, singleCol, tupleCol, tripleCol, fourCol, fiveCol, sixCol,
  SingleColumnSelect(..), TupleColumnSelect(..),
  TripleColumnSelect(..), FourColumnSelect(..),
  FiveColumnSelect(..), SixColumnSelect(..), TableClause(..),
  getSingleType, getTupleTypes, getTripleTypes, getFourTupleTypes,
  getFiveTupleTypes, getSixTupleTypes,
  getSingleValFunc, getTupleValFuncs, getTripleValFuncs,
  getFourTupleValFuncs, getFiveTupleValFuncs, getSixTupleValFuncs,
  trLimit, trSpecifier, trSetOp, trSingleSelectQuery, asTable,
  trTupleSelectQuery, trJoinPart1, trJoinPart2, trTripleSelectQuery,
  trFourTupleSelectQuery, trFiveTupleSelectQuery, trSixTupleSelectQuery,
  caseResultInt, caseResultFloat, caseResultString, caseResultChar,
  caseResultBool)
 where

import Data.List(intercalate)
import Data.Time(ClockTime)

import Database.CDBI.Connection
import Database.CDBI.Criteria
import Database.CDBI.Description

---datatype for set operations
data SetOp = Union | Intersect | Except

--- datatype for joins
data  Join =  Cross
           | Inner Constraint


--- Constructorfunction for an inner join
---@param constraint
innerJoin :: Constraint -> Join
innerJoin constraint = Inner constraint

--- Constructorfunction for cross join
crossJoin :: Join
crossJoin = Cross

--- data structure to represent a table-clause (tables and joins)
--- in a way that at least one table has to be specified
data TableClause = TC Table Int (Maybe (Join,TableClause))

-- Data type to specify the result type of case expressions and its conversion.
type CaseVal a = (SQLType , (SQLValue -> a))

--- Datatype representing a single column in a select-clause. Can be just a
--- column connected with an alias and an optional aggregation function(String)
--- or a Case-when-then-statement
data ColumnSingleCollection a = ResultColumnDescription (ColumnDescription a)
                                                        Int
                                                        String
                              | Case Condition (CValue, CValue) (CaseVal a)

--- Datatype to select two different columns which can be of different types
--- and from different tables.
type ColumnTupleCollection a b = (ColumnSingleCollection a,
                                 ColumnSingleCollection b)

--- Datatype to select three different columns which can be of different types
--- and from different tables.
type ColumnTripleCollection a b c = (ColumnSingleCollection a,
                                     ColumnSingleCollection b,
                                     ColumnSingleCollection c)

--- Datatype to select four different columns which can be of different types
--- and from different tables.
type ColumnFourTupleCollection a b c d = (ColumnSingleCollection a,
                                          ColumnSingleCollection b,
                                          ColumnSingleCollection c,
                                          ColumnSingleCollection d)

--- Datatype to select five different columns which can be of different types
--- and from different tables.
type ColumnFiveTupleCollection a b c d e= (ColumnSingleCollection a,
                                           ColumnSingleCollection b,
                                           ColumnSingleCollection c,
                                           ColumnSingleCollection d,
                                           ColumnSingleCollection e)

--- Datatype to select five different columns which can be of different types
--- and from different tables.
type ColumnSixTupleCollection a b c d e f = (ColumnSingleCollection a,
                                             ColumnSingleCollection b,
                                             ColumnSingleCollection c,
                                             ColumnSingleCollection d,
                                             ColumnSingleCollection e,
                                             ColumnSingleCollection f)

-- Data type to represent an aggregation function in a select-clause.
type Fun a = (String , ColumnDescription a)

--- Constructor for aggregation function sum
--- in select-clauses.
--- A pseudo-ResultColumnDescription of type
--- float is created for correct return type.
sum :: Specifier -> ColumnDescription _ -> Fun Float
sum spec (ColDesc name _ _ _) =
  ("Sum( "++ (trSpecifier spec) ,
  (ColDesc name SQLTypeFloat (\f -> (SQLFloat f)) getFloatValue))

--- Constructor for aggregation function avg
--- in select-clauses.
--- A pseudo-ResultColumnDescription of type
--- float is created for correct return type.
avg :: Specifier -> ColumnDescription _ -> Fun Float
avg spec (ColDesc name _ _ _) =
  ("Avg( "++ (trSpecifier spec),
  (ColDesc name SQLTypeFloat (\f -> (SQLFloat f)) getFloatValue))

--- Constructor for aggregation function count
--- in select-clauses.
--- A pseudo-ResultColumnDescription of type
--- float is created for correct return type.
count :: Specifier -> ColumnDescription _ -> Fun Int
count spec (ColDesc name _ _ _) =
  ("Count( "++ (trSpecifier spec),
  (ColDesc name SQLTypeInt (\i -> (SQLInt i)) getIntValue))

--- Constructor for aggregation function min in select-clauses.
minV :: ColumnDescription a -> Fun a
minV cd = ("Min( ", cd)

--- Constructor for aggregation function max in select-clauses.
maxV :: ColumnDescription a -> Fun a
maxV cd = ("Max( ", cd)

--- Constructor function in case no aggregation function is specified.
none :: ColumnDescription a -> Fun a
none cd = ("(", cd)

---Constructor for CaseVal of type Int
---expecting result of type Int in case-expression
caseResultInt :: CaseVal Int
caseResultInt = (SQLTypeInt, getIntValue)

---Constructor for CaseVal of type Float
---expecting result of type Float in case-expression
caseResultFloat :: CaseVal Float
caseResultFloat = (SQLTypeFloat, getFloatValue)

---Constructor for CaseVal of type String
---expecting result of type String in case-expression
caseResultString :: CaseVal String
caseResultString = (SQLTypeString, getStringValue)

---Constructor for CaseVal of type Date
---expecting result of type Date in case-expression
caseResultDate :: CaseVal ClockTime
caseResultDate = (SQLTypeDate, getDateValue)

---Constructor for CaseVal of type Bool
---expecting result of type Bool in case-expression
caseResultBool :: CaseVal Bool
caseResultBool = (SQLTypeBool, getBoolValue)

---Constructor for CaseVal of type Char
---expecting result of type Char in case-expression
caseResultChar :: CaseVal Char
caseResultChar = (SQLTypeChar, getCharValue)

--- Constructor function for representation of statement:
--- CASE WHEN condition THEN val1 ELSE val2 END.
--- It does only work for the same type in then and
--- else branch.
---@param con - the condition
---@param val1 - value for then-branch
---@param val2 - value for else-branch
---@param cv - data providing SQLType and conversion function
caseThen :: Condition -> Value a -> Value a -> (CaseVal a)
                        -> ColumnSingleCollection a
caseThen con val1 val2 cv =
  Case con ((toCValue val1), (toCValue val2)) cv

--- Constructorfunction for ColumnSingleCollection.
---@param coldecs - ColumnDescription of column to select
---@param alias - alias of the table
---@param f - aggregation function (constructor)
singleCol :: ColumnDescription a -> Int -> (ColumnDescription a -> Fun b)
                                        -> ColumnSingleCollection b
singleCol colDesc alias f = ResultColumnDescription convColDesc alias fun
  where (fun, convColDesc) = f colDesc

---Constructor function for ColumnTupleCollection.
---@param col1 - first ColumnSingleCollection
---@param col2 - second ColumnSingleCollection
tupleCol :: ColumnSingleCollection a -> ColumnSingleCollection b
                                     -> ColumnTupleCollection a b
tupleCol col1 col2 = (col1,col2)

---Constructor function for ColumnTripleCollection.
tripleCol :: ColumnSingleCollection a
          -> ColumnSingleCollection b
          -> ColumnSingleCollection c
          -> ColumnTripleCollection a b c
tripleCol col1 col2 col3 = (col1, col2, col3)

---Constructor function for ColumnFourTupleCollection.
fourCol :: ColumnSingleCollection a
        -> ColumnSingleCollection b
        -> ColumnSingleCollection c
        -> ColumnSingleCollection d
        -> ColumnFourTupleCollection a b c d
fourCol col1 col2 col3 col4 = (col1, col2, col3, col4)

---Constructor function for ColumnFiveTupleCollection.
fiveCol :: ColumnSingleCollection a
        -> ColumnSingleCollection b
        -> ColumnSingleCollection c
        -> ColumnSingleCollection d
        -> ColumnSingleCollection e
        -> ColumnFiveTupleCollection a b c d e
fiveCol col1 col2 col3 col4 col5 = (col1, col2, col3, col4, col5)

--- Constructor function for ColumnSixTupleCollection.
sixCol :: ColumnSingleCollection a
        -> ColumnSingleCollection b
        -> ColumnSingleCollection c
        -> ColumnSingleCollection d
        -> ColumnSingleCollection e
        -> ColumnSingleCollection f
        -> ColumnSixTupleCollection a b c d e f
sixCol col1 col2 col3 col4 col5 col6 = (col1, col2, col3, col4, col5, col6)

--- Datatype to describe all parts of a select-query without Setoperators
--- order-by and limit (selecthead) for a single column.
data SingleColumnSelect a  = SingleCS Specifier
                                      (ColumnSingleCollection a)
                                      TableClause
                                      Criteria

--- Datatype to describe all parts of a select-query without Setoperators
--- order-by and limit (selecthead) for two columns.
data TupleColumnSelect a b = TupleCS  Specifier
                                      (ColumnTupleCollection a b)
                                      TableClause
                                      Criteria

--- Datatype to describe all parts of a select-query without Setoperators
--- order-by and limit (selecthead) for three columns.
data TripleColumnSelect a b c = TripleCS Specifier
                                         (ColumnTripleCollection a b c)
                                         TableClause
                                         Criteria

--- Datatype to describe all parts of a select-query without Setoperators
--- order-by and limit (selecthead) for four columns.
data FourColumnSelect a b c d = FourCS Specifier
                                       (ColumnFourTupleCollection a b c d)
                                       TableClause
                                       Criteria

--- Datatype to describe all parts of a select-query without Setoperators
--- order-by and limit (selecthead) for five columns.
data FiveColumnSelect a b c d e = FiveCS Specifier
                                         (ColumnFiveTupleCollection a b c d e)
                                         TableClause
                                         Criteria

--- Datatype to describe all parts of a select-query without Setoperators
--- order-by and limit (selecthead) for five columns.
data SixColumnSelect a b c d e f = SixCS Specifier
                                         (ColumnSixTupleCollection a b c d e f)
                                         TableClause
                                         Criteria

--selector of the SQLType encasulated in a ColumnSingleCollection
getColumnType :: ColumnSingleCollection _ -> [SQLType]
getColumnType col =
  case col of
       (ResultColumnDescription (ColDesc _ typ _ _) _ _) -> [typ]
       (Case _ (_ , _) (typ,_))                          -> [typ]

-- selector of the conversion function encapsulated in a
-- ColumnSingleCollection
getColumnValFunc :: ColumnSingleCollection a -> (SQLValue -> a)
getColumnValFunc col =
  case col of
       (ResultColumnDescription (ColDesc _ _ _ f) _ _)   -> f
       (Case _ (_, _) (_,f))                             -> f

--selector: returns the SQLType of the ColumnSingleCollection
-- inside of SingleColumnSelect
getSingleType :: SingleColumnSelect _ -> [SQLType]
getSingleType (SingleCS _ col _ _) = getColumnType col

--selector: returns the function to convert the SQLValue to the resulttype
getSingleValFunc :: SingleColumnSelect a -> (SQLValue -> a)
getSingleValFunc (SingleCS _ col _ _) = getColumnValFunc col

--selector: returns the list of SQLTypes used
-- inside the TupleColumnSelect
getTupleTypes :: TupleColumnSelect _ _ -> [SQLType]
getTupleTypes (TupleCS _ (col1,col2) _ _) = getColumnType col1
                                              ++ getColumnType col2

--selector: returns the tuple of functions to convert the SQLValue
--to the resulttype
getTupleValFuncs :: TupleColumnSelect a b -> ((SQLValue -> a), (SQLValue -> b))
getTupleValFuncs (TupleCS _ (col1,col2) _ _) = (getColumnValFunc col1,
                                                  getColumnValFunc col2)

--selector: returns the list of SQLTypes used
-- inside the TripleColumnSelect
getTripleTypes :: TripleColumnSelect _ _ _ -> [SQLType]
getTripleTypes (TripleCS _ (col1, col2, col3) _ _) =
  getColumnType col1 ++ getColumnType col2 ++ getColumnType col3

--selector: returns the triple of functions to convert the SQLValue
--to the resulttype
getTripleValFuncs :: TripleColumnSelect a b c ->
                            ((SQLValue -> a), (SQLValue -> b), (SQLValue -> c))
getTripleValFuncs (TripleCS _ (col1, col2, col3) _ _) =
  (getColumnValFunc col1, getColumnValFunc col2, getColumnValFunc col3)

--selector: returns the list of SQLTypes used
-- inside the FourColumnSelect
getFourTupleTypes :: FourColumnSelect _ _ _ _ -> [SQLType]
getFourTupleTypes (FourCS _ (col1, col2, col3, col4) _ _) =
  getColumnType col1 ++ getColumnType col2 ++
    getColumnType col3 ++ getColumnType col4

--selector: returns the fourtuple of functions to convert the
--SQLValue to the resulttype
getFourTupleValFuncs :: FourColumnSelect a b c d ->
                           ((SQLValue -> a), (SQLValue -> b),
                             (SQLValue -> c), (SQLValue -> d))
getFourTupleValFuncs (FourCS _ (col1, col2, col3, col4) _ _) =
  (getColumnValFunc col1, getColumnValFunc col2,
     getColumnValFunc col3, getColumnValFunc col4)


--selector: returns the list of SQLTypes used
-- inside the FiveColumnSelect
getFiveTupleTypes :: FiveColumnSelect a b c d e -> [SQLType]
getFiveTupleTypes (FiveCS _ (col1, col2, col3, col4, col5) _ _) =
  getColumnType col1 ++ getColumnType col2 ++
    getColumnType col3 ++ getColumnType col4 ++ getColumnType col5

--selector: returns the fivetuple of functions to convert the
--SQLValue to the resulttype
getFiveTupleValFuncs :: FiveColumnSelect a b c d e -> ((SQLValue -> a),
  (SQLValue -> b), (SQLValue -> c), (SQLValue -> d), (SQLValue -> e))
getFiveTupleValFuncs (FiveCS _ (col1, col2, col3, col4, col5) _ _) =
  (getColumnValFunc col1, getColumnValFunc col2, getColumnValFunc col3,
    getColumnValFunc col4, getColumnValFunc col5)

--selector: returns the list of SQLTypes used
-- inside the SixColumnSelect
getSixTupleTypes :: SixColumnSelect a b c d e f -> [SQLType]
getSixTupleTypes (SixCS _ (col1, col2, col3, col4, col5, col6) _ _) =
  getColumnType col1 ++ getColumnType col2 ++ getColumnType col3 ++
  getColumnType col4 ++ getColumnType col5 ++ getColumnType col6

--selector: returns the sixtuple of functions to convert the
--SQLValue to the resulttype
getSixTupleValFuncs :: SixColumnSelect a b c d e f
  -> (SQLValue -> a, SQLValue -> b, SQLValue -> c, SQLValue -> d,
      SQLValue -> e, SQLValue -> f)
getSixTupleValFuncs (SixCS _ (col1, col2, col3, col4, col5, col6) _ _) =
  (getColumnValFunc col1, getColumnValFunc col2, getColumnValFunc col3,
   getColumnValFunc col4, getColumnValFunc col5, getColumnValFunc col6)

-- ------------------------------------------------------------------------------
-- translation functions
-- ------------------------------------------------------------------------------

-- Transform a SingleColumnSelect to its string representation.
trSingleSelectQuery :: SingleColumnSelect _ -> String
trSingleSelectQuery (SingleCS sp col tabs crit) =
  ("select "++ trSpecifier sp ++ getResultColumnString col ++" from " ++
   (getTableString tabs "") ++ " " ++ trCriteria crit)

-- Transform a TupleColumnSelect to its string representation.
trTupleSelectQuery :: TupleColumnSelect _ _ -> String
trTupleSelectQuery (TupleCS sp (col1, col2) tabs crit) =
  ("select " ++trSpecifier sp ++ getResultColumnString col1 ++ ", "++
    getResultColumnString col2 ++" from " ++ (getTableString tabs "") ++
      trCriteria crit )

-- Transform a TripleColumnSelect to its string representation.
trTripleSelectQuery :: TripleColumnSelect _ _ _ -> String
trTripleSelectQuery (TripleCS sp (col1, col2, col3) tabs crit) =
  ("select " ++trSpecifier sp ++ getResultColumnString col1 ++ ", "++
    getResultColumnString col2 ++ ", "++  getResultColumnString col3 ++
     " from " ++ (getTableString tabs "") ++ trCriteria crit )

-- Transform a FourTupleColumnSelect to its string representation.
trFourTupleSelectQuery :: FourColumnSelect _ _ _ _ -> String
trFourTupleSelectQuery (FourCS sp (col1, col2, col3, col4) tabs crit) =
  ("select " ++trSpecifier sp ++ getResultColumnString col1 ++ ", "++
    getResultColumnString col2 ++ ", "++  getResultColumnString col3
      ++ ", "++  getResultColumnString col4 ++ " from " ++
      (getTableString tabs "") ++ trCriteria crit )

-- Transform a FiveTupleColumnSelect to its string representation.
trFiveTupleSelectQuery :: FiveColumnSelect _ _ _ _ _ -> String
trFiveTupleSelectQuery (FiveCS sp (col1, col2, col3, col4, col5) tabs crit) =
  ("select " ++trSpecifier sp ++ getResultColumnString col1 ++ ", "++
    getResultColumnString col2 ++", "++ getResultColumnString col3
      ++", "++  getResultColumnString col4 ++ ", "++  getResultColumnString col5
        ++" from " ++ (getTableString tabs "") ++ trCriteria crit )

-- Transform a SixTupleColumnSelect to its string representation.
trSixTupleSelectQuery :: SixColumnSelect _ _ _ _ _ _ -> String
trSixTupleSelectQuery (SixCS sp (col1, col2, col3, col4, col5, col6)
                             tabs crit) =
  ("select " ++trSpecifier sp ++ getResultColumnString col1 ++ ", "++
    getResultColumnString col2 ++ ", " ++ getResultColumnString col3 ++ ", " ++
    getResultColumnString col4 ++ ", " ++ getResultColumnString col5 ++ ", "++
    getResultColumnString col6 ++
    " from " ++ (getTableString tabs "") ++ trCriteria crit )

-- translate set operations
trSetOp :: SetOp -> String
trSetOp Union = " union "
trSetOp Intersect = " intersect "
trSetOp Except = " except "

-- translate limit clause
trLimit :: Maybe Int -> String
trLimit limit = case limit of
                     Nothing -> ""
                     Just n -> " Limit "++(show n)

-- Create the "as tablename" string
asTable :: Table -> Int -> Table
asTable table n = case n of
                      0 -> ""
                      m -> " as '" ++ (show m) ++ table ++ "'"

-- translate joins
trJoinPart1 :: Join -> String
trJoinPart1 Cross = " cross join"
trJoinPart1 (Inner _) = " inner join"

trJoinPart2 :: Join -> String
trJoinPart2 Cross = ""
trJoinPart2 (Inner constraint) =
                          " ON (" ++ (trConstraint constraint)++")"

-- translate a ColumnSingleCollection
getResultColumnString:: ColumnSingleCollection a -> String
getResultColumnString (ResultColumnDescription (ColDesc name _ _ _) alias aggr)
                                          = aggr ++ (trColumn name alias) ++ ")"
getResultColumnString (Case con (val1, val2) _ )
               = "( case when " ++ trCondition con ++ " then " ++ trValue val1
                                        ++ " else " ++ trValue val2 ++ " end)"

-- translate a table-clause
getTableString :: TableClause -> String -> String
getTableString (TC tab alias Nothing) join2 =
   (" '" ++tab ++ "'" ++ (asTable tab alias)++" "++join2)
getTableString (TC tab alias (Just (join, tc))) join2 =
     (" '" ++tab ++ "'" ++ (asTable tab alias)++join2
       ++(trJoinPart1 join) ++ (getTableString tc (trJoinPart2 join)))


getCharValue :: SQLValue -> Char
getCharValue (SQLChar char) = char

getDateValue :: SQLValue -> ClockTime
getDateValue (SQLDate date) = date

getFloatValue :: SQLValue -> Float
getFloatValue (SQLFloat float) = float

getIntValue :: SQLValue -> Int
getIntValue (SQLInt int) = int

getStringValue :: SQLValue -> String
getStringValue (SQLString str) = str

getBoolValue :: SQLValue -> Bool
getBoolValue (SQLBool bool) = bool