Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added an example app and fixed documentation.

  • Loading branch information...
commit bf78a014b79ad027eef864bc62d7bd64f0740d3e 1 parent c2b0b4e
@mightybyte authored
Showing with 93 additions and 4 deletions.
  1. +88 −0 examples/Site.hs
  2. +5 −4 src/Snap/Snaplet/AcidState.hs
View
88 examples/Site.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Prelude hiding ((.), id)
+import Control.Category
+import Control.Monad.Reader
+import Control.Monad.State
+import Data.ByteString (ByteString)
+import Data.Lens.Template
+import Data.SafeCopy
+import qualified Data.Text as T
+import Data.Typeable
+import Snap.Core
+import Snap.Snaplet
+import Snap.Snaplet.AcidState
+import Snap.Snaplet.Heist
+import Snap.Util.FileServe
+
+import Snap
+import Snap.Snaplet.AcidState
+import Snap.Snaplet.Heist
+
+------------------------------------------------------------------------------
+-- acid-state code
+------------------------------------------------------------------------------
+
+data PersistentState = PersistentState
+ { _psCounter :: Int
+ } deriving (Show,Ord,Eq,Typeable)
+
+makeLens ''PersistentState
+
+deriveSafeCopy 0 'base ''PersistentState
+
+incCounter :: Update PersistentState ()
+incCounter = modify (modL psCounter (+1))
+
+myQuery :: Query PersistentState Int
+myQuery = asks _psCounter
+
+makeAcidic ''PersistentState ['incCounter, 'myQuery]
+
+
+------------------------------------------------------------------------------
+-- snap code
+------------------------------------------------------------------------------
+
+data App = App
+ { _acid :: Snaplet (Acid PersistentState)
+ }
+
+type AppHandler = Handler App App
+
+makeLens ''App
+
+
+------------------------------------------------------------------------------
+-- | This instance is optional. It just allows you to avoid putting the call
+-- "with acid" in front of your calls to query and update.
+instance HasAcid App PersistentState where
+ getAcidStore = getL (snapletValue . acid)
+
+
+------------------------------------------------------------------------------
+-- | The application's routes.
+routes :: [(ByteString, Handler App App ())]
+routes = [ ("", serveDirectory "resources/static")
+ , ("/inc", update IncCounter)
+ , ("/count", writeText . T.pack . show =<< query MyQuery)
+ ]
+
+
+------------------------------------------------------------------------------
+-- | The application initializer.
+app :: SnapletInit App App
+app = makeSnaplet "app" "An snaplet example application." Nothing $ do
+ a <- nestSnaplet "acid" acid $ acidInit (PersistentState 0)
+ addRoutes routes
+ return $ App a
+
+
+main = serveSnaplet defaultConfig app
View
9 src/Snap/Snaplet/AcidState.hs
@@ -34,11 +34,11 @@ import Snap
------------------------------------------------------------------------------
-- |
description :: Text
-description = "Snaplet providing acid-state"
+description = "Snaplet providing acid-state functionality"
------------------------------------------------------------------------------
--- |
+-- | Data type holding acid-state snaplet data.
data Acid st = Acid
{ _acidStore :: A.AcidState st
}
@@ -75,8 +75,9 @@ acidInit' location initial = makeSnaplet "acid-state" description Nothing $ do
-- You can minimize boilerplate in your application by adding an instance like
-- the following:
--
--- data App = App { ... _acid :: Snaplet (Acid MyState) ... }
--- instance HasAcid App where getAcidStore = _acid
+-- > 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)
Please sign in to comment.
Something went wrong with that request. Please try again.