mirror of
https://github.com/khibino/haskell-relational-record.git
synced 2024-11-29 14:45:51 +03:00
Extend signatures of model templates.
This commit is contained in:
Kei Hibino
parent
bd2455f171
commit
de6c93ee12
@ -94,15 +94,17 @@ import qualified Database.Record.Persistable as Persistable
|
||||
|
||||
|
||||
-- | Generate default name of record type constructor from SQL table name 'String'
|
||||
recordTypeNameDefault :: String -- ^ Table name in SQL
|
||||
recordTypeNameDefault :: String -- ^ Schema name in SQL
|
||||
-> String -- ^ Table name in SQL
|
||||
-> ConName -- ^ Result name
|
||||
recordTypeNameDefault = conCamelcaseName
|
||||
recordTypeNameDefault _scm = conCamelcaseName
|
||||
|
||||
-- | Record type constructor template from SQL table name 'String'.
|
||||
-- Type name is generated by 'recordTypeNameDefault'.
|
||||
recordTypeDefault :: String -- ^ Table name in SQL
|
||||
recordTypeDefault :: String -- ^ Schema name in SQL
|
||||
-> String -- ^ Table name in SQL
|
||||
-> TypeQ -- ^ Result type template
|
||||
recordTypeDefault = toTypeCon . recordTypeNameDefault
|
||||
recordTypeDefault scm = toTypeCon . recordTypeNameDefault scm
|
||||
|
||||
-- | Variable expression of record column offset array.
|
||||
columnOffsetsVarNameDefault :: Name -- ^ Table type name
|
||||
@ -150,19 +152,21 @@ defineHasNotNullKeyInstance =
|
||||
|
||||
-- | Template of 'HasColumnConstraint' 'Primary' instance
|
||||
-- from SQL table name 'String' and key index.
|
||||
defineHasPrimaryKeyInstanceDefault :: String -- ^ Table name
|
||||
defineHasPrimaryKeyInstanceDefault :: String -- ^ Schema name
|
||||
-> String -- ^ Table name
|
||||
-> [Int] -- ^ Key index which specifies this constraint
|
||||
-> Q [Dec] -- ^ Declaration of primary key constraint instance
|
||||
defineHasPrimaryKeyInstanceDefault =
|
||||
defineHasPrimaryKeyInstance . recordTypeDefault
|
||||
defineHasPrimaryKeyInstanceDefault scm =
|
||||
defineHasPrimaryKeyInstance . recordTypeDefault scm
|
||||
|
||||
-- | Template of 'HasColumnConstraint' 'NotNull' instance
|
||||
-- from SQL table name 'String' and key index.
|
||||
defineHasNotNullKeyInstanceDefault :: String -- ^ Table name
|
||||
defineHasNotNullKeyInstanceDefault :: String -- ^ Schema name
|
||||
-> String -- ^ Table name
|
||||
-> Int -- ^ Key index which specifies this constraint
|
||||
-> Q [Dec] -- ^ Declaration of not null key constraint instance
|
||||
defineHasNotNullKeyInstanceDefault =
|
||||
defineHasNotNullKeyInstance . recordTypeDefault
|
||||
defineHasNotNullKeyInstanceDefault scm =
|
||||
defineHasNotNullKeyInstance . recordTypeDefault scm
|
||||
|
||||
{-# DEPRECATED derivingEq "Use TH quasi-quotation like ''Eq instead of this." #-}
|
||||
-- | Name to specify deriving 'Eq'
|
||||
@ -230,10 +234,10 @@ columnDefault n t = (varCamelcaseName n, t)
|
||||
|
||||
-- | Record type declaration template from SQL table name 'String'
|
||||
-- and column name 'String' - type pairs, derivings.
|
||||
defineRecordTypeDefault :: String -> [(String, TypeQ)] -> [Name] -> Q [Dec]
|
||||
defineRecordTypeDefault table columns =
|
||||
defineRecordTypeDefault :: String -> String -> [(String, TypeQ)] -> [Name] -> Q [Dec]
|
||||
defineRecordTypeDefault schema table columns =
|
||||
defineRecordType
|
||||
(recordTypeNameDefault table)
|
||||
(recordTypeNameDefault schema table)
|
||||
[ columnDefault n t | (n, t) <- columns ]
|
||||
|
||||
|
||||
@ -320,14 +324,15 @@ toSqlNameDefault = (`varNameWithPrefix` "toSqlOf")
|
||||
|
||||
-- | All templates depending on SQL value type with default names.
|
||||
makeRecordPersistableWithSqlTypeDefault :: TypeQ -- ^ SQL value type
|
||||
-> String -- ^ Table name of database
|
||||
-> String -- ^ Schema name
|
||||
-> String -- ^ Table name
|
||||
-> Int -- ^ Count of record columns
|
||||
-> Q [Dec] -- ^ Result declarations
|
||||
makeRecordPersistableWithSqlTypeDefault sqlValueType table width = do
|
||||
makeRecordPersistableWithSqlTypeDefault sqlValueType schema table width = do
|
||||
makeRecordPersistableWithSqlType
|
||||
sqlValueType
|
||||
(persistableFunctionNamesDefault . conName . conCamelcaseName $ table)
|
||||
(recordTypeDefault table, toDataCon . recordTypeNameDefault $ table)
|
||||
(recordTypeDefault schema table, toDataCon . recordTypeNameDefault schema $ table)
|
||||
width
|
||||
|
||||
recordInfo' :: Info -> Maybe ((TypeQ, ExpQ), (Maybe [Name], [TypeQ]))
|
||||
@ -387,13 +392,14 @@ defineRecord
|
||||
|
||||
-- | All templates for record type with default names.
|
||||
defineRecordDefault :: TypeQ -- ^ SQL value type
|
||||
-> String -- ^ Schema name
|
||||
-> String -- ^ Table name
|
||||
-> [(String, TypeQ)] -- ^ Column names and types
|
||||
-> [Name] -- ^ Record derivings
|
||||
-> Q [Dec] -- ^ Result declarations
|
||||
defineRecordDefault sqlValueType table columns derives = do
|
||||
typ <- defineRecordTypeDefault table columns derives
|
||||
withSql <- makeRecordPersistableWithSqlTypeDefault sqlValueType table $ length columns
|
||||
defineRecordDefault sqlValueType scm table columns derives = do
|
||||
typ <- defineRecordTypeDefault scm table columns derives
|
||||
withSql <- makeRecordPersistableWithSqlTypeDefault sqlValueType scm table $ length columns
|
||||
return $ typ ++ withSql
|
||||
|
||||
|
||||
|
||||
@ -70,7 +70,7 @@ defineTableDefault' :: Config -- ^ Configuration to generate query wi
|
||||
-> Q [Dec] -- ^ Result declaration
|
||||
defineTableDefault' config schema table columns derives = do
|
||||
modelD <- Relational.defineTableTypesAndRecordDefault config schema table columns derives
|
||||
sqlvD <- makeRecordPersistableWithSqlTypeDefault [t| SqlValue |] table $ length columns
|
||||
sqlvD <- makeRecordPersistableWithSqlTypeDefault [t| SqlValue |] schema table $ length columns
|
||||
return $ modelD ++ sqlvD
|
||||
|
||||
-- | Generate all HDBC templates about table using default naming rule.
|
||||
@ -84,7 +84,7 @@ defineTableDefault :: Config -- ^ Configuration to generate query wit
|
||||
-> Q [Dec] -- ^ Result declaration
|
||||
defineTableDefault config schema table columns derives primary notNull = do
|
||||
modelD <- Relational.defineTableDefault config schema table columns derives primary notNull
|
||||
sqlvD <- makeRecordPersistableWithSqlTypeDefault [t| SqlValue |] table $ length columns
|
||||
sqlvD <- makeRecordPersistableWithSqlTypeDefault [t| SqlValue |] schema table $ length columns
|
||||
return $ modelD ++ sqlvD
|
||||
|
||||
-- | Generate all HDBC templates using system catalog informations with specified config.
|
||||
|
||||
@ -119,12 +119,13 @@ defineHasPrimaryKeyInstance recType colType indexes = do
|
||||
return $ kc ++ ck
|
||||
|
||||
-- | Rule template to infer primary key.
|
||||
defineHasPrimaryKeyInstanceDefault :: String -- ^ Table name
|
||||
defineHasPrimaryKeyInstanceDefault :: String -- ^ Schema name
|
||||
-> String -- ^ Table name
|
||||
-> TypeQ -- ^ Column type
|
||||
-> [Int] -- ^ Primary key index
|
||||
-> Q [Dec] -- ^ Declarations of primary constraint key
|
||||
defineHasPrimaryKeyInstanceDefault =
|
||||
defineHasPrimaryKeyInstance . recordTypeDefault
|
||||
defineHasPrimaryKeyInstanceDefault scm =
|
||||
defineHasPrimaryKeyInstance . recordTypeDefault scm
|
||||
|
||||
-- | Rule template to infer not-null key.
|
||||
defineHasNotNullKeyInstance :: TypeQ -- ^ Record type
|
||||
@ -134,11 +135,12 @@ defineHasNotNullKeyInstance =
|
||||
defineHasColumnConstraintInstance [t| NotNull |]
|
||||
|
||||
-- | Rule template to infer not-null key.
|
||||
defineHasNotNullKeyInstanceDefault :: String -- ^ Table name
|
||||
defineHasNotNullKeyInstanceDefault :: String -- ^ Schema name
|
||||
-> String -- ^ Table name
|
||||
-> Int -- ^ NotNull key index
|
||||
-> Q [Dec] -- ^ Declaration of not-null constraint key
|
||||
defineHasNotNullKeyInstanceDefault =
|
||||
defineHasNotNullKeyInstance . recordTypeDefault
|
||||
defineHasNotNullKeyInstanceDefault scm =
|
||||
defineHasNotNullKeyInstance . recordTypeDefault scm
|
||||
|
||||
|
||||
-- | Column projection path 'Pi' template.
|
||||
@ -271,9 +273,9 @@ defineProductConstructorInstance recTypeQ recData colTypes =
|
||||
|]
|
||||
|
||||
-- | Make template for record 'ProductConstructor' instance using default naming rule.
|
||||
defineProductConstructorInstanceDefault :: String -> [TypeQ] -> Q [Dec]
|
||||
defineProductConstructorInstanceDefault table colTypes = do
|
||||
let typeName = recordTypeNameDefault table
|
||||
defineProductConstructorInstanceDefault :: String -> String -> [TypeQ] -> Q [Dec]
|
||||
defineProductConstructorInstanceDefault schema table colTypes = do
|
||||
let typeName = recordTypeNameDefault schema table
|
||||
defineProductConstructorInstance
|
||||
(toTypeCon typeName)
|
||||
(toDataCon typeName)
|
||||
@ -291,10 +293,10 @@ defineTableTypesDefault config schema table columns = do
|
||||
(relationVarNameDefault table)
|
||||
(table `varNameWithPrefix` "insert")
|
||||
(table `varNameWithPrefix` "insertQuery")
|
||||
(recordTypeDefault table)
|
||||
(recordTypeDefault schema table)
|
||||
(tableSQL (normalizedTableName config) schema table)
|
||||
(map (fst . fst) columns)
|
||||
colsDs <- defineColumnsDefault (recordTypeNameDefault table) columns
|
||||
colsDs <- defineColumnsDefault (recordTypeNameDefault schema table) columns
|
||||
return $ tableDs ++ colsDs
|
||||
|
||||
-- | Make templates about table, column and haskell record using default naming rule.
|
||||
@ -305,8 +307,8 @@ defineTableTypesAndRecordDefault :: Config -- ^ Configuration to gene
|
||||
-> [Name] -- ^ Record derivings
|
||||
-> Q [Dec] -- ^ Result declarations
|
||||
defineTableTypesAndRecordDefault config schema table columns derives = do
|
||||
recD <- defineRecordTypeDefault table columns derives
|
||||
rconD <- defineProductConstructorInstanceDefault table [t | (_, t) <- columns]
|
||||
recD <- defineRecordTypeDefault schema table columns derives
|
||||
rconD <- defineProductConstructorInstanceDefault schema table [t | (_, t) <- columns]
|
||||
tableDs <- defineTableTypesDefault config schema table [(c, Nothing) | c <- columns ]
|
||||
return $ recD ++ rconD ++ tableDs
|
||||
|
||||
@ -362,20 +364,21 @@ defineSqlsWithPrimaryKeyDefault table =
|
||||
upd = table `varNameWithPrefix` "update"
|
||||
|
||||
-- | All templates about primary key.
|
||||
defineWithPrimaryKeyDefault :: String -- ^ Table name string
|
||||
defineWithPrimaryKeyDefault :: String -- ^ Schema name
|
||||
-> String -- ^ Table name string
|
||||
-> TypeQ -- ^ Type of primary key
|
||||
-> [Int] -- ^ Indexes specifies primary key
|
||||
-> Q [Dec] -- ^ Result declarations
|
||||
defineWithPrimaryKeyDefault table keyType ixs = do
|
||||
instD <- defineHasPrimaryKeyInstanceDefault table keyType ixs
|
||||
let recType = recordTypeDefault table
|
||||
defineWithPrimaryKeyDefault schema table keyType ixs = do
|
||||
instD <- defineHasPrimaryKeyInstanceDefault schema table keyType ixs
|
||||
let recType = recordTypeDefault schema table
|
||||
tableE = tableVarExpDefault table
|
||||
relE = relationVarExpDefault table
|
||||
sqlsD <- defineSqlsWithPrimaryKeyDefault table keyType recType relE tableE
|
||||
return $ instD ++ sqlsD
|
||||
|
||||
-- | All templates about not-null key.
|
||||
defineWithNotNullKeyDefault :: String -> Int -> Q [Dec]
|
||||
defineWithNotNullKeyDefault :: String -> String -> Int -> Q [Dec]
|
||||
defineWithNotNullKeyDefault = defineHasNotNullKeyInstanceDefault
|
||||
|
||||
-- | Generate all templtes about table using default naming rule.
|
||||
@ -393,8 +396,8 @@ defineTableDefault config schema table columns derives primaryIxs mayNotNullIdx
|
||||
keyType = foldl1' pairT . map (snd . (columns !!)) $ primaryIxs
|
||||
primD <- case primaryIxs of
|
||||
[] -> return []
|
||||
ixs -> defineWithPrimaryKeyDefault table keyType ixs
|
||||
nnD <- maybeD (\i -> defineWithNotNullKeyDefault table i) mayNotNullIdx
|
||||
ixs -> defineWithPrimaryKeyDefault schema table keyType ixs
|
||||
nnD <- maybeD (\i -> defineWithNotNullKeyDefault schema table i) mayNotNullIdx
|
||||
return $ tblD ++ primD ++ nnD
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user