{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      : Database.Relational.Schema.IBMDB2
-- Copyright   : 2013-2019 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module implements queries to get
-- table schema and table constraint information
-- from system catalog of IBM DB2.
module Database.Relational.Schema.IBMDB2 (
  module Database.Relational.Schema.IBMDB2.Config,

  normalizeColumn, notNull, getType,

  columnsQuerySQL, primaryKeyQuerySQL
  ) where


import Data.Int (Int16, Int32, Int64)
import Data.Char (toLower)
import Data.Map (Map, fromList)
import qualified Data.Map as Map
import Data.Time (LocalTime, Day)
import Language.Haskell.TH (TypeQ)

import Database.Relational
  (Query, relationalQuery, Relation, query, relation',
   wheres, (.=.), (!), (><), placeholder, asc, value)

import Control.Applicative ((<|>))

import Database.Relational.Schema.IBMDB2.Config
import Database.Relational.Schema.IBMDB2.Columns (Columns, columns)
import qualified Database.Relational.Schema.IBMDB2.Columns as Columns
import Database.Relational.Schema.IBMDB2.Tabconst (tabconst)
import qualified Database.Relational.Schema.IBMDB2.Tabconst as Tabconst
import Database.Relational.Schema.IBMDB2.Keycoluse (keycoluse)
import qualified Database.Relational.Schema.IBMDB2.Keycoluse as Keycoluse


-- | Mapping between type in DB2 and Haskell type.
mapFromSqlDefault :: Map String TypeQ
mapFromSqlDefault :: Map String TypeQ
mapFromSqlDefault =
  forall k a. Ord k => [(k, a)] -> Map k a
fromList [(String
"VARCHAR",   [t|String|]),
            (String
"CHAR",      [t|String|]),
            (String
"CHARACTER", [t|String|]),
            (String
"TIMESTAMP", [t|LocalTime|]),
            (String
"DATE",      [t|Day|]),
            (String
"SMALLINT",  [t|Int16|]),
            (String
"INTEGER",   [t|Int32|]),
            (String
"BIGINT",    [t|Int64|]),
            (String
"BLOB",      [t|String|]),
            (String
"CLOB",      [t|String|])]

-- | Normalize column name string to query DB2 system catalog
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 :: Columns -> Bool
notNull :: Columns -> Bool
notNull =  (forall a. Eq a => a -> a -> Bool
== String
"N") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Columns -> String
Columns.nulls

-- | Get column normalized name and column Haskell type.
getType :: Map String TypeQ      -- ^ Type mapping specified by user
        -> Columns               -- ^ Column info in system catalog
        -> Maybe (String, TypeQ) -- ^ Result normalized name and mapped Haskell type
getType :: Map String TypeQ -> Columns -> Maybe (String, TypeQ)
getType Map String TypeQ
mapFromSql Columns
rec = do
  TypeQ
typ <- (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
key 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
key Map String TypeQ
mapFromSqlDefault)
  forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
normalizeColumn forall a b. (a -> b) -> a -> b
$ Columns -> String
Columns.colname Columns
rec, forall {m :: * -> *}. Quote m => m Type -> m Type
mayNull TypeQ
typ)
  where key :: String
key = Columns -> String
Columns.typename Columns
rec
        mayNull :: m Type -> m Type
mayNull m Type
typ = if Columns -> Bool
notNull Columns
rec
                      then m Type
typ
                      else [t| Maybe $(typ) |]

-- | 'Relation' to query 'Columns' from schema name and table name.
columnsRelationFromTable :: Relation (String, String) Columns
columnsRelationFromTable :: Relation (String, String) Columns
columnsRelationFromTable =  forall p r. SimpleQuery p r -> Relation p r
relation' forall a b. (a -> b) -> a -> b
$ do
  Record Flat Columns
c <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () Columns
columns
  (PlaceHolders String
schemaP, ()) <- forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder (\Record Flat String
ph -> forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat Columns
c forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Columns String
Columns.tabschema' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String
ph)
  (PlaceHolders String
nameP  , ()) <- forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder (\Record Flat String
ph -> forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat Columns
c forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Columns String
Columns.tabname'   forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String
ph)
  forall (m :: * -> *) c t. Monad m => Record c t -> Orderings c m ()
asc forall a b. (a -> b) -> a -> b
$ Record Flat Columns
c forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Columns Int16
Columns.colno'
  forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders String
schemaP forall (p :: * -> *) a b.
ProductIsoApplicative p =>
p a -> p b -> p (a, b)
>< PlaceHolders String
nameP, Record Flat Columns
c)

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


-- | 'Relation' to query primary key name from schema name and table name.
primaryKeyRelation :: Relation (String, String) String
primaryKeyRelation :: Relation (String, String) String
primaryKeyRelation =  forall p r. SimpleQuery p r -> Relation p r
relation' forall a b. (a -> b) -> a -> b
$ do
  Record Flat Tabconst
cons  <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () Tabconst
tabconst
  Record Flat Keycoluse
key   <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () Keycoluse
keycoluse
  Record Flat Columns
col   <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () Columns
columns

  forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat Tabconst
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Tabconst String
Tabconst.tabschema' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat Columns
col forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Columns String
Columns.tabschema'
  forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat Tabconst
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Tabconst String
Tabconst.tabname'   forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat Columns
col forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Columns String
Columns.tabname'
  forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat Keycoluse
key  forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Keycoluse String
Keycoluse.colname'  forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat Columns
col forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Columns String
Columns.colname'
  forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat Tabconst
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Tabconst String
Tabconst.constname' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat Keycoluse
key forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Keycoluse String
Keycoluse.constname'

  forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat Columns
col  forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Columns String
Columns.nulls'     forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. 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 Tabconst
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Tabconst String
Tabconst.type'     forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. forall t c. (LiteralSQL t, OperatorContext c) => t -> Record c t
value String
"P"
  forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat Tabconst
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Tabconst String
Tabconst.enforced' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. forall t c. (LiteralSQL t, OperatorContext c) => t -> Record c t
value String
"Y"

  (PlaceHolders String
schemaP, ()) <- forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder (\Record Flat String
ph -> forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat Tabconst
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Tabconst String
Tabconst.tabschema' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String
ph)
  (PlaceHolders String
nameP  , ()) <- forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder (\Record Flat String
ph -> forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat Tabconst
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Tabconst String
Tabconst.tabname'   forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String
ph)

  forall (m :: * -> *) c t. Monad m => Record c t -> Orderings c m ()
asc  forall a b. (a -> b) -> a -> b
$ Record Flat Keycoluse
key forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Keycoluse Int16
Keycoluse.colseq'

  forall (m :: * -> *) a. Monad m => a -> m a
return   (PlaceHolders String
schemaP forall (p :: * -> *) a b.
ProductIsoApplicative p =>
p a -> p b -> p (a, b)
>< PlaceHolders String
nameP, Record Flat Keycoluse
key forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Keycoluse String
Keycoluse.colname')

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