khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2025-01-08 14:26:33 +03:00
Code Issues Projects Releases Wiki Activity

relational-query-HDBC: apply default generic instances

Browse Source
This commit is contained in:
Kei Hibino 2017-03-31 15:33:54 +09:00
parent 083c41fae7
commit b3eaa9d343
1 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
relational-query-HDBC/src/Database/HDBC/Query/TH.hs
View File

@ -37,6 +37,7 @@ import Language.Haskell.TH (Q, runIO, Name, TypeQ, Dec)
import Language.Haskell.TH.Name.CamelCase (varCamelcaseName)
import Language.Haskell.TH.Lib.Extra (reportWarning, reportError)
import Database.Record (ToSql, FromSql)
import Database.Record.TH (makeRecordPersistableWithSqlTypeDefault)
import qualified Database.Record.TH as Record
import Database.Relational.Query (Relation, Config, verboseAsCompilerWarning, defaultConfig, relationalQuerySQL)
@ -55,10 +56,10 @@ makeRecordPersistableDefault :: Name -- ^ Type constructor name
-> Q [Dec] -- ^ Result declaration
makeRecordPersistableDefault recTypeName = do
rr <- Relational.makeRelationalRecordDefault recTypeName
(pair, (_mayNs, cts)) <- Record.reifyRecordType recTypeName
let width = length cts
ps <- Record.makeRecordPersistableWithSqlType [t| SqlValue |]
(Record.persistableFunctionNamesDefault recTypeName) pair width
(pair@(typeCon, _), _) <- Record.reifyRecordType recTypeName
ps <- [d| instance FromSql SqlValue $typeCon
instance ToSql SqlValue $typeCon
|]
return $ rr ++ ps
-- | Generate all HDBC templates about table except for constraint keys using default naming rule.