khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2024-11-29 14:45:51 +03:00
Code Issues Projects Releases Wiki Activity

Export template of record width expression.

Browse Source
This commit is contained in:
Kei Hibino 2014-09-19 18:12:57 +09:00
parent 68f19720d8
commit 217f64c21d
1 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
persistable-record/src/Database/Record/TH.hs
View File

@ -41,6 +41,8 @@ module Database.Record.TH (
makeRecordPersistableWithSqlTypeDefaultFromDefined,
definePersistableWidthInstance,
recordWidthTemplate,
defineRecordParser,
defineRecordPrinter,
@ -173,16 +175,21 @@ derivingData = conCamelcaseName "Data"
derivingTypable :: ConName
derivingTypable = conCamelcaseName "Typable"
-- | Record type width expression template.
recordWidthTemplate :: TypeQ -- ^ Record type constructor.
-> ExpQ -- ^ Expression to get record width.
recordWidthTemplate ty =
[| runPersistableRecordWidth
$(sigE [| persistableWidth |] [t| PersistableRecordWidth $(ty) |])
|]
-- | 'PersistableWidth' instance declaration.
definePersistableWidthInstance :: TypeQ -- ^ Record type constructor.
-> [TypeQ] -- ^ Types of record columns.
-> Q [Dec] -- ^ Declaration of 'PersistableWidth' instance.
definePersistableWidthInstance typeCon tys = do
let wdt ty = [| runPersistableRecordWidth
$(sigE [| persistableWidth |] [t| PersistableRecordWidth $(ty) |])
|]
[d| instance PersistableWidth $typeCon where
persistableWidth = unsafePersistableRecordWidth $ foldl' (+) 0 $(listE $ map wdt tys)
persistableWidth = unsafePersistableRecordWidth $ foldl' (+) 0 $(listE $ map recordWidthTemplate tys)
|]
-- | Record type declaration template.