{-# 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 = [(String, TypeQ)] -> Map String TypeQ
forall k a. Ord k => [(k, a)] -> Map k a
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 :: String -> String
normalizeColumn = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
notNull :: DbaTabColumns -> Bool
notNull :: DbaTabColumns -> Bool
notNull = (Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just "N") (Maybe String -> Bool)
-> (DbaTabColumns -> Maybe String) -> DbaTabColumns -> Bool
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 mapFromSql :: Map String TypeQ
mapFromSql cols :: DbaTabColumns
cols = do
String
ky <- DbaTabColumns -> Maybe String
Cols.dataType DbaTabColumns
cols
TypeQ
typ <- if String
ky String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "NUMBER"
then TypeQ -> Maybe TypeQ
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeQ -> Maybe TypeQ) -> TypeQ -> Maybe TypeQ
forall a b. (a -> b) -> a -> b
$ Maybe Int32 -> TypeQ
forall a. (Ord a, Num a) => Maybe a -> TypeQ
numberType (Maybe Int32 -> TypeQ) -> Maybe Int32 -> TypeQ
forall a b. (a -> b) -> a -> b
$ DbaTabColumns -> Maybe Int32
Cols.dataScale DbaTabColumns
cols
else String -> Map String TypeQ -> Maybe TypeQ
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ky Map String TypeQ
mapFromSql Maybe TypeQ -> Maybe TypeQ -> Maybe TypeQ
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Map String TypeQ -> Maybe TypeQ
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ky Map String TypeQ
mapFromSqlDefault
(String, TypeQ) -> Maybe (String, TypeQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
normalizeColumn (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ DbaTabColumns -> String
Cols.columnName DbaTabColumns
cols, TypeQ -> TypeQ
mayNull TypeQ
typ)
where
mayNull :: TypeQ -> TypeQ
mayNull typ :: TypeQ
typ
| DbaTabColumns -> Bool
notNull DbaTabColumns
cols = TypeQ
typ
| Bool
otherwise = [t|Maybe $(typ)|]
numberType :: Maybe a -> TypeQ
numberType Nothing = [t|Integer|]
numberType (Just n :: a
n)
| a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [t|Integer|]
| Bool
otherwise = [t|Double|]
columnsRelationFromTable :: Relation (String, String) DbaTabColumns
columnsRelationFromTable :: Relation (String, String) DbaTabColumns
columnsRelationFromTable = SimpleQuery (String, String) DbaTabColumns
-> Relation (String, String) DbaTabColumns
forall p r. SimpleQuery p r -> Relation p r
relation' (SimpleQuery (String, String) DbaTabColumns
-> Relation (String, String) DbaTabColumns)
-> SimpleQuery (String, String) DbaTabColumns
-> Relation (String, String) DbaTabColumns
forall a b. (a -> b) -> a -> b
$ do
Record Flat DbaTabColumns
cols <- Relation () DbaTabColumns
-> Orderings Flat QueryCore (Record Flat DbaTabColumns)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () DbaTabColumns
dbaTabColumns
(owner :: PlaceHolders String
owner, ()) <- (Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ())
forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder ((Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ()))
-> (Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ())
forall a b. (a -> b) -> a -> b
$ \owner :: Record Flat String
owner ->
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat DbaTabColumns
cols Record Flat DbaTabColumns
-> Pi DbaTabColumns String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns String
Cols.owner' Record Flat String -> Record Flat String -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String
owner
(name :: PlaceHolders String
name, ()) <- (Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ())
forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder ((Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ()))
-> (Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ())
forall a b. (a -> b) -> a -> b
$ \name :: Record Flat String
name ->
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat DbaTabColumns
cols Record Flat DbaTabColumns
-> Pi DbaTabColumns String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns String
Cols.tableName' Record Flat String -> Record Flat String -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String
name
Record Flat (Maybe Int32) -> Orderings Flat QueryCore ()
forall (m :: * -> *) c t. Monad m => Record c t -> Orderings c m ()
asc (Record Flat (Maybe Int32) -> Orderings Flat QueryCore ())
-> Record Flat (Maybe Int32) -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat DbaTabColumns
cols Record Flat DbaTabColumns
-> Pi DbaTabColumns (Maybe Int32) -> Record Flat (Maybe Int32)
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns (Maybe Int32)
Cols.columnId'
(PlaceHolders (String, String), Record Flat DbaTabColumns)
-> SimpleQuery (String, String) DbaTabColumns
forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders String
owner PlaceHolders String
-> PlaceHolders String -> PlaceHolders (String, String)
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 = Relation (String, String) DbaTabColumns
-> Query (String, String) DbaTabColumns
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 = SimpleQuery (String, String) (Maybe String)
-> Relation (String, String) (Maybe String)
forall p r. SimpleQuery p r -> Relation p r
relation' (SimpleQuery (String, String) (Maybe String)
-> Relation (String, String) (Maybe String))
-> SimpleQuery (String, String) (Maybe String)
-> Relation (String, String) (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
Record Flat DbaConstraints
cons <- Relation () DbaConstraints
-> Orderings Flat QueryCore (Record Flat DbaConstraints)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () DbaConstraints
dbaConstraints
Record Flat DbaTabColumns
cols <- Relation () DbaTabColumns
-> Orderings Flat QueryCore (Record Flat DbaTabColumns)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () DbaTabColumns
dbaTabColumns
Record Flat DbaConsColumns
consCols <- Relation () DbaConsColumns
-> Orderings Flat QueryCore (Record Flat DbaConsColumns)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () DbaConsColumns
dbaConsColumns
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat DbaConstraints
cons Record Flat DbaConstraints
-> Pi DbaConstraints (Maybe String) -> Record Flat (Maybe String)
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConstraints (Maybe String)
Cons.owner' Record Flat (Maybe String)
-> Record Flat (Maybe String) -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String -> Record Flat (Maybe String)
forall (p :: * -> *) a. ProjectableMaybe p => p a -> p (Maybe a)
just (Record Flat DbaTabColumns
cols Record Flat DbaTabColumns
-> Pi DbaTabColumns String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns String
Cols.owner')
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat DbaConstraints
cons Record Flat DbaConstraints
-> Pi DbaConstraints String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConstraints String
Cons.tableName' Record Flat String -> Record Flat String -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat DbaTabColumns
cols Record Flat DbaTabColumns
-> Pi DbaTabColumns String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns String
Cols.tableName'
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat DbaConsColumns
consCols Record Flat DbaConsColumns
-> Pi DbaConsColumns (Maybe String) -> Record Flat (Maybe String)
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConsColumns (Maybe String)
ConsCols.columnName' Record Flat (Maybe String)
-> Record Flat (Maybe String) -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String -> Record Flat (Maybe String)
forall (p :: * -> *) a. ProjectableMaybe p => p a -> p (Maybe a)
just (Record Flat DbaTabColumns
cols Record Flat DbaTabColumns
-> Pi DbaTabColumns String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns String
Cols.columnName')
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat DbaConstraints
cons Record Flat DbaConstraints
-> Pi DbaConstraints String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConstraints String
Cons.constraintName' Record Flat String -> Record Flat String -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat DbaConsColumns
consCols Record Flat DbaConsColumns
-> Pi DbaConsColumns String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConsColumns String
ConsCols.constraintName'
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat DbaTabColumns
cols Record Flat DbaTabColumns
-> Pi DbaTabColumns (Maybe String) -> Record Flat (Maybe String)
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaTabColumns (Maybe String)
Cols.nullable' Record Flat (Maybe String)
-> Record Flat (Maybe String) -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String -> Record Flat (Maybe String)
forall (p :: * -> *) a. ProjectableMaybe p => p a -> p (Maybe a)
just (String -> Record Flat String
forall t c. (LiteralSQL t, OperatorContext c) => t -> Record c t
value "N")
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat DbaConstraints
cons Record Flat DbaConstraints
-> Pi DbaConstraints (Maybe String) -> Record Flat (Maybe String)
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConstraints (Maybe String)
Cons.constraintType' Record Flat (Maybe String)
-> Record Flat (Maybe String) -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String -> Record Flat (Maybe String)
forall (p :: * -> *) a. ProjectableMaybe p => p a -> p (Maybe a)
just (String -> Record Flat String
forall t c. (LiteralSQL t, OperatorContext c) => t -> Record c t
value "P")
(owner :: PlaceHolders String
owner, ()) <- (Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ())
forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder ((Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ()))
-> (Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ())
forall a b. (a -> b) -> a -> b
$ \owner :: Record Flat String
owner ->
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat DbaConstraints
cons Record Flat DbaConstraints
-> Pi DbaConstraints (Maybe String) -> Record Flat (Maybe String)
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConstraints (Maybe String)
Cons.owner' Record Flat (Maybe String)
-> Record Flat (Maybe String) -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String -> Record Flat (Maybe String)
forall (p :: * -> *) a. ProjectableMaybe p => p a -> p (Maybe a)
just Record Flat String
owner
(name :: PlaceHolders String
name, ()) <- (Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ())
forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder ((Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ()))
-> (Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ())
forall a b. (a -> b) -> a -> b
$ \name :: Record Flat String
name ->
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat DbaConstraints
cons Record Flat DbaConstraints
-> Pi DbaConstraints String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConstraints String
Cons.tableName' Record Flat String -> Record Flat String -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String
name
Record Flat (Maybe Int32) -> Orderings Flat QueryCore ()
forall (m :: * -> *) c t. Monad m => Record c t -> Orderings c m ()
asc (Record Flat (Maybe Int32) -> Orderings Flat QueryCore ())
-> Record Flat (Maybe Int32) -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat DbaConsColumns
consCols Record Flat DbaConsColumns
-> Pi DbaConsColumns (Maybe Int32) -> Record Flat (Maybe Int32)
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi DbaConsColumns (Maybe Int32)
ConsCols.position'
(PlaceHolders (String, String), Record Flat (Maybe String))
-> SimpleQuery (String, String) (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders String
owner PlaceHolders String
-> PlaceHolders String -> PlaceHolders (String, String)
forall (p :: * -> *) a b.
ProductIsoApplicative p =>
p a -> p b -> p (a, b)
>< PlaceHolders String
name, Record Flat DbaConsColumns
consCols Record Flat DbaConsColumns
-> Pi DbaConsColumns (Maybe String) -> Record Flat (Maybe String)
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 = Relation (String, String) (Maybe String)
-> Query (String, String) (Maybe String)
forall p r. Relation p r -> Query p r
relationalQuery Relation (String, String) (Maybe String)
primaryKeyRelation