{-# 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

-- NOT COMPLETED
-- (ref: http://docs.oracle.com/cd/B28359_01/server.111/b28318/datatype.htm)
-- | Mapping between type in Oracle DB and Haskell type.
mapFromSqlDefault :: Map String TypeQ
mapFromSqlDefault :: Map String TypeQ
mapFromSqlDefault = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (String
"CHAR", [t|String|])
    , (String
"VARCHAR", [t|String|]) -- deprecated
    , (String
"VARCHAR2", [t|String|])
    , (String
"NCHAR", [t|String|])
    , (String
"NVARCHAR2", [t|String|])
    -- , ("NUMBER", [t|Integer or Double|]) see 'getType'
    , (String
"BINARY_FLOAT", [t|Double|]) -- Float don't work
    , (String
"BINARY_DOUBLE", [t|Double|])
    , (String
"DATE", [t|LocalTime|])
    , (String
"BLOB", [t|ByteString|])
    , (String
"CLOB", [t|String|])
    , (String
"NCLOB", [t|String|])
    , (String
"LONG RAW", [t|ByteString|]) -- deprecated
    , (String
"RAW", [t|ByteString|])
    , (String
"ROWID", [t|String|])
    , (String
"UROWID", [t|String|])
    ]

-- | Normalize column name string to query Oracle DB data dictionary.
normalizeColumn :: String -> String
normalizeColumn :: String -> String
normalizeColumn = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower

-- | Not-null attribute information of column.
notNull :: DbaTabColumns -> Bool
notNull :: DbaTabColumns -> Bool
notNull = (forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
"N") forall b c a. (b -> c) -> (a -> b) -> a -> c
. DbaTabColumns -> Maybe String
Cols.nullable

-- | Get column normalized name and column Haskell type.
getType :: Map String TypeQ -- ^ Type mapping specified by user
        -> DbaTabColumns -- ^ Column info in data dictionary
        -> Maybe (String, TypeQ) -- ^ Result normalized name and mapped Haskell type
getType :: Map String TypeQ -> DbaTabColumns -> Maybe (String, TypeQ)
getType Map String TypeQ
mapFromSql DbaTabColumns
cols = do
    String
ky  <- DbaTabColumns -> Maybe String
Cols.dataType DbaTabColumns
cols
    TypeQ
typ <- if String
ky forall a. Eq a => a -> a -> Bool
== String
"NUMBER"
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a}.
(Quote m, Ord a, Num a) =>
Maybe a -> m Type
numberType forall a b. (a -> b) -> a -> b
$ DbaTabColumns -> Maybe Int32
Cols.dataScale DbaTabColumns
cols
        else forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ky Map String TypeQ
mapFromSql forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ky Map String TypeQ
mapFromSqlDefault
    forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
normalizeColumn forall a b. (a -> b) -> a -> b
$ DbaTabColumns -> String
Cols.columnName DbaTabColumns
cols, forall {m :: * -> *}. Quote m => m Type -> m Type
mayNull TypeQ
typ)
  where
    mayNull :: m Type -> m Type
mayNull m Type
typ
        | DbaTabColumns -> Bool
notNull DbaTabColumns
cols = m Type
typ
        | Bool
otherwise = [t|Maybe $(typ)|]
    numberType :: Maybe a -> m Type
numberType Maybe a
Nothing = [t|Integer|]
    numberType (Just a
n)
        | a
n forall a. Ord a => a -> a -> Bool
<= a
0 = [t|Integer|]
        | Bool
otherwise = [t|Double|]

-- | 'Relation' to query 'DbaTabColumns' from owner name and table name.
columnsRelationFromTable :: Relation (String, String) DbaTabColumns
columnsRelationFromTable :: Relation (String, String) DbaTabColumns
columnsRelationFromTable = forall p r. SimpleQuery p r -> Relation p r
relation' forall a b. (a -> b) -> a -> b
$ do
    Record Flat DbaTabColumns
cols <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () DbaTabColumns
dbaTabColumns
    (PlaceHolders String
owner, ()) <- forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder forall a b. (a -> b) -> a -> b
$ \Record Flat String
owner ->
        forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat DbaTabColumns
cols forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns String
Cols.owner' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String
owner
    (PlaceHolders String
name, ()) <- forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder forall a b. (a -> b) -> a -> b
$ \Record Flat String
name ->
        forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat DbaTabColumns
cols forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns String
Cols.tableName' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String
name
    forall (m :: * -> *) c t. Monad m => Record c t -> Orderings c m ()
asc forall a b. (a -> b) -> a -> b
$ Record Flat DbaTabColumns
cols forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns (Maybe Int32)
Cols.columnId'
    forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders String
owner forall (p :: * -> *) a b.
ProductIsoApplicative p =>
p a -> p b -> p (a, b)
>< PlaceHolders String
name, Record Flat DbaTabColumns
cols)

-- | Phantom typed 'Query' to get 'DbaTabColumns' from owner name and table name.
columnsQuerySQL :: Query (String, String) DbaTabColumns
columnsQuerySQL :: Query (String, String) DbaTabColumns
columnsQuerySQL = forall p r. Relation p r -> Query p r
relationalQuery Relation (String, String) DbaTabColumns
columnsRelationFromTable

-- | 'Relation' to query primary key name from owner name and table name.
primaryKeyRelation :: Relation (String, String) (Maybe String)
primaryKeyRelation :: Relation (String, String) (Maybe String)
primaryKeyRelation = forall p r. SimpleQuery p r -> Relation p r
relation' forall a b. (a -> b) -> a -> b
$ do
    Record Flat DbaConstraints
cons <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () DbaConstraints
dbaConstraints
    Record Flat DbaTabColumns
cols <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () DbaTabColumns
dbaTabColumns
    Record Flat DbaConsColumns
consCols <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () DbaConsColumns
dbaConsColumns

    forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat DbaConstraints
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConstraints (Maybe String)
Cons.owner' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. forall (p :: * -> *) a. ProjectableMaybe p => p a -> p (Maybe a)
just (Record Flat DbaTabColumns
cols forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns String
Cols.owner')
    forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat DbaConstraints
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConstraints String
Cons.tableName' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat DbaTabColumns
cols forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns String
Cols.tableName'
    forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat DbaConsColumns
consCols forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConsColumns (Maybe String)
ConsCols.columnName' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. forall (p :: * -> *) a. ProjectableMaybe p => p a -> p (Maybe a)
just (Record Flat DbaTabColumns
cols forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns String
Cols.columnName')
    forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat DbaConstraints
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConstraints String
Cons.constraintName' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat DbaConsColumns
consCols forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConsColumns String
ConsCols.constraintName'

    forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat DbaTabColumns
cols forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns (Maybe String)
Cols.nullable' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. forall (p :: * -> *) a. ProjectableMaybe p => p a -> p (Maybe a)
just (forall t c. (LiteralSQL t, OperatorContext c) => t -> Record c t
value String
"N")
    forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat DbaConstraints
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConstraints (Maybe String)
Cons.constraintType' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. forall (p :: * -> *) a. ProjectableMaybe p => p a -> p (Maybe a)
just (forall t c. (LiteralSQL t, OperatorContext c) => t -> Record c t
value String
"P")

    (PlaceHolders String
owner, ()) <- forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder forall a b. (a -> b) -> a -> b
$ \Record Flat String
owner ->
        forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat DbaConstraints
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConstraints (Maybe String)
Cons.owner' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. forall (p :: * -> *) a. ProjectableMaybe p => p a -> p (Maybe a)
just Record Flat String
owner
    (PlaceHolders String
name, ()) <- forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder forall a b. (a -> b) -> a -> b
$ \Record Flat String
name ->
        forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat DbaConstraints
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConstraints String
Cons.tableName' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String
name

    forall (m :: * -> *) c t. Monad m => Record c t -> Orderings c m ()
asc forall a b. (a -> b) -> a -> b
$ Record Flat DbaConsColumns
consCols forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConsColumns (Maybe Int32)
ConsCols.position'

    forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders String
owner forall (p :: * -> *) a b.
ProductIsoApplicative p =>
p a -> p b -> p (a, b)
>< PlaceHolders String
name, Record Flat DbaConsColumns
consCols forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConsColumns (Maybe String)
ConsCols.columnName')

-- | Phantom typed 'Query' to get primary key name from owner name and table name.
primaryKeyQuerySQL :: Query (String, String) (Maybe String)
primaryKeyQuerySQL :: Query (String, String) (Maybe String)
primaryKeyQuerySQL = forall p r. Relation p r -> Query p r
relationalQuery Relation (String, String) (Maybe String)
primaryKeyRelation