-- |
-- Module      : Database.Relational.Internal.Config
-- Copyright   : 2017-2019 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines configuration datatype used in query products.
module Database.Relational.Internal.Config (
  Config,

  defaultConfig,

  {- field labels of 'Config' type.
     To avoid haddock bug ( https://github.com/haskell/haddock/issues/456 ),
     they are not listed in Config ( ... ). -}
  productUnitSupport,
  chunksInsertSize,
  schemaNameMode,
  normalizedTableName,
  addQueryTableAliasAS,
  addModifyTableAliasAS,
  enableWarning,
  verboseAsCompilerWarning,
  disableOverloadedProjection,
  disableSpecializedProjection,
  identifierQuotation,
  nameConfig,

  NameConfig,
  defaultNameConfig,

  {- field labels of 'NameConfig' type.
     To avoid haddock bug ( https://github.com/haskell/haddock/issues/456 ),
     they are not listed in NameConfig ( ... ). -}
  recordConfig,
  relationVarName,

  ProductUnitSupport (..), SchemaNameMode (..), IdentifierQuotation (..),
  ) where

import Language.Haskell.TH.Name.CamelCase (VarName, varCamelcaseName)
import qualified Database.Record.TH as RecordTH


-- | 'NameConfig' type to customize names of expanded templates.
data NameConfig =
  NameConfig
  { NameConfig -> NameConfig
recordConfig       ::  RecordTH.NameConfig
  -- ^ Configurations related to the names of generated record types
  --   and their field labels.
  , NameConfig -> String -> String -> VarName
relationVarName    ::  String -> String -> VarName
  -- ^ Function to build the name of 'Database.Relational.Monad.BaseType.Relation' representing the table.
  --   The first argument is the scheme name, and second argument is the table name.
  }

instance Show NameConfig where
  show :: NameConfig -> String
show = String -> NameConfig -> String
forall a b. a -> b -> a
const String
"<NameConfig>"

-- | Default implementation of 'NameConfig' type.
defaultNameConfig :: NameConfig
defaultNameConfig :: NameConfig
defaultNameConfig =
  NameConfig :: NameConfig -> (String -> String -> VarName) -> NameConfig
NameConfig
  { recordConfig :: NameConfig
recordConfig    = NameConfig
RecordTH.defaultNameConfig
  , relationVarName :: String -> String -> VarName
relationVarName = (String -> VarName) -> String -> String -> VarName
forall a b. a -> b -> a
const String -> VarName
varCamelcaseName
  }

-- | Unit of product is supported or not.
data ProductUnitSupport = PUSupported | PUNotSupported  deriving Int -> ProductUnitSupport -> ShowS
[ProductUnitSupport] -> ShowS
ProductUnitSupport -> String
(Int -> ProductUnitSupport -> ShowS)
-> (ProductUnitSupport -> String)
-> ([ProductUnitSupport] -> ShowS)
-> Show ProductUnitSupport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProductUnitSupport] -> ShowS
$cshowList :: [ProductUnitSupport] -> ShowS
show :: ProductUnitSupport -> String
$cshow :: ProductUnitSupport -> String
showsPrec :: Int -> ProductUnitSupport -> ShowS
$cshowsPrec :: Int -> ProductUnitSupport -> ShowS
Show

-- | Schema name qualify mode in SQL string.
data SchemaNameMode
  = SchemaQualified     -- ^ Schema qualified table name in SQL string
  | SchemaNotQualified  -- ^ Not qualified table name in SQL string
  deriving (SchemaNameMode -> SchemaNameMode -> Bool
(SchemaNameMode -> SchemaNameMode -> Bool)
-> (SchemaNameMode -> SchemaNameMode -> Bool) -> Eq SchemaNameMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemaNameMode -> SchemaNameMode -> Bool
$c/= :: SchemaNameMode -> SchemaNameMode -> Bool
== :: SchemaNameMode -> SchemaNameMode -> Bool
$c== :: SchemaNameMode -> SchemaNameMode -> Bool
Eq, Int -> SchemaNameMode -> ShowS
[SchemaNameMode] -> ShowS
SchemaNameMode -> String
(Int -> SchemaNameMode -> ShowS)
-> (SchemaNameMode -> String)
-> ([SchemaNameMode] -> ShowS)
-> Show SchemaNameMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaNameMode] -> ShowS
$cshowList :: [SchemaNameMode] -> ShowS
show :: SchemaNameMode -> String
$cshow :: SchemaNameMode -> String
showsPrec :: Int -> SchemaNameMode -> ShowS
$cshowsPrec :: Int -> SchemaNameMode -> ShowS
Show)

-- | Configuration for quotation of identifiers of SQL.
data IdentifierQuotation = NoQuotation | Quotation Char deriving Int -> IdentifierQuotation -> ShowS
[IdentifierQuotation] -> ShowS
IdentifierQuotation -> String
(Int -> IdentifierQuotation -> ShowS)
-> (IdentifierQuotation -> String)
-> ([IdentifierQuotation] -> ShowS)
-> Show IdentifierQuotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdentifierQuotation] -> ShowS
$cshowList :: [IdentifierQuotation] -> ShowS
show :: IdentifierQuotation -> String
$cshow :: IdentifierQuotation -> String
showsPrec :: Int -> IdentifierQuotation -> ShowS
$cshowsPrec :: Int -> IdentifierQuotation -> ShowS
Show

-- | Configuration type.
data Config =
  Config
  { Config -> ProductUnitSupport
productUnitSupport           ::  !ProductUnitSupport
  -- ^ No FROM clause (corresponding the unit of JOIN) is allowed or not.
  , Config -> Int
chunksInsertSize             ::  !Int
  -- ^ Threshold count of placeholders in the insert statement with multi-values.
  , Config -> SchemaNameMode
schemaNameMode               ::  !SchemaNameMode
  -- ^ 'SchemaNameMode' configuration
  , Config -> Bool
normalizedTableName          ::  !Bool
  -- ^ If True, schema names become uppercase, and table names become lowercase.
  , Config -> Bool
addQueryTableAliasAS         ::  !Bool
  -- ^ If True, AS keyword is not skipped but added in table-alias of SELECT statement or correlate SELECT clause.
  , Config -> Bool
addModifyTableAliasAS        ::  !Bool
  -- ^ If True, AS keyword is not skipped but added in target-table-alias of UPDATE and DELETE statement.
  , Config -> Bool
enableWarning                ::  !Bool
  -- ^ If True, print warning messages in macros of relational-record.
  , Config -> Bool
verboseAsCompilerWarning     ::  !Bool
  -- ^ If True, more detailed logs are printed when generating record types from schema.
  , Config -> Bool
disableOverloadedProjection  ::  !Bool
  -- ^ If True, instance of 'Database.Relational.OverloadedProjection.HasProjection' for each column is NOT generated.
  , Config -> Bool
disableSpecializedProjection ::  !Bool
  -- ^ If True, 'Database.Relational.Pi.Pi' for each column is NOT generated.
  , Config -> IdentifierQuotation
identifierQuotation          ::  !IdentifierQuotation
  -- ^ 'IdentifierQuotation' configuration
  , Config -> NameConfig
nameConfig                   ::  !NameConfig
  -- ^ 'NameConfig' configuration
  } deriving Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show

-- | Default configuration of 'Config'.
--   To change some behaviour of relational-query,
--   use record update syntax:
--
-- @
--   defaultConfig
--     { productUnitSupport            =  'PUSupported'
--     , chunksInsertSize              =  256
--     , schemaNameMode                =  'SchemaQualified'
--     , normalizedTableName           =  True
--     , addQueryTableAliasAS          =  False
--     , addModifyTableAliasAS         =  False
--     , enableWarning                 =  True
--     , verboseAsCompilerWarning      =  False
--     , disableOverloadedProjection   =  False
--     , disableSpecializedProjection  =  False
--     , identifierQuotation           =  'NoQuotation'
--     , nameConfig                    =
--        defaultNameConfig
--        { recordConfig     =  'RecordTH.defaultNameConfig'
--        , relationVarName  =  \\schema table -> 'varCamelcaseName' $ table ++ "_" ++ scheme
--        -- ^ append the table name after the schema name. e.g. "schemaTable"
--        }
--     }
-- @
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
  Config :: ProductUnitSupport
-> Int
-> SchemaNameMode
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> IdentifierQuotation
-> NameConfig
-> Config
Config { productUnitSupport :: ProductUnitSupport
productUnitSupport            =  ProductUnitSupport
PUSupported
         , chunksInsertSize :: Int
chunksInsertSize              =  Int
256
         , schemaNameMode :: SchemaNameMode
schemaNameMode                =  SchemaNameMode
SchemaQualified
         , normalizedTableName :: Bool
normalizedTableName           =  Bool
True
         , addQueryTableAliasAS :: Bool
addQueryTableAliasAS          =  Bool
False
         , addModifyTableAliasAS :: Bool
addModifyTableAliasAS         =  Bool
False
         , enableWarning :: Bool
enableWarning                 =  Bool
True
         , verboseAsCompilerWarning :: Bool
verboseAsCompilerWarning      =  Bool
False
         , disableOverloadedProjection :: Bool
disableOverloadedProjection   =  Bool
False
         , disableSpecializedProjection :: Bool
disableSpecializedProjection  =  Bool
False
         , identifierQuotation :: IdentifierQuotation
identifierQuotation           =  IdentifierQuotation
NoQuotation
         , nameConfig :: NameConfig
nameConfig                    =  NameConfig
defaultNameConfig
         }