{-# LANGUAGE TemplateHaskell #-}
module Database.Relational.Schema.Oracle
( module Database.Relational.Schema.Oracle.Config
, normalizeColumn, notNull, getType
, columnsQuerySQL, primaryKeyQuerySQL
) where
import Control.Applicative ((<|>))
import Data.ByteString (ByteString)
import Data.Char (toLower)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Time (LocalTime)
import Language.Haskell.TH (TypeQ)
import Database.Relational
import Database.Relational.Schema.Oracle.Config
import Database.Relational.Schema.Oracle.ConsColumns (dbaConsColumns)
import qualified Database.Relational.Schema.Oracle.ConsColumns as ConsCols
import Database.Relational.Schema.Oracle.Constraints (dbaConstraints)
import qualified Database.Relational.Schema.Oracle.Constraints as Cons
import Database.Relational.Schema.Oracle.TabColumns (DbaTabColumns, dbaTabColumns)
import qualified Database.Relational.Schema.Oracle.TabColumns as Cols
mapFromSqlDefault :: Map String TypeQ
mapFromSqlDefault = Map.fromList
[ ("CHAR", [t|String|])
, ("VARCHAR", [t|String|])
, ("VARCHAR2", [t|String|])
, ("NCHAR", [t|String|])
, ("NVARCHAR2", [t|String|])
, ("BINARY_FLOAT", [t|Double|])
, ("BINARY_DOUBLE", [t|Double|])
, ("DATE", [t|LocalTime|])
, ("BLOB", [t|ByteString|])
, ("CLOB", [t|String|])
, ("NCLOB", [t|String|])
, ("LONG RAW", [t|ByteString|])
, ("RAW", [t|ByteString|])
, ("ROWID", [t|String|])
, ("UROWID", [t|String|])
]
normalizeColumn :: String -> String
normalizeColumn = map toLower
notNull :: DbaTabColumns -> Bool
notNull = (== Just "N") . Cols.nullable
getType :: Map String TypeQ
-> DbaTabColumns
-> Maybe (String, TypeQ)
getType mapFromSql cols = do
ky <- Cols.dataType cols
typ <- if ky == "NUMBER"
then return $ numberType $ Cols.dataScale cols
else Map.lookup ky mapFromSql <|> Map.lookup ky mapFromSqlDefault
return (normalizeColumn $ Cols.columnName cols, mayNull typ)
where
mayNull typ
| notNull cols = typ
| otherwise = [t|Maybe $(typ)|]
numberType Nothing = [t|Integer|]
numberType (Just n)
| n <= 0 = [t|Integer|]
| otherwise = [t|Double|]
columnsRelationFromTable :: Relation (String, String) DbaTabColumns
columnsRelationFromTable = relation' $ do
cols <- query dbaTabColumns
(owner, ()) <- placeholder $ \owner ->
wheres $ cols ! Cols.owner' .=. owner
(name, ()) <- placeholder $ \name ->
wheres $ cols ! Cols.tableName' .=. name
asc $ cols ! Cols.columnId'
return (owner >< name, cols)
columnsQuerySQL :: Query (String, String) DbaTabColumns
columnsQuerySQL = relationalQuery columnsRelationFromTable
primaryKeyRelation :: Relation (String, String) (Maybe String)
primaryKeyRelation = relation' $ do
cons <- query dbaConstraints
cols <- query dbaTabColumns
consCols <- query dbaConsColumns
wheres $ cons ! Cons.owner' .=. just (cols ! Cols.owner')
wheres $ cons ! Cons.tableName' .=. cols ! Cols.tableName'
wheres $ consCols ! ConsCols.columnName' .=. just (cols ! Cols.columnName')
wheres $ cons ! Cons.constraintName' .=. consCols ! ConsCols.constraintName'
wheres $ cols ! Cols.nullable' .=. just (value "N")
wheres $ cons ! Cons.constraintType' .=. just (value "P")
(owner, ()) <- placeholder $ \owner ->
wheres $ cons ! Cons.owner' .=. just owner
(name, ()) <- placeholder $ \name ->
wheres $ cons ! Cons.tableName' .=. name
asc $ consCols ! ConsCols.position'
return (owner >< name, consCols ! ConsCols.columnName')
primaryKeyQuerySQL :: Query (String, String) (Maybe String)
primaryKeyQuerySQL = relationalQuery primaryKeyRelation