PersistentHistory.hs

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 [] = []

Creating a history table for any model annotated with "history".

I'm a little surprised that persistent automatically changes the field types of createdBy and updatedBy to match my User model's primary key, instead of complaining about wrong types, but this is a pleasant surprise.