{-# LANGUAGE BangPatterns #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} module Snap.Snaplet.ActionLog.Types ( ActionLog (..) , ActionType (..) , actionToInt , intToAction , module Snap.Snaplet.ActionLog.Types ) where ------------------------------------------------------------------------------ import Blaze.ByteString.Builder import Data.ByteString (ByteString) import Data.Int import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding import Data.Time import Data.Word import Database.Persist import Database.Persist.Quasi import Database.Persist.TH import Heist.Compiled import qualified Heist.Interpreted as I import Snap.Restful import Snap.Restful.TH import Snap.Snaplet.Persistent ------------------------------------------------------------------------------ import Snap.Snaplet.ActionLog.InternalTypes ------------------------------------------------------------------------------- ------------------------------------------------------------------------------ -- | The list of entity definitions this snaplet exposes. You need them so -- that you can append to your application's list of entity definitions and -- perform the migration in one block. -- -- Here's an example of how to combine your app's own entity definitions and -- the action log's in one migration block: -- -- > share [mkMigrate "migrateAll"] $ -- > actionLogEntityDefs ++ -- > $(persistFileWith lowerCaseSettings "schema.txt") actionLogEntityDefs :: [EntityDef SqlType] actionLogEntityDefs = $(persistFileWith lowerCaseSettings "schema.txt") share [mkPersist sqlSettings, mkMigrate "migrateActionLog"] $(persistFileWith lowerCaseSettings "schema.txt") loggedActionCSplices :: [(Text, Entity LoggedAction -> Builder)] loggedActionCSplices = mapSnd (. entityVal) $(cSplices ''LoggedAction) loggedActionISplices :: Monad m => LoggedAction -> [(Text, I.Splice m)] loggedActionISplices = $(iSplices ''LoggedAction) detailsCSplices :: [(Text, Entity LoggedActionDetails -> Builder)] detailsCSplices = mapSnd (. entityVal) $(cSplices ''LoggedActionDetails) detailsISplices :: Monad m => LoggedActionDetails -> [(Text, I.Splice m)] detailsISplices = $(iSplices ''LoggedActionDetails) instance PrimSplice LoggedActionId where iPrimSplice = iPrimShow . mkInt cPrimSplice = cPrimShow . mkInt ------------------------------------------------------------------------------ -- | Type class that must be implemented to have an action log. You do not -- have to have any custom splices. If you don't need to add splices to what -- the snaplet provides by default, just have the custom splice functions -- return an empty list. -- -- One potential use for the custom splices might be if you want to display -- your own custom information in action log lists. Maybe you want to display -- a user email address in addition to their name, or maybe instead of -- displaying raw entity IDs you want to do some DB query to get a different -- field for display. The custom splices allow you to make any runtime -- function of a LoggedAction into a splice that can be displayed in action -- log templates. class (HasPersistPool m) => HasActionLog m where -- | Gets a tenant ID for the current user of your application. If your -- application is not multi-tenanted, then you can just return a constant -- here. alGetTenantId :: m Int -- | Gets the current user's user ID. Again, if your application does not -- have the concept of a user, you can return a constant. alGetAuthUserId :: m Int -- | In latency sensitive applications where time stamps are used -- frequently, you may want to do the system call once and then cache the -- results. This function allows you to provide your own cache-aware -- version of getTime if you choose. Otherwise you can just lift the -- getCurrentTime function from Data.Time.Clock into your monad. alGetTime :: m UTCTime -- | Function that takes a user ID and returns the user's name, email, or -- whatever you want the snaplet to call that user. This function is used -- to generate the user dropdown box in action log filter controls. alGetName :: Int -> m Text -- | Complied version of any custom splices that you want to be available -- inside the @actionLogListing@ splice. alCustomCSplices :: [(Text, Promise (Entity LoggedAction) -> Splice m)] -- | Interpreted version of any custom splices that you want to be -- available inside the @actionLogListing@ splice. alCustomISplices :: Entity LoggedAction -> [(Text, I.Splice m)] ------------------------------------------------------------------------------ -- | To store deltas, you need to be able to get Text representations of each -- field. class DeltaField a where toBS :: a -> ByteString instance DeltaField ByteString where toBS = id instance DeltaField Text where toBS = encodeUtf8 instance DeltaField String where toBS = toBS . T.pack instance DeltaField Bool where toBS = toBS . show instance DeltaField Int where toBS = toBS . show instance DeltaField Int8 where toBS = toBS . show instance DeltaField Int16 where toBS = toBS . show instance DeltaField Int32 where toBS = toBS . show instance DeltaField Int64 where toBS = toBS . show instance DeltaField Integer where toBS = toBS . show instance DeltaField Float where toBS = toBS . show instance DeltaField Double where toBS = toBS . show instance DeltaField Word where toBS = toBS . show instance DeltaField Word8 where toBS = toBS . show instance DeltaField Word16 where toBS = toBS . show instance DeltaField Word32 where toBS = toBS . show instance DeltaField Word64 where toBS = toBS . show instance DeltaField a => DeltaField (Maybe a) where toBS Nothing = "Nothing" toBS (Just a) = toBS a instance (b ~ PersistEntityBackend e) => DeltaField (KeyBackend b e) where toBS = toBS . mkInt class CanDelta a where deltaFields :: [(Text, a -> ByteString)] ------------------------------------------------------------------------------ -- | Calculates a list of fields that changed along with ByteString -- representations of their old and new values. getDeltas :: (CanDelta a) => a -> a -> [(Text, ByteString, ByteString)] getDeltas old new = do func [] deltaFields where func !acc [] = acc func !acc ((name, f):fs) = if oldField == newField then func acc fs else func ((name, oldField, newField):acc) fs where oldField = f old newField = f new