Permalink
Browse files

Refactored the API to have more convenient type signatures.

  • Loading branch information...
1 parent 9f7a9e2 commit d06eefb5fe3b24ddfa34231ca2ed172ffb210ff7 @mightybyte committed Feb 21, 2012
Showing with 27 additions and 20 deletions.
  1. +2 −2 snaplet-acid-state.cabal
  2. +25 −18 src/Snap/Snaplet/AcidState.hs
View
@@ -1,5 +1,5 @@
name: snaplet-acid-state
-version: 0.1
+version: 0.2
synopsis: acid-state snaplet for Snap Framework
description: This snaplet that makes it easy to use acid-state in a Snap
application.
@@ -27,7 +27,7 @@ Library
build-depends:
acid-state >= 0.6 && < 0.7,
base >= 4 && < 5,
- snap >= 0.6 && < 0.8,
+ snap >= 0.6 && < 0.9,
text >= 0.11 && < 0.12
ghc-options: -Wall -fwarn-tabs -funbox-strict-fields
@@ -12,6 +12,7 @@ module Snap.Snaplet.AcidState
, HasAcid(..)
, acidInit
, acidInit'
+ , getAcidState
, update
, query
, createCheckpoint
@@ -20,6 +21,9 @@ module Snap.Snaplet.AcidState
, module Data.Acid
) where
+
+import Prelude hiding ((.), id)
+import Control.Category
import qualified Data.Acid as A
import qualified Data.Acid.Advanced as A
import Data.Acid hiding (update
@@ -40,7 +44,7 @@ description = "Snaplet providing acid-state functionality"
------------------------------------------------------------------------------
-- | Data type holding acid-state snaplet data.
-data Acid st = Acid
+newtype Acid st = Acid
{ _acidStore :: A.AcidState st
}
@@ -87,50 +91,53 @@ instance HasAcid (Acid st) st where
getAcidStore = id
-getAcidState :: forall a st. HasAcid a st => a -> AcidState st
-getAcidState = _acidStore . getAcidStore
+------------------------------------------------------------------------------
+-- | Lower-level function providing direct access to the AcidState data type.
+getAcidState :: (HasAcid s st, MonadSnaplet m, MonadState s (m v' v'))
+ => m v' v (AcidState st)
+getAcidState = withTop' id $ gets $ _acidStore . getAcidStore
------------------------------------------------------------------------------
-- | Wrapper for acid-state's update function that works for arbitrary
-- instances of HasAcid.
-update :: (MonadState s m, HasAcid s (A.MethodState event),
- UpdateEvent event, MonadIO m)
- => event -> m (EventResult event)
+update :: (HasAcid s (A.MethodState event),
+ MonadSnaplet m,
+ MonadState s (m v' v'),
+ UpdateEvent event,
+ MonadIO (m v' v))
+ => event -> m v' v (EventResult event)
update event = do
- st <- gets getAcidState
+ st <- getAcidState
liftIO $ A.update st event
------------------------------------------------------------------------------
-- | Wrapper for acid-state's query function that works for arbitrary
-- instances of HasAcid.
query :: (HasAcid s (A.MethodState event),
- MonadIO m, QueryEvent event, MonadState s m)
- => event -> m (EventResult event)
+ MonadSnaplet m,
+ MonadState s (m v' v'),
+ QueryEvent event,
+ MonadIO (m v' v))
+ => event -> m v' v (EventResult event)
query event = do
- st <- gets getAcidState
+ st <- getAcidState
liftIO $ A.query st event
------------------------------------------------------------------------------
-- | Wrapper for acid-state's createCheckpoint function that works for
-- arbitrary instances of HasAcid.
-createCheckpoint :: forall (m :: * -> *) s st.
- (HasAcid s st, MonadIO m, MonadState s m)
- => m ()
createCheckpoint = do
- (st :: AcidState st) <- gets getAcidState
+ st <- getAcidState
liftIO $ A.createCheckpoint st
------------------------------------------------------------------------------
-- | Wrapper for acid-state's closeAcidState function that works for
-- arbitrary instances of HasAcid.
-closeAcidState :: forall (m :: * -> *) s st.
- (HasAcid s st, MonadIO m, MonadState s m)
- => m ()
closeAcidState = do
- (st :: AcidState st) <- gets getAcidState
+ st <- getAcidState
liftIO $ A.closeAcidState st

0 comments on commit d06eefb

Please sign in to comment.