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

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

@@ -7,17 +7,24 @@ module Database.Record.TH (
   defineHasNotNullKeyInstance,
   defineHasPrimaryKeyInstance,
   defineHasPrimaryKeyInstanceDefault,
-  defineHasNotNullKeyInstanceDefault
+  defineHasNotNullKeyInstanceDefault,
+
+  derivingEq, derivingShow, derivingRead, derivingData, derivingTypable,
+
+  defineRecordType
   ) where
 
 import Language.Haskell.TH.Name.CamelCase
-  (ConName, conCamelcaseName, toTypeCon)
+  (ConName(conName), VarName(varName), conCamelcaseName, toTypeCon)
 import Language.Haskell.TH.Name.Extra (integralE)
-import Language.Haskell.TH (Q, TypeQ, Dec)
+import Language.Haskell.TH
+  (Q, TypeQ, Dec, DecQ, dataD,
+   recC, cxt, varStrictType, strictType, isStrict)
 
 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
@@ -44,3 +51,20 @@ defineHasPrimaryKeyInstanceDefault =
 defineHasNotNullKeyInstanceDefault :: String -> Int -> Q [Dec]
 defineHasNotNullKeyInstanceDefault =
   defineHasNotNullKeyInstance . recordTypeDefault
+
+derivingEq   = conCamelcaseName "Eq"
+derivingShow = conCamelcaseName "Show"
+derivingRead = conCamelcaseName "Read"
+derivingData = conCamelcaseName "Data"
+derivingTypable = conCamelcaseName "Typable"
+derivingEq, derivingShow, derivingRead, derivingData, derivingTypable :: ConName
+
+defineRecordType :: ConName            -- ^ Name of the data type of table record type.
+                 -> [(VarName, TypeQ)] -- ^ List of fields in the table. Must be legal, properly cased record fields.
+                 -> [ConName]          -- ^ Deriving type class names.
+                 -> DecQ               -- ^ The data type record declaration.
+defineRecordType typeName' fields derives = do
+  let typeName = conName typeName'
+  dataD (cxt []) typeName [] [recC typeName (map fld fields)] (map conName derives)
+  where
+    fld (n, tq) = varStrictType (varName n) (strictType isStrict tq)

schema-th/src/Database/HDBC/Schema/IBMDB2.hs

@@ -28,11 +28,11 @@ import qualified Language.Haskell.TH.Name.Extra as TH
 import Database.HDBC (IConnection)
 
 import Database.HDBC.SqlValueExtra ()
-import Database.HDBC.TH (derivingShow)
 import qualified Database.HDBC.TH as Base
 import Database.Relational.Query.Type (unsafeTypedQuery)
 import Database.Relational.Query (Query)
 import Database.HDBC.Record.Query (runQuery', listToUnique)
+import Database.Record.TH (derivingShow)
 import Language.SQL.Keyword (Keyword(..))
 import qualified Language.SQL.Keyword as SQL
 

schema-th/src/Database/HDBC/Schema/PgCatalog/PgAttribute.hs

@@ -12,8 +12,8 @@
 module Database.HDBC.Schema.PgCatalog.PgAttribute where
 
 import Data.Int (Int16, Int32)
+import Database.Record.TH (derivingShow)
 import Database.HDBC.SqlValueExtra ()
-import Database.HDBC.TH (derivingShow)
 import qualified Database.HDBC.TH as Base
 
 $(Base.defineRecordDefault

schema-th/src/Database/HDBC/Schema/PgCatalog/PgType.hs

@@ -12,8 +12,8 @@
 module Database.HDBC.Schema.PgCatalog.PgType where
 
 import Data.Int (Int16, Int32)
+import Database.Record.TH (derivingShow)
 import Database.HDBC.SqlValueExtra ()
-import Database.HDBC.TH (derivingShow)
 import qualified Database.HDBC.TH as Base
 
 $(Base.defineRecordDefault

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

@@ -17,9 +17,6 @@
 module Database.HDBC.TH (
   fieldInfo,
 
-  derivingEq, derivingShow, derivingRead, derivingData, derivingTypable,
-
-  defineRecordType,
   defineRecordConstructFunction,
   definePersistableInstance,
   defineRecordDecomposeFunction,
@@ -49,20 +46,19 @@ import Database.HDBC (IConnection, SqlValue, fromSql, toSql)
 
 import Language.Haskell.TH.Name.CamelCase
   (ConName (conName), VarName (varName),
-   conCamelcaseName, varCamelcaseName,
+   varCamelcaseName,
    varNameWithPrefix,
    toTypeCon)
 import Language.Haskell.TH.Name.Extra
   (integralE, simpleValD, compileError)
 import Language.Haskell.TH
   (Q, mkName, runIO,
-   TypeQ, DecQ, Dec,
+   TypeQ, Dec,
    appsE, conE, varE, listE, stringE,
    listP, varP, wildP,
    conT,
-   dataD, sigD, funD, valD,
-   clause, normalB,
-   recC, cxt, varStrictType, strictType, isStrict)
+   sigD, funD, valD,
+   clause, normalB)
 
 import Database.HDBC.Session (withConnectionIO)
 import Database.Record.Persistable
@@ -70,7 +66,8 @@ import Database.Record.Persistable
    persistableRecordWidth, PersistableWidth, persistableWidth)
 import Database.Record.TH
   (recordTypeNameDefault, recordTypeDefault,
-   defineHasPrimaryKeyInstanceDefault, defineHasNotNullKeyInstanceDefault)
+   defineHasPrimaryKeyInstanceDefault, defineHasNotNullKeyInstanceDefault,
+   defineRecordType)
 import Database.Record.FromSql (FromSql(recordFromSql), recordFromSql')
 import Database.Record.ToSql (ToSql(recordToSql), recordToSql')
 import Database.Relational.Query.Type (unsafeTypedQuery)
@@ -92,26 +89,9 @@ fieldInfo :: String
 fieldInfo n t = ((varCamelcaseName n, t), n)
 
 
-derivingEq   = conCamelcaseName "Eq"
-derivingShow = conCamelcaseName "Show"
-derivingRead = conCamelcaseName "Read"
-derivingData = conCamelcaseName "Data"
-derivingTypable = conCamelcaseName "Typable"
-derivingEq, derivingShow, derivingRead, derivingData, derivingTypable :: ConName
-
 mayDeclare :: (a -> Q [Dec]) -> Maybe a -> Q [Dec]
 mayDeclare =  maybe (return [])
 
-defineRecordType :: ConName            -- ^ Name of the data type of table record type.
-                 -> [(VarName, TypeQ)] -- ^ List of fields in the table. Must be legal, properly cased record fields.
-                 -> [ConName]          -- ^ Deriving type class names.
-                 -> DecQ               -- ^ The data type record declaration.
-defineRecordType typeName' fields derives = do
-  let typeName = conName typeName'
-  dataD (cxt []) typeName [] [recC typeName (map fld fields)] (map conName derives)
-  where
-    fld (n, tq) = varStrictType (varName n) (strictType isStrict tq)
-
 defineRecordConstructFunction :: VarName   -- ^ Name of record construct function.
                               -> ConName   -- ^ Name of record type.
                               -> Int       -- ^ Count of record fields.