snaplet-acid-state (empty) → 0.1
raw patch · 4 files changed
+192/−0 lines, 4 filesdep +acid-statedep +basedep +snapsetup-changed
Dependencies added: acid-state, base, snap, text
Files
- LICENSE +27/−0
- Setup.hs +3/−0
- snaplet-acid-state.cabal +33/−0
- src/Snap/Snaplet/AcidState.hs +129/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2009, Snap Framework authors (see CONTRIBUTORS)+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer.++Redistributions in binary form must reproduce the above copyright notice, this+list of conditions and the following disclaimer in the documentation and/or+other materials provided with the distribution.++Neither the name of the Snap Framework authors nor the names of its+contributors may be used to endorse or promote products derived from this+software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ snaplet-acid-state.cabal view
@@ -0,0 +1,33 @@+name: snaplet-acid-state+version: 0.1+synopsis: acid-state snaplet for Snap Framework+description: This snaplet that makes it easy to use acid-state in a Snap+ application.+license: BSD3+license-file: LICENSE+author: Doug Beardsley+maintainer: mightybyte@gmail.com+build-type: Simple+cabal-version: >= 1.6+category: Web++extra-source-files: LICENSE++source-repository head+ type: git+ location: https://github.com/mightybyte/snaplet-acid-state.git++Library+ hs-source-dirs: src++ exposed-modules:+ Snap.Snaplet.AcidState++ build-depends:+ acid-state >= 0.6 && < 0.7,+ base >= 4 && < 5,+ snap >= 0.6 && < 0.8,+ text >= 0.11 && < 0.12++ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields+ -fno-warn-orphans -fno-warn-unused-do-bind
+ src/Snap/Snaplet/AcidState.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+module Snap.Snaplet.AcidState+ ( Acid+ , HasAcid(..)+ , acidInit+ , acidInit'+ , update+ , query+ , createCheckpoint+ , closeAcidState++ , module Data.Acid+ ) where++import qualified Data.Acid as A+import qualified Data.Acid.Advanced as A+import Data.Acid hiding (update+ ,query+ ,createCheckpoint+ ,closeAcidState+ )+import Data.Typeable+import Data.Text (Text)+import Snap+++------------------------------------------------------------------------------+-- | +description :: Text+description = "Snaplet providing acid-state functionality"+++------------------------------------------------------------------------------+-- | Data type holding acid-state snaplet data.+data Acid st = Acid+ { _acidStore :: A.AcidState st+ }+++------------------------------------------------------------------------------+-- | Initializer that stores the state in the "state/[typeOf state]/"+-- directory.+acidInit :: (A.IsAcidic st, Typeable st)+ => st+ -- ^ Initial state to be used if + -> SnapletInit b (Acid st)+acidInit initial = makeSnaplet "acid-state" description Nothing $ do+ st <- liftIO $ A.openLocalState initial+ return $ Acid st+++------------------------------------------------------------------------------+-- | Initializer allowing you to specify the location of the acid-state store.+acidInit' :: A.IsAcidic st+ => FilePath+ -- ^ Location of the acid-state store on disk+ -> st+ -- ^ Initial state to be used if + -> SnapletInit b (Acid st)+acidInit' location initial = makeSnaplet "acid-state" description Nothing $ do+ st <- liftIO $ A.openLocalStateFrom location initial+ return $ Acid st+++------------------------------------------------------------------------------+-- | Type class standardizing a context that holds an AcidState.+--+-- You can minimize boilerplate in your application by adding an instance like+-- the following:+--+-- > data App = App { ... _acid :: Snaplet (Acid MyState) ... }+-- > instance HasAcid App MyState where+-- > getAcidStore = getL (snapletValue . acid)+class HasAcid myState acidState where+ getAcidStore :: myState -> (Acid acidState)+++instance HasAcid (Acid st) st where+ getAcidStore = id+++getAcidState :: forall a st. HasAcid a st => a -> AcidState st+getAcidState = _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 event = do+ st <- gets 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)+query event = do+ st <- gets getAcidState+ liftIO $ A.query st event+++------------------------------------------------------------------------------+-- | Wrapper for acid-state's createCheckpoint function that works for+-- arbitrary instances of HasAcid.+createCheckpoint = do+ st <- gets getAcidState+ liftIO $ A.createCheckpoint st+++------------------------------------------------------------------------------+-- | Wrapper for acid-state's closeAcidState function that works for+-- arbitrary instances of HasAcid.+closeAcidState = do+ st <- gets getAcidState+ liftIO $ A.closeAcidState st+