{-# 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 informations
-- 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 =
  [(String, TypeQ)] -> Map String TypeQ
forall k a. Ord k => [(k, a)] -> Map k a
fromList [("VARCHAR",   [t|String|]),
            ("CHAR",      [t|String|]),
            ("CHARACTER", [t|String|]),
            ("TIMESTAMP", [t|LocalTime|]),
            ("DATE",      [t|Day|]),
            ("SMALLINT",  [t|Int16|]),
            ("INTEGER",   [t|Int32|]),
            ("BIGINT",    [t|Int64|]),
            ("BLOB",      [t|String|]),
            ("CLOB",      [t|String|])]

-- | Normalize column name string to query DB2 system catalog
normalizeColumn :: String -> String
normalizeColumn :: String -> String
normalizeColumn =  (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower

-- | Not-null attribute information of column.
notNull :: Columns -> Bool
notNull :: Columns -> Bool
notNull =  (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "N") (String -> Bool) -> (Columns -> String) -> Columns -> Bool
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 mapFromSql :: Map String TypeQ
mapFromSql rec :: Columns
rec = do
  TypeQ
typ <- (String -> Map String TypeQ -> Maybe TypeQ
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
key 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
key 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
$ Columns -> String
Columns.colname Columns
rec, TypeQ -> TypeQ
mayNull TypeQ
typ)
  where key :: String
key = Columns -> String
Columns.typename Columns
rec
        mayNull :: TypeQ -> TypeQ
mayNull typ :: TypeQ
typ = if Columns -> Bool
notNull Columns
rec
                      then TypeQ
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 =  SimpleQuery (String, String) Columns
-> Relation (String, String) Columns
forall p r. SimpleQuery p r -> Relation p r
relation' (SimpleQuery (String, String) Columns
 -> Relation (String, String) Columns)
-> SimpleQuery (String, String) Columns
-> Relation (String, String) Columns
forall a b. (a -> b) -> a -> b
$ do
  Record Flat Columns
c <- Relation () Columns
-> Orderings Flat QueryCore (Record Flat Columns)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () Columns
columns
  (schemaP :: PlaceHolders String
schemaP, ()) <- (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 (\ph :: Record Flat String
ph -> 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 Columns
c Record Flat Columns -> Pi Columns String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Columns String
Columns.tabschema' 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
ph)
  (nameP :: PlaceHolders String
nameP  , ()) <- (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 (\ph :: Record Flat String
ph -> 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 Columns
c Record Flat Columns -> Pi Columns String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Columns String
Columns.tabname'   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
ph)
  Record Flat Int16 -> Orderings Flat QueryCore ()
forall (m :: * -> *) c t. Monad m => Record c t -> Orderings c m ()
asc (Record Flat Int16 -> Orderings Flat QueryCore ())
-> Record Flat Int16 -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat Columns
c Record Flat Columns -> Pi Columns Int16 -> Record Flat Int16
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Columns Int16
Columns.colno'
  (PlaceHolders (String, String), Record Flat Columns)
-> SimpleQuery (String, String) Columns
forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders String
schemaP PlaceHolders String
-> PlaceHolders String -> PlaceHolders (String, String)
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 =  Relation (String, String) Columns -> Query (String, String) Columns
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 =  SimpleQuery (String, String) String
-> Relation (String, String) String
forall p r. SimpleQuery p r -> Relation p r
relation' (SimpleQuery (String, String) String
 -> Relation (String, String) String)
-> SimpleQuery (String, String) String
-> Relation (String, String) String
forall a b. (a -> b) -> a -> b
$ do
  Record Flat Tabconst
cons  <- Relation () Tabconst
-> Orderings Flat QueryCore (Record Flat Tabconst)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () Tabconst
tabconst
  Record Flat Keycoluse
key   <- Relation () Keycoluse
-> Orderings Flat QueryCore (Record Flat Keycoluse)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () Keycoluse
keycoluse
  Record Flat Columns
col   <- Relation () Columns
-> Orderings Flat QueryCore (Record Flat Columns)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () Columns
columns

  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 Tabconst
cons Record Flat Tabconst -> Pi Tabconst String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Tabconst String
Tabconst.tabschema' 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 Columns
col Record Flat Columns -> Pi Columns String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Columns String
Columns.tabschema'
  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 Tabconst
cons Record Flat Tabconst -> Pi Tabconst String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Tabconst String
Tabconst.tabname'   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 Columns
col Record Flat Columns -> Pi Columns String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Columns String
Columns.tabname'
  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 Keycoluse
key  Record Flat Keycoluse -> Pi Keycoluse String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Keycoluse String
Keycoluse.colname'  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 Columns
col Record Flat Columns -> Pi Columns String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Columns String
Columns.colname'
  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 Tabconst
cons Record Flat Tabconst -> Pi Tabconst String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Tabconst String
Tabconst.constname' 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 Keycoluse
key Record Flat Keycoluse -> Pi Keycoluse String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Keycoluse String
Keycoluse.constname'

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

  (schemaP :: PlaceHolders String
schemaP, ()) <- (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 (\ph :: Record Flat String
ph -> 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 Tabconst
cons Record Flat Tabconst -> Pi Tabconst String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Tabconst String
Tabconst.tabschema' 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
ph)
  (nameP :: PlaceHolders String
nameP  , ()) <- (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 (\ph :: Record Flat String
ph -> 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 Tabconst
cons Record Flat Tabconst -> Pi Tabconst String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi Tabconst String
Tabconst.tabname'   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
ph)

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

  (PlaceHolders (String, String), Record Flat String)
-> SimpleQuery (String, String) String
forall (m :: * -> *) a. Monad m => a -> m a
return   (PlaceHolders String
schemaP PlaceHolders String
-> PlaceHolders String -> PlaceHolders (String, String)
forall (p :: * -> *) a b.
ProductIsoApplicative p =>
p a -> p b -> p (a, b)
>< PlaceHolders String
nameP, Record Flat Keycoluse
key Record Flat Keycoluse -> Pi Keycoluse String -> Record Flat String
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 =  Relation (String, String) String -> Query (String, String) String
forall p r. Relation p r -> Query p r
relationalQuery Relation (String, String) String
primaryKeyRelation