diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,2 @@ +0.3.1 +* Broaden deps diff --git a/snaplet-actionlog.cabal b/snaplet-actionlog.cabal --- a/snaplet-actionlog.cabal +++ b/snaplet-actionlog.cabal @@ -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 diff --git a/src/Snap/Snaplet/ActionLog.hs b/src/Snap/Snaplet/ActionLog.hs --- a/src/Snap/Snaplet/ActionLog.hs +++ b/src/Snap/Snaplet/ActionLog.hs @@ -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 diff --git a/src/Snap/Snaplet/ActionLog/API.hs b/src/Snap/Snaplet/ActionLog/API.hs --- a/src/Snap/Snaplet/ActionLog/API.hs +++ b/src/Snap/Snaplet/ActionLog/API.hs @@ -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 ] [] diff --git a/src/Snap/Snaplet/ActionLog/Internal/Schema.hs b/src/Snap/Snaplet/ActionLog/Internal/Schema.hs new file mode 100644 --- /dev/null +++ b/src/Snap/Snaplet/ActionLog/Internal/Schema.hs @@ -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") diff --git a/src/Snap/Snaplet/ActionLog/InternalTypes.hs b/src/Snap/Snaplet/ActionLog/InternalTypes.hs --- a/src/Snap/Snaplet/ActionLog/InternalTypes.hs +++ b/src/Snap/Snaplet/ActionLog/InternalTypes.hs @@ -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 diff --git a/src/Snap/Snaplet/ActionLog/Resource.hs b/src/Snap/Snaplet/ActionLog/Resource.hs --- a/src/Snap/Snaplet/ActionLog/Resource.hs +++ b/src/Snap/Snaplet/ActionLog/Resource.hs @@ -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 diff --git a/src/Snap/Snaplet/ActionLog/Types.hs b/src/Snap/Snaplet/ActionLog/Types.hs --- a/src/Snap/Snaplet/ActionLog/Types.hs +++ b/src/Snap/Snaplet/ActionLog/Types.hs @@ -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