Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
file 88 lines (64 sloc) 2.976 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where
------------------------------------------------------------------------------
-- explicit imports
------------------------------------------------------------------------------

import Control.Monad.Reader (asks)
import Data.ByteString (ByteString)
import Control.Lens (makeLenses, view, over)
import Data.SafeCopy (base, deriveSafeCopy)
import qualified Data.Text as T
import Data.Typeable (Typeable)
import Snap.Util.FileServe (serveDirectory)
import Snap (SnapletInit, Snaplet, Handler,
                 addRoutes, nestSnaplet, serveSnaplet,
                 defaultConfig, makeSnaplet,
                 snapletValue, writeText, modify)
import Snap.Snaplet.AcidState (Update, Query, Acid,
                 HasAcid (getAcidStore), makeAcidic, update, query, acidInit)


------------------------------------------------------------------------------
-- acid-state code
------------------------------------------------------------------------------

data PersistentState = PersistentState
    { _psCounter :: Int
    } deriving (Show,Ord,Eq,Typeable)

makeLenses ''PersistentState

deriveSafeCopy 0 'base ''PersistentState

incCounter :: Update PersistentState ()
incCounter = modify (over 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

makeLenses ''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 = view (acid.snapletValue)


------------------------------------------------------------------------------
-- | 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
Something went wrong with that request. Please try again.