Move TH functions which is independent of HDBC from HDBC-schema-th info DB-record.

DB-record/DB-record.cabal

@@ -19,6 +19,9 @@ library
                         Database.Record.ToSql
                         Database.Record.Persistable
                         Database.Record.KeyConstraint
+                        Database.Record.TH
 
   build-depends:          base <5
+                        , template-haskell
+                        , names-th
   hs-source-dirs:       src

DB-record/src/Database/Record/TH.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Database.Record.TH (
+  recordTypeNameDefault, recordTypeDefault,
+  defineHasNotNullKeyInstance,
+  defineHasPrimaryKeyInstance,
+  defineHasPrimaryKeyInstanceDefault,
+  defineHasNotNullKeyInstanceDefault
+  ) where
+
+import Language.Haskell.TH.Name.CamelCase
+  (ConName, conCamelcaseName, toTypeCon)
+import Language.Haskell.TH.Name.Extra (integralE)
+import Language.Haskell.TH (Q, TypeQ, Dec)
+
+import Database.Record.KeyConstraint
+  (HasKeyConstraint(constraintKey), specifyKeyConstraint, Primary, NotNull)
+
+defineHasKeyConstraintInstance :: TypeQ -> TypeQ -> Int -> Q [Dec]
+defineHasKeyConstraintInstance constraint typeCon index =
+  [d| instance HasKeyConstraint $constraint $typeCon where
+        constraintKey = specifyKeyConstraint $(integralE index) |]
+
+recordTypeNameDefault :: String -> ConName
+recordTypeNameDefault =  conCamelcaseName
+
+recordTypeDefault :: String -> TypeQ
+recordTypeDefault =  toTypeCon . recordTypeNameDefault
+
+defineHasNotNullKeyInstance :: TypeQ -> Int -> Q [Dec]
+defineHasNotNullKeyInstance =
+  defineHasKeyConstraintInstance [t| NotNull |]
+
+defineHasPrimaryKeyInstance :: TypeQ -> Int -> Q [Dec]
+defineHasPrimaryKeyInstance =
+  defineHasKeyConstraintInstance [t| Primary |]
+
+defineHasPrimaryKeyInstanceDefault :: String -> Int -> Q [Dec]
+defineHasPrimaryKeyInstanceDefault =
+  defineHasPrimaryKeyInstance . recordTypeDefault
+
+defineHasNotNullKeyInstanceDefault :: String -> Int -> Q [Dec]
+defineHasNotNullKeyInstanceDefault =
+  defineHasNotNullKeyInstance . recordTypeDefault

schema-th/src/Database/HDBC/TH.hs

@@ -68,8 +68,9 @@ import Database.HDBC.Session (withConnectionIO)
 import Database.Record.Persistable
   (persistableRecord, Persistable, persistable,
    persistableRecordWidth, PersistableWidth, persistableWidth)
-import Database.Record.KeyConstraint
-  (HasKeyConstraint(constraintKey), specifyKeyConstraint, Primary, NotNull)
+import Database.Record.TH
+  (recordTypeNameDefault, recordTypeDefault,
+   defineHasPrimaryKeyInstanceDefault, defineHasNotNullKeyInstanceDefault)
 import Database.Record.FromSql (FromSql(recordFromSql), recordFromSql')
 import Database.Record.ToSql (ToSql(recordToSql), recordToSql')
 import Database.Relational.Query.Type (unsafeTypedQuery)
@@ -84,12 +85,6 @@ import Database.HDBC.Schema.Driver (Driver, getFields, getPrimaryKey)
 nameOfTableSQL :: String -> String -> String
 nameOfTableSQL schema table = map toUpper schema ++ '.' : map toLower table
 
-recordTypeNameDefault :: String -> ConName
-recordTypeNameDefault =  conCamelcaseName
-
-recordTypeDefault :: String -> TypeQ
-recordTypeDefault =  toTypeCon . recordTypeNameDefault
-
 
 fieldInfo :: String
           -> TypeQ
@@ -188,19 +183,6 @@ definePersistableInstance widthVar' typeCon consFunName' decompFunName' width =
         recordToSql = recordToSql'
     |]
 
-defineHasKeyConstraintInstance :: TypeQ -> TypeQ -> Int -> Q [Dec]
-defineHasKeyConstraintInstance constraint typeCon index =
-  [d| instance HasKeyConstraint $constraint $typeCon where
-        constraintKey = specifyKeyConstraint $(integralE index) |]
-
-defineHasNotNullKeyInstance :: TypeQ -> Int -> Q [Dec]
-defineHasNotNullKeyInstance =
-  defineHasKeyConstraintInstance [t| NotNull |]
-
-defineHasPrimaryKeyInstance :: TypeQ -> Int -> Q [Dec]
-defineHasPrimaryKeyInstance =
-  defineHasKeyConstraintInstance [t| Primary |]
-
 defineRecordDecomposeFunction :: VarName   -- ^ Name of record decompose function.
                               -> TypeQ     -- ^ Name of record type.
                               -> [VarName] -- ^ List of field names of record.
@@ -256,15 +238,6 @@ defineRecordDefault schema table fields drives = do
     fields'
     drives
 
-defineHasPrimaryKeyInstanceDefault :: String -> Int -> Q [Dec]
-defineHasPrimaryKeyInstanceDefault =
-  defineHasPrimaryKeyInstance . recordTypeDefault
-
-defineHasNotNullKeyInstanceDefault :: String -> Int -> Q [Dec]
-defineHasNotNullKeyInstanceDefault =
-  defineHasNotNullKeyInstance . recordTypeDefault
-
-
 defineConstantSql :: VarName -> String -> Q [Dec]
 defineConstantSql name' sqlStr = do
   let name = varName name'