{-# 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 String TypeQ
mapFromSqlDefault = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (String
"CHAR", [t|String|])
, (String
"VARCHAR", [t|String|])
, (String
"VARCHAR2", [t|String|])
, (String
"NCHAR", [t|String|])
, (String
"NVARCHAR2", [t|String|])
, (String
"BINARY_FLOAT", [t|Double|])
, (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|])
, (String
"RAW", [t|ByteString|])
, (String
"ROWID", [t|String|])
, (String
"UROWID", [t|String|])
]
normalizeColumn :: String -> String
normalizeColumn :: String -> String
normalizeColumn = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
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
getType :: Map String TypeQ
-> DbaTabColumns
-> Maybe (String, TypeQ)
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|]
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)
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
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')
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