snaplet-actionlog 0.2.0.1 → 0.3.1
raw patch · 8 files changed
+243/−186 lines, 8 filesdep +lensdep +map-syntaxdep ~blaze-builderdep ~digestive-functorsdep ~digestive-functors-heistnew-uploader
Dependencies added: lens, map-syntax
Dependency ranges changed: blaze-builder, digestive-functors, digestive-functors-heist, digestive-functors-snap, errors, heist, persistent, persistent-postgresql, persistent-template, readable, restful-snap, snap, snap-extras, snaplet-persistent, text, time, transformers
Files
- changelog.md +2/−0
- snaplet-actionlog.cabal +24/−19
- src/Snap/Snaplet/ActionLog.hs +12/−13
- src/Snap/Snaplet/ActionLog/API.hs +45/−31
- src/Snap/Snaplet/ActionLog/Internal/Schema.hs +38/−0
- src/Snap/Snaplet/ActionLog/InternalTypes.hs +1/−1
- src/Snap/Snaplet/ActionLog/Resource.hs +87/−77
- src/Snap/Snaplet/ActionLog/Types.hs +34/−45
+ changelog.md view
@@ -0,0 +1,2 @@+0.3.1+* Broaden deps
snaplet-actionlog.cabal view
@@ -1,5 +1,5 @@ name: snaplet-actionlog-version: 0.2.0.1+version: 0.3.1 synopsis: Generic action log snaplet for the Snap Framework description: This snaplet contains support for logging website actions. Common actions are creating, updating, and deleting records.@@ -12,7 +12,9 @@ homepage: https://github.com/soostone/snaplet-actionlog category: Web, Snap -extra-source-files: LICENSE+extra-source-files:+ LICENSE+ changelog.md data-files: schema.txt@@ -37,28 +39,31 @@ Snap.Snaplet.ActionLog.Resource Snap.Snaplet.ActionLog.Types Snap.Snaplet.ActionLog.InternalTypes+ Snap.Snaplet.ActionLog.Internal.Schema Paths_snaplet_actionlog build-depends: base >= 4 && < 5,- blaze-builder >= 0.3 && < 0.4,+ blaze-builder >= 0.3 && < 0.5, bytestring >= 0.9.1 && < 0.11,- digestive-functors >= 0.6 && < 0.7,- digestive-functors-heist >= 0.7 && < 0.8,- digestive-functors-snap >= 0.6 && < 0.7,- errors >= 1.4.1 && < 1.5,- heist >= 0.12 && < 0.13,- persistent >= 1.2 && < 1.3,- persistent-postgresql >= 1.2 && < 1.3,- persistent-template >= 1.2 && < 1.3,- readable >= 0.1 && < 0.2,- restful-snap >= 0.1 && < 0.2,- snap >= 0.11.3 && < 0.13,- snap-extras >= 0.4 && < 0.7,- snaplet-persistent >= 0.2 && < 0.3,- text >= 0.11 && < 0.12,- time >= 1.1 && < 1.5,- transformers >= 0.3 && < 0.4,+ digestive-functors >= 0.6 && < 0.9,+ digestive-functors-heist >= 0.7 && < 0.9,+ digestive-functors-snap >= 0.6 && < 0.8,+ errors >= 2.0 && < 2.3,+ heist >= 0.14 && < 1.1,+ lens < 5,+ map-syntax,+ persistent >= 2.0 && < 2.8,+ persistent-postgresql >= 2.0 && < 2.7,+ persistent-template >= 2.0 && < 2.6,+ readable >= 0.1 && < 0.4,+ restful-snap >= 0.4 && < 0.5,+ snap >= 0.11.3 && < 1.1,+ snap-extras >= 0.11 && < 1.1,+ snaplet-persistent >= 0.4 && < 0.7,+ text >= 0.11 && < 1.3,+ time >= 1.1 && < 1.9,+ transformers >= 0.3 && < 0.6, unordered-containers >= 0.2 && < 0.3, xmlhtml >= 0.2 && < 0.3
src/Snap/Snaplet/ActionLog.hs view
@@ -41,30 +41,33 @@ -- * Types , actionLogEntityDefs , migrateActionLog- , LoggedActionGeneric(..)- , LoggedAction+ , LoggedAction(..) , LoggedActionId- , LoggedActionDetailsGeneric(..)- , LoggedActionDetails+ , LoggedActionDetails(..) , LoggedActionDetailsId ) where ------------------------------------------------------------------------------+import Control.Lens+import Control.Monad+import qualified Data.Map.Syntax as MS import Data.Monoid import Data.Text.Encoding import Heist-import qualified Heist.Interpreted as I+import qualified Heist.Interpreted as I import Snap import Snap.Restful import Snap.Snaplet.Heist.Compiled ------------------------------------------------------------------------------+import Paths_snaplet_actionlog import Snap.Snaplet.ActionLog.API import Snap.Snaplet.ActionLog.Resource import Snap.Snaplet.ActionLog.Types-import Paths_snaplet_actionlog+------------------------------------------------------------------------------- + ------------------------------------------------------------------------------ -- | Initializer for the action log snaplet. It sets up templates, routes, -- and compiled and interpreted splices.@@ -80,15 +83,11 @@ [(RIndex, indexH), (RShow, showH)] [] [] heist addConfig heist $ mempty- { hcCompiledSplices = actionLogSplices resource- , hcInterpretedSplices = actionLogISplices resource-+ & scCompiledSplices .~ actionLogSplices resource+ & scInterpretedSplices .~ actionLogISplices resource -- Load time splices are for splices that can be used in the apply and -- bind tags.- , hcLoadTimeSplices =- [ ("actionlogTemplate", I.textSplice $ decodeUtf8 url)- ]- }+ & scLoadTimeSplices .~ ("actionlogTemplate" MS.## I.textSplice (decodeUtf8 url)) addTemplates heist "" return ActionLog where
src/Snap/Snaplet/ActionLog/API.hs view
@@ -1,7 +1,9 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} module Snap.Snaplet.ActionLog.API where @@ -15,6 +17,7 @@ import Snap.Snaplet.Persistent ------------------------------------------------------------------------------ import Snap.Snaplet.ActionLog.Types+------------------------------------------------------------------------------- ------------------------------------------------------------------------------@@ -44,42 +47,47 @@ -- one of the other functions like 'loggedInsert'. But when those aren't -- sufficient, this function provides you maximum control to log actions as -- you see fit.-logAction :: HasActionLog m- => Text- -- ^ Entity name. If you are logging database modifications,- -- then this might be the name of the table being operated on.- -> Int- -- ^ Entity ID. This is the primary key for the affected row.- -> ActionType- -- ^ Type of action, such as create, update, or delete.- -> m (Key LoggedAction)-logAction entityName entityId action = do+logAction+ :: HasActionLog m+ => Text+ -- ^ Entity name. If you are logging database modifications,+ -- then this might be the name of the table being operated on.+ -> Int+ -- ^ Entity ID. This is the primary key for the affected row.+ -> ActionType+ -- ^ Type of action, such as create, update, or delete.+ -> m (Key LoggedAction)+logAction entityName eid action = do tid <- alGetTenantId uid <- alGetAuthUserId now <- alGetTime runPersist $ insert $- LoggedAction tid uid entityName entityId action now+ LoggedAction tid uid entityName eid action now ------------------------------------------------------------------------------ -- | Performs a logged insert into the database. Just about everything should -- be inserted using this function instead of @runPersist' . insert@-loggedInsert :: (PersistEntity a, HasActionLog m,- PersistEntityBackend a ~ SqlBackend)- => a -> m (Key a)+loggedInsert+ :: ( PersistEntity a, HasActionLog m, ToBackendKey SqlBackend a+ , PersistEntityBackend a ~ SqlBackend)+ => a+ -> m (Key a) loggedInsert val = do let entityName = getName val recKey <- runPersist $ insert val- let entityId = mkInt recKey- logAction entityName entityId CreateAction+ let eid = mkInt recKey+ logAction entityName eid CreateAction return recKey ------------------------------------------------------------------------------ -- | Performs a logged replace of a database record.-loggedReplace :: (PersistEntity a, CanDelta a, HasActionLog m,- PersistEntityBackend a ~ SqlBackend)- => Key a -> a -> m ()+loggedReplace+ :: (PersistEntity a, CanDelta a, HasActionLog m,+ ToBackendKey SqlBackend a,+ PersistEntityBackend a ~ SqlBackend)+ => Key a -> a -> m () loggedReplace key new = do old <- runPersist $ get key maybe (return ()) (\o -> loggedReplace' key o new) old@@ -89,21 +97,24 @@ -- | Performs a logged replace of a database record. loggedReplace' :: (PersistEntity a, CanDelta a, HasActionLog m,+ ToBackendKey SqlBackend a, PersistEntityBackend a ~ SqlBackend) => Key a -> a -> a -> m () loggedReplace' key old new = do let entityName = getName new runPersist $ replace key new- let entityId = mkInt key- aid <- logAction entityName entityId UpdateAction+ let eid = mkInt key+ aid <- logAction entityName eid UpdateAction storeDeltas aid old new return () ------------------------------------------------------------------------------ -- | Performs a logged update of a database record.-loggedUpdate :: (PersistEntity a, CanDelta a, HasActionLog m,- PersistEntityBackend a ~ SqlBackend)+loggedUpdate+ :: (PersistEntity a, CanDelta a, HasActionLog m,+ ToBackendKey SqlBackend a,+ PersistEntityBackend a ~ SqlBackend) => Key a -> [Update a] -> m () loggedUpdate key updates = do old <- runPersist $ get key@@ -114,6 +125,7 @@ -- | Performs a logged update of a database record. loggedUpdate' :: (PersistEntity a, CanDelta a, HasActionLog m,+ ToBackendKey SqlBackend a, PersistEntityBackend a ~ SqlBackend) => Key a -> a@@ -123,8 +135,8 @@ val <- runPersist $ updateGet key updates new <- runPersist $ get key let entityName = getName val- let entityId = mkInt key- aid <- logAction entityName entityId UpdateAction+ let eid = mkInt key+ aid <- logAction entityName eid UpdateAction maybe (return ()) (\n -> storeDeltas aid old n) new return () @@ -134,6 +146,7 @@ loggedDelete :: forall m a. (HasActionLog m, PersistEntity a,+ ToBackendKey SqlBackend a, PersistEntityBackend a ~ SqlBackend) => Entity a -> m ()@@ -147,6 +160,7 @@ -- | Performs a logged delete of a key in the database. loggedDeleteKey :: (PersistEntity a, HasActionLog m,+ ToBackendKey SqlBackend a, PersistEntityBackend a ~ SqlBackend) => Key a -> m ()@@ -181,9 +195,9 @@ -- | Gets the LoggedAction entry for the specified entity and id. getEntityActions :: HasPersistPool m => Text -> Int -> m [Entity LoggedAction]-getEntityActions entityName entityId = runPersist $+getEntityActions entityName eid = runPersist $ selectList [ LoggedActionEntityName ==. entityName- , LoggedActionEntityId ==. entityId+ , LoggedActionEntityId ==. eid ] []
+ src/Snap/Snaplet/ActionLog/Internal/Schema.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+module Snap.Snaplet.ActionLog.Internal.Schema where+++-------------------------------------------------------------------------------+import Data.Text (Text)+import Data.Time+import Database.Persist+import Database.Persist.Quasi+import Database.Persist.TH+-------------------------------------------------------------------------------+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]+actionLogEntityDefs = $(persistFileWith lowerCaseSettings "schema.txt")+++share [mkPersist sqlSettings, mkMigrate "migrateActionLog"]+ $(persistFileWith lowerCaseSettings "schema.txt")
src/Snap/Snaplet/ActionLog/InternalTypes.hs view
@@ -12,7 +12,7 @@ ------------------------------------------------------------------------------ import Control.Monad import Data.Readable-import Data.Text (Text)+import Data.Text (Text) import Database.Persist import Database.Persist.Sql import Snap.Restful
src/Snap/Snaplet/ActionLog/Resource.hs view
@@ -12,19 +12,23 @@ ) where -------------------------------------------------------------------------------import Blaze.ByteString.Builder import Blaze.ByteString.Builder.Char8+import Control.Applicative as A import Control.Error-import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as B+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B+import qualified Data.Map.Syntax as MS import Data.Monoid-import qualified Data.Readable as R-import Data.Text (Text)-import qualified Data.Text as T+import qualified Data.Readable as R+import Data.Text (Text)+import qualified Data.Text as T import Database.Persist import Heist import Heist.Compiled-import qualified Heist.Interpreted as I+import qualified Heist.Interpreted as I import Snap import Snap.Restful import Snap.Snaplet.ActionLog.API@@ -32,12 +36,12 @@ import Snap.Snaplet.Heist.Generic import Snap.Snaplet.Persistent import Text.Digestive-import qualified Text.Digestive as Form-import qualified Text.Digestive.Heist as DHI+import qualified Text.Digestive as Form+import qualified Text.Digestive.Heist as DHI import Text.Digestive.Heist.Compiled-import Text.Digestive.Snap hiding (method)-import qualified Text.Digestive.Snap as Form-import qualified Text.XmlHtml as X+import Text.Digestive.Snap hiding (method)+import qualified Text.Digestive.Snap as Form+import qualified Text.XmlHtml as X ------------------------------------------------------------------------------ @@ -94,11 +98,11 @@ disableOnJust :: (Maybe a -> Form v m b) -> Maybe a -> Form v m b disableOnJust f Nothing = f Nothing-disableOnJust f def = disable $ f def+disableOnJust f def = disable $ f def --------------------------------------------------------------------------------- | +-- | logFilterForm :: HasActionLog m => Bool -> Maybe LogFilter -> Form Text m LogFilter@@ -109,7 +113,7 @@ names <- mapM alGetName uids let userPairs = noFilter : (map firstJust $ zip uids names) return $ LogFilter- <$> "user" .: choice userPairs ?$ (filterUser <$> d)+ A.<$> "user" .: choice userPairs ?$ (filterUser <$> d) <*> "entity" .: choice entityPairs ?$ (filterEntity <$> d) <*> "entity-id" .: optionalStringRead "id must be an int" ?$ (filterEntityId =<< d)@@ -145,20 +149,23 @@ ------------------------------------------------------------------------------- actionLogSplices :: (HasActionLog n, MonadSnap n)- => Resource -> [(Text, Splice n)]-actionLogSplices r =- [ ("actionDetails", actionViewSplice r)- , ("defaultActions", defaultActionsSplice r) - ]- ++ applyDeferred (return mempty) (coupledSplices r False)+ => Resource -> Splices (Splice n)+actionLogSplices r = mconcat+ [ MS.mapV ($ mempty) (coupledSplices r False)+ , splices ]+ where+ splices = do+ "actionDetails" MS.## actionViewSplice r+ "defaultActions" MS.## defaultActionsSplice r coupledSplices :: (HasActionLog n, MonadSnap n)- => Resource -> Bool -> [(Text, Promise LogFilter -> Splice n)]-coupledSplices r b =- [ ("actionlogListing", actionsSplice r (runLogFilterForm b))- , ("actionlogFilterForm", logFilterFormSplice (runLogFilterForm b))- ]+ => Resource+ -> Bool+ -> Splices (RuntimeSplice n LogFilter -> Splice n)+coupledSplices r b = do+ "actionlogListing" MS.## actionsSplice r (runLogFilterForm b)+ "actionlogFilterForm" MS.## logFilterFormSplice (runLogFilterForm b) getFilterFunc :: Monad n => HeistT n IO (RuntimeSplice n LogFilter)@@ -208,10 +215,10 @@ actionsSplice :: HasActionLog n => Resource -> (Maybe a -> n (t, Maybe LogFilter))- -> Promise LogFilter+ -> RuntimeSplice n LogFilter -> Splice n-actionsSplice res form prom = manyWithSplices runChildren (actionSplices res) $ do- f <- getPromise prom+actionsSplice res form rt = manyWithSplices runChildren (actionSplices res) $ do+ f <- rt (_,r) <- lift $ form Nothing let filters = case r of Nothing -> []@@ -219,45 +226,44 @@ lift $ getTenantActions filters [] -applyDeferred :: Monad n- => RuntimeSplice n a- -> [(Text, Promise a -> Splice n)]- -> [(Text, Splice n)]-applyDeferred m = applySnd m . mapSnd defer-- actionSplices :: HasActionLog n => Resource- -> [(Text, Promise (Entity LoggedAction) -> Splice n)]-actionSplices r =- ("loggedActionUserName", runtimeToPromise getUserName) :- ("loggedActionDetails", detailsSplice) :- (pureSplices loggedActionCSplices ++- alCustomCSplices ++- repromise (return . DBId . mkWord64 . entityKey)- (pureSplices $ textSplices $ itemCSplices r)- )+ -> Splices (RuntimeSplice n (Entity LoggedAction) -> Splice n)+actionSplices r = mconcat+ [ MS.mapV pureSplice loggedActionCSplices+ , alCustomCSplices+ , MS.mapV ( deferMap (return . Just . DBId . mkWord64 . entityKey)+ . pureSplice . textSplice) (itemCSplices r)+ , splices+ ] where- getUserName = return . fromText <=< alGetName . loggedActionUserId . entityVal- detailsSplice prom =- manyWithSplices runChildren (pureSplices detailsCSplices)- (lift . getActionDetails . entityKey =<< getPromise prom)- + splices = do+ "loggedActionUserName" MS.## getUserName+ "loggedActionDetails" MS.## detailsSplice -runtimeToPromise :: (Monad n) => (t -> n Builder) -> Promise t -> Splice n-runtimeToPromise f p = return $ yieldRuntime $ do- entity <- getPromise p- lift $ f entity+ detailsSplice :: HasActionLog n+ => RuntimeSplice n (Entity LoggedAction)+ -> Splice n+ detailsSplice rt =+ manyWithSplices runChildren (MS.mapV pureSplice detailsCSplices)+ (lift . getActionDetails . entityKey =<< rt) + getUserName :: HasActionLog n+ => RuntimeSplice n (Entity LoggedAction)+ -> Splice n+ getUserName = bindLater $ \entity -> lift $ do+ name <- alGetName $ loggedActionUserId $ entityVal entity+ return $ fromText name + --------------------------------------------------------------------------------logFilterFormSplice :: Monad m+logFilterFormSplice :: MonadIO m => (Maybe a -> m (View Text, b))- -> Promise a+ -> RuntimeSplice m a -> Splice m-logFilterFormSplice form prom =- formSplice [] [] $ do- f <- getPromise prom+logFilterFormSplice form rt =+ formSplice mempty mempty $ do+ f <- rt lift $ liftM fst $ form (Just f) @@ -312,22 +318,24 @@ ------------------------------------------------------------------------------- -- | Interpreted splice for an action log listing. actionLogISplices :: (HasActionLog n, MonadSnap n)- => Resource -> [(Text, I.Splice n)]+ => Resource -> Splices (I.Splice n) actionLogISplices r =- [ ("actionDetails", actionDetailsISplice r) - , ("defaultActions", defaultActionsISplice r) - ]- ++ coupledISplices r False mempty+ splices `mappend` coupledISplices r False mempty+ where+ splices = do+ "actionDetails" MS.## actionDetailsISplice r+ "defaultActions" MS.## defaultActionsISplice r + coupledISplices :: (HasActionLog m, MonadSnap m)- => Resource -> Bool -> LogFilter -> [(Text, I.Splice m)]-coupledISplices r b f =- [ ("actionlogListing", actionLogListingISplice r (runLogFilterForm b) f)- , ("actionlogFilterForm", logFilterFormISplice (runLogFilterForm b) f)- ]+ => Resource -> Bool -> LogFilter -> Splices (I.Splice m)+coupledISplices r b f = do+ "actionlogListing" MS.## actionLogListingISplice r (runLogFilterForm b) f+ "actionlogFilterForm" MS.## logFilterFormISplice (runLogFilterForm b) f + actionDetailsISplice :: (HasActionLog n, MonadSnap n) => Resource -> I.Splice n actionDetailsISplice r = do@@ -352,15 +360,17 @@ actionISplices :: HasActionLog m => Resource -> Entity LoggedAction- -> [(Text, I.Splice m)]-actionISplices r e =- ("loggedActionUserName", I.textSplice =<< getUserName) :- ("loggedActionDetails", detailsISplice) :- (loggedActionISplices (entityVal e) ++- alCustomISplices e ++- itemSplices r (DBId $ mkWord64 $ entityKey e)- )+ -> Splices (I.Splice m)+actionISplices r e = mconcat+ [ splices+ , loggedActionISplices (entityVal e)+ , alCustomISplices e+ , itemSplices r (DBId $ mkWord64 $ entityKey e)+ ] where+ splices = do+ "loggedActionUserName" MS.## I.textSplice =<< getUserName+ "loggedActionDetails" MS.## detailsISplice getUserName = lift $ alGetName $ loggedActionUserId $ entityVal e detailsISplice = do ds <- lift $ getActionDetails $ entityKey e
src/Snap/Snaplet/ActionLog/Types.hs view
@@ -1,12 +1,16 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-} module Snap.Snaplet.ActionLog.Types ( ActionLog (..)@@ -15,63 +19,48 @@ , intToAction , module Snap.Snaplet.ActionLog.Types+ , module Snap.Snaplet.ActionLog.Internal.Schema ) where ------------------------------------------------------------------------------ import Blaze.ByteString.Builder-import Data.ByteString (ByteString)+import Data.ByteString (ByteString) import Data.Int-import Data.Text (Text)-import qualified Data.Text as T+#if MIN_VERSION_heist(1,0,0)+import Data.Map.Syntax (mapV, ( ## ))+#endif+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 Database.Persist.Sql+import Heist import Heist.Compiled-import qualified Heist.Interpreted as I+import qualified Heist.Interpreted as I import Snap.Restful import Snap.Restful.TH import Snap.Snaplet.Persistent ------------------------------------------------------------------------------+import Snap.Snaplet.ActionLog.Internal.Schema 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)+loggedActionCSplices :: Splices (Entity LoggedAction -> Builder)+loggedActionCSplices = mapV (. entityVal) $(cSplices ''LoggedAction) -loggedActionISplices :: Monad m => LoggedAction -> [(Text, I.Splice m)]+loggedActionISplices :: Monad m => LoggedAction -> Splices (I.Splice m) loggedActionISplices = $(iSplices ''LoggedAction) -detailsCSplices :: [(Text, Entity LoggedActionDetails -> Builder)]-detailsCSplices = mapSnd (. entityVal) $(cSplices ''LoggedActionDetails)+detailsCSplices :: Splices (Entity LoggedActionDetails -> Builder)+detailsCSplices = mapV (. entityVal) $(cSplices ''LoggedActionDetails) -detailsISplices :: Monad m => LoggedActionDetails -> [(Text, I.Splice m)]+detailsISplices :: Monad m => LoggedActionDetails -> Splices (I.Splice m) detailsISplices = $(iSplices ''LoggedActionDetails) @@ -119,11 +108,11 @@ -- | Complied version of any custom splices that you want to be available -- inside the @actionLogListing@ splice.- alCustomCSplices :: [(Text, Promise (Entity LoggedAction) -> Splice m)]+ alCustomCSplices :: Splices (RuntimeSplice m (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)]+ alCustomISplices :: Entity LoggedAction -> Splices (I.Splice m) @@ -185,10 +174,10 @@ toBS = toBS . show instance DeltaField a => DeltaField (Maybe a) where- toBS Nothing = "Nothing"+ toBS Nothing = "Nothing" toBS (Just a) = toBS a -instance (b ~ PersistEntityBackend e) => DeltaField (KeyBackend b e) where+instance (ToBackendKey SqlBackend e) => DeltaField (Key e) where toBS = toBS . mkInt class CanDelta a where