Last active
January 9, 2019 22:07
-
-
Save sabine/728879a3fd23852c9c2c443818d16e3f to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
newtype Created = Created UTCTime | |
deriving (Show, Read, Eq, Generic, PersistField, PersistFieldSql, Ord) | |
instance FromJSON Created | |
instance ToJSON Created | |
newtype Updated = Updated UTCTime | |
deriving (Show, Read, Eq, Generic, PersistField, PersistFieldSql) | |
instance FromJSON Updated | |
instance ToJSON Updated | |
newtype Deleted = Deleted Bool | |
deriving (Show, Read, Eq, Generic, PersistField, PersistFieldSql) | |
instance FromJSON Deleted | |
instance ToJSON Deleted | |
addHistoryDefs :: [EntityDef] -> [EntityDef] | |
addHistoryDefs (e:es) = case "history" `elem` (entityAttrs e) of | |
True -> eWithHistory : historyModelForE : addHistoryDefs es | |
False -> e : addHistoryDefs es | |
where | |
eWithHistory = e { entityFields = entityFields e ++ [ | |
FieldDef | |
(HaskellName "created") | |
(DBName "created") | |
(FTTypeCon Nothing "Created") | |
SqlDayTime | |
[] | |
True | |
NoReference | |
, FieldDef | |
(HaskellName "createdBy") | |
(DBName "created_by") | |
(FTTypeCon Nothing "UserUUID") | |
SqlInt64 | |
[] | |
True | |
(ForeignRef (HaskellName "DbUser") (FTTypeCon Nothing "UserUUID")) | |
, FieldDef | |
(HaskellName "updated") | |
(DBName "updated") | |
(FTTypeCon Nothing "Updated") | |
SqlDayTime | |
[] | |
True | |
NoReference | |
, FieldDef | |
(HaskellName "updatedBy") | |
(DBName "updated_by") | |
(FTTypeCon Nothing "UserUUID") | |
SqlString | |
[] | |
True | |
(ForeignRef (HaskellName "DbUser") (FTTypeCon Nothing "UserUUID")) | |
, FieldDef | |
(HaskellName "deleted") | |
(DBName "deleted") | |
(FTTypeCon Nothing "Deleted") | |
SqlBool | |
[] | |
True | |
NoReference | |
]} | |
historyModelForE = EntityDef | |
(HaskellName $ historyEntityName) | |
(DBName $ unDBName (entityDB e) <> "_history") | |
(FieldDef | |
(HaskellName "Id") | |
(DBName "id") | |
(FTTypeCon Nothing $ historyEntityName <> "Id") | |
(SqlOther "Composite Reference") | |
[] | |
True | |
(CompositeRef | |
(CompositeDef [ | |
FieldDef | |
(HaskellName $ "modelFk") | |
(DBName "model_fk") | |
(FTTypeCon Nothing (unHaskellName (entityHaskell e) <> "Id")) | |
(SqlOther "SqlType unset for modelFk") | |
[] | |
True | |
NoReference | |
, FieldDef | |
(HaskellName "created") | |
(DBName "created") | |
(FTTypeCon Nothing "Created") | |
(SqlOther "SqlType unset for created") | |
[] | |
True | |
NoReference | |
] | |
[]) | |
) | |
) | |
[] | |
([ | |
FieldDef | |
(HaskellName $ "modelFk") | |
(DBName "model_fk") | |
(FTTypeCon Nothing (unHaskellName (entityHaskell e) <> "Id")) | |
SqlInt64 | |
[] | |
True | |
(ForeignRef | |
(entityHaskell e) | |
(FTTypeCon (Just "Data.Int") "Int64"))] | |
++ entityFields e | |
++ [FieldDef | |
(HaskellName "created") | |
(DBName "created") | |
(FTTypeCon Nothing "Created") | |
SqlDayTime | |
[] | |
True | |
NoReference | |
, FieldDef | |
(HaskellName "createdBy") | |
(DBName "created_by") | |
(FTTypeCon Nothing "UserUUID") | |
SqlInt64 | |
[] | |
True | |
(ForeignRef (HaskellName "DbUser") (FTTypeCon Nothing "UserUUID")) | |
]) | |
[] | |
[] | |
[] | |
mempty | |
False | |
historyEntityName = unHaskellName (entityHaskell e) <> "History" | |
addHistoryDefs [] = [] | |
--mkHistoryDec :: [EntityDef] -> Q [Dec] | |
--mkHistoryDec (e:es) = | |
--mkHistoryDec [] = [] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Creating a history table for any model annotated with "
history
".I'm a little surprised that persistent automatically changes the field types of
createdBy
andupdatedBy
to match my User model's primary key, instead of complaining about wrong types, but this is a pleasant surprise.