module Database.Relational.Schema.Oracle
( 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.OracleDataDictionary.ConsColumns (dbaConsColumns)
import qualified Database.Relational.Schema.OracleDataDictionary.ConsColumns as ConsCols
import Database.Relational.Schema.OracleDataDictionary.Constraints (dbaConstraints)
import qualified Database.Relational.Schema.OracleDataDictionary.Constraints as Cons
import Database.Relational.Schema.OracleDataDictionary.TabColumns (DbaTabColumns, dbaTabColumns)
import qualified Database.Relational.Schema.OracleDataDictionary.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