{-# LANGUAGE TemplateHaskell #-}
module Database.Relational.Schema.MySQL
    ( module Database.Relational.Schema.MySQL.Config

    , normalizeColumn
    , notNull
    , getType
    , columnsQuerySQL
    , primaryKeyQuerySQL
    )
    where

import           Data.Int               (Int8, Int16, Int32, Int64)
import           Data.Char              (toLower, toUpper)
import           Data.Map               (Map, fromList)
import qualified Data.Map               as Map
import           Data.Time              (Day, LocalTime, TimeOfDay)
import           Data.Time.Clock.POSIX  (POSIXTime)
import           Data.ByteString        (ByteString)
import           Control.Applicative    ((<|>))
import           Language.Haskell.TH    (TypeQ)

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

import           Database.Relational.Schema.MySQL.Config
import           Database.Relational.Schema.MySQL.Columns           (Columns, columns)
import qualified Database.Relational.Schema.MySQL.Columns           as Columns
import           Database.Relational.Schema.MySQL.TableConstraints  (tableConstraints)
import qualified Database.Relational.Schema.MySQL.TableConstraints  as Tabconst
import           Database.Relational.Schema.MySQL.KeyColumnUsage    (keyColumnUsage)
import qualified Database.Relational.Schema.MySQL.KeyColumnUsage    as Keycoluse

-- TODO: Need to check unsigned int types to avoid wrong mapping

mapFromSqlDefault :: Map String TypeQ
mapFromSqlDefault :: Map String TypeQ
mapFromSqlDefault = forall k a. Ord k => [(k, a)] -> Map k a
fromList
    [ (String
"CHAR",       [t| String |])
    , (String
"VARCHAR",    [t| String |])
    , (String
"TINYTEXT",   [t| String |])
    , (String
"TEXT",       [t| String |])
    , (String
"MEDIUMTEXT", [t| String |])
    , (String
"LONGTEXT",   [t| String |])
    , (String
"TINYBLOB",   [t| ByteString |])
    , (String
"BLOB",       [t| ByteString |])
    , (String
"MEDIUMBLOB", [t| ByteString |])
    , (String
"LONGBLOB",   [t| ByteString |])
    , (String
"DATE",       [t| Day |])
    , (String
"DATETIME",   [t| LocalTime |])
    , (String
"TIME",       [t| TimeOfDay |])
    , (String
"TIMESTAMP",  [t| POSIXTime |])
    , (String
"TINYINT",    [t| Int8 |])
    , (String
"SMALLINT",   [t| Int16 |])
    , (String
"MEDIUMINT",  [t| Int32 |])
    , (String
"INT",        [t| Int32 |])
    , (String
"INTEGER",    [t| Int32 |])
    , (String
"BIGINT",     [t| Int64 |])
    ]

normalizeColumn :: String -> String
normalizeColumn :: String -> String
normalizeColumn = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower

notNull :: Columns -> Bool
notNull :: Columns -> Bool
notNull = (forall a. Eq a => a -> a -> Bool
== String
"NO") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Columns -> String
Columns.isNullable

getType :: Map String TypeQ
        -> Columns
        -> Maybe (String, TypeQ)
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.columnName Columns
rec, forall {m :: * -> *}. Quote m => m Type -> m Type
mayNull TypeQ
typ)
    where
        key :: String
key = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall a b. (a -> b) -> a -> b
$ Columns -> String
Columns.dataType 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)|]

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
    where
        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.tableSchema' 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.tableName'   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.ordinalPosition'
            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)

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
    where
        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 TableConstraints
cons <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () TableConstraints
tableConstraints
            Record Flat KeyColumnUsage
key  <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () KeyColumnUsage
keyColumnUsage

            forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat TableConstraints
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi TableConstraints String
Tabconst.tableSchema'    forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat KeyColumnUsage
key forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi KeyColumnUsage String
Keycoluse.tableSchema'
            forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat TableConstraints
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi TableConstraints String
Tabconst.tableName'      forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat KeyColumnUsage
key forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi KeyColumnUsage String
Keycoluse.tableName'
            forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat TableConstraints
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi TableConstraints String
Tabconst.constraintName' forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat KeyColumnUsage
key forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi KeyColumnUsage String
Keycoluse.constraintName'

            (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 TableConstraints
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi TableConstraints String
Tabconst.tableSchema' 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 TableConstraints
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi TableConstraints String
Tabconst.tableName'   forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String
ph)
            forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat TableConstraints
cons forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi TableConstraints String
Tabconst.constraintType' 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
"PRIMARY KEY"

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

            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 KeyColumnUsage
key forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi KeyColumnUsage String
Keycoluse.columnName')