module Database.HDBC.Schema.IBMDB2 (
driverIBMDB2
) where
import Prelude hiding (length)
import Language.Haskell.TH (TypeQ)
import qualified Data.List as List
import Data.Char (toUpper)
import Data.Map (fromList)
import Control.Monad (when)
import Database.HDBC (IConnection, SqlValue)
import Language.Haskell.TH.Lib.Extra (reportMessage)
import Database.HDBC.Record.Query (runQuery')
import Database.HDBC.Record.Persistable ()
import Database.Record.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
import Database.Relational.Schema.IBMDB2
(normalizeColumn, notNull, getType, columnsQuerySQL, primaryKeyQuerySQL)
import Database.Relational.Schema.DB2Syscat.Columns (Columns)
import qualified Database.Relational.Schema.DB2Syscat.Columns as Columns
import Database.HDBC.Schema.Driver
(TypeMap, Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)
$(makeRecordPersistableWithSqlTypeDefaultFromDefined
[t| SqlValue |] ''Columns)
logPrefix :: String -> String
logPrefix = ("IBMDB2: " ++)
putLog :: String -> IO ()
putLog = reportMessage . logPrefix
compileErrorIO :: String -> IO a
compileErrorIO = fail . logPrefix
getPrimaryKey' :: IConnection conn
=> conn
-> String
-> String
-> IO [String]
getPrimaryKey' conn scm' tbl' = do
let tbl = map toUpper tbl'
scm = map toUpper scm'
primCols <- runQuery' conn primaryKeyQuerySQL (scm, tbl)
let primaryKeyCols = normalizeColumn `fmap` primCols
putLog $ "getPrimaryKey: primary key = " ++ show primaryKeyCols
return primaryKeyCols
getColumns' :: IConnection conn
=> TypeMap
-> conn
-> String
-> String
-> IO ([(String, TypeQ)], [Int])
getColumns' tmap conn scm' tbl' = do
let tbl = map toUpper tbl'
scm = map toUpper scm'
cols <- runQuery' conn columnsQuerySQL (scm, tbl)
when (null cols) . compileErrorIO
$ "getFields: No columns found: schema = " ++ scm ++ ", table = " ++ tbl
let notNullIdxs = map fst . filter (notNull . snd) . zip [0..] $ cols
putLog
$ "getFields: num of columns = " ++ show (List.length cols)
++ ", not null columns = " ++ show notNullIdxs
let getType' col = case getType (fromList tmap) col of
Nothing -> compileErrorIO
$ "Type mapping is not defined against DB2 type: " ++ Columns.typename col
Just p -> return p
types <- mapM getType' cols
return (types, notNullIdxs)
driverIBMDB2 :: IConnection conn => Driver conn
driverIBMDB2 =
emptyDriver { getFieldsWithMap = getColumns' }
{ getPrimaryKey = getPrimaryKey' }