module RESTng.System.ORMTypesConv

where

import Database.HDBC
import Data.Typeable
import System.Time (ClockTime, TimeDiff)

import RESTng.Resources.User (UserRole)


type SqlColumnDesc = (SqlTypeId,            -- HDBC's data type (extracted from a Database.HDBC.SqlColDesc)
                      Bool)                 -- nullable?        (extracted from a Database.HDBC.SqlColDesc)

type TypesAssoc = [(TypeRep, SqlColumnDesc)] -- this list is an n x n mapping used for translation, 
                                            -- but when looking up the translation of either side, just the first element of 
                                            -- the other side will be retrieved

typeRepToSqlColumnDesc :: TypeRep -> TypesAssoc -> Maybe SqlColumnDesc
typeRepToSqlColumnDesc = lookup


hdbcToSqlColumnDesc :: SqlColDesc -> SqlColumnDesc
hdbcToSqlColumnDesc c = case colNullable c of
                          Nothing -> error ("don't know if the column is nullable: " ++ show c)
                          Just b -> (colType c, b)

typesAssoc :: [(TypeRep, SqlColumnDesc)]
typesAssoc = map nullableTypeAssoc    basicTypesAssocs ++ 
             map notNullableTypeAssoc basicTypesAssocs
             where
               notNullableTypeAssoc (trep, sqltype) = (trep, (sqltype, False))
               nullableTypeAssoc    (trep, sqltype) = (mkTyConApp typeConOfMaybe [trep], (sqltype, True))


basicTypesAssocs :: [(TypeRep, SqlTypeId)]
basicTypesAssocs =
             [
              (stringTR, SqlVarCharT),
              (integerTR, SqlBigIntT),
              (boolTR, SqlBitT),
              (clockTimeTR, SqlTimestampT),
              (userRolesTR, SqlVarCharT),

              (stringTR, SqlCharT),
              (stringTR, SqlVarCharT),
              (stringTR, SqlLongVarCharT),
              (stringTR, SqlWCharT),
              (stringTR, SqlWVarCharT),
              (stringTR, SqlWLongVarCharT),
              (rationalTR, SqlDecimalT),
              (rationalTR, SqlNumericT),
--              ("Int32", SqlSmallIntT),
--              ("Int32", SqlIntegerT),
              (rationalTR, SqlRealT),
              (floatTR, SqlFloatT),
              (doubleTR, SqlDoubleT),
              (boolTR, SqlBitT),
--              ("Int32", SqlTinyIntT),
--              ("Int64", SqlBigIntT),
--              ("", SqlBinaryT),
--              ("", SqlVarBinaryT),
--              ("", SqlLongVarBinaryT),
              (clockTimeTR, SqlDateT),
              (clockTimeTR, SqlTimeT),
              (clockTimeTR, SqlTimestampT),
              (clockTimeTR, SqlUTCDateTimeT),
              (timeDiffTR, SqlUTCTimeT)
--              ("", SqlIntervalT SqlInterval),
--              ("", SqlGUIDT),
--              ("", SqlUnknownT String),
             ]

renderSqlTypeId :: SqlTypeId -> String
renderSqlTypeId SqlVarCharT = "text"
renderSqlTypeId SqlBigIntT = "int4"
renderSqlTypeId SqlBitT = "bool"
renderSqlTypeId SqlTimestampT = "timestamptz"
--renderSqlTypeId SqlDecimalT = "???"
renderSqlTypeId SqlFloatT = "float4"
renderSqlTypeId SqlDoubleT = "float8"
--renderSqlTypeId SqlUTCTimeT = "???"


-- some TypeRep s values
ctTc :: TyCon
ctTc = mkTyCon "System.Time.ClockTime"
instance Typeable ClockTime where typeOf _ = mkTyConApp ctTc []

ctTd :: TyCon
ctTd = mkTyCon "System.Time.TimeDiff"
instance Typeable TimeDiff where typeOf _ = mkTyConApp ctTd []

stringTR = typeOf (undefined :: String)
--int32TR = typeOf (undefined :: Int32)
--int64TR = typeOf (undefined :: Int64)
intTR = typeOf (undefined :: Int)
integerTR = typeOf (undefined :: Integer)
rationalTR = typeOf (undefined :: Rational)
floatTR = typeOf (undefined :: Float)
doubleTR = typeOf (undefined :: Double)
boolTR = typeOf (undefined :: Bool)
clockTimeTR = typeOf (undefined :: ClockTime)
timeDiffTR = typeOf (undefined :: TimeDiff)
userRolesTR = typeOf (undefined :: [UserRole])

typeConOfMaybe = (typeRepTyCon . typeOf) (Just ())