mysnapsession-example 0.2 → 0.3
raw patch · 5 files changed
+57/−26 lines, 5 filesdep ~mysnapsessiondep ~time
Dependency ranges changed: mysnapsession, time
Files
- animalgame/src/Application.hs +5/−1
- animalgame/src/Site.hs +26/−9
- clientcount/src/Application.hs +5/−1
- clientcount/src/Site.hs +9/−6
- mysnapsession-example.cabal +12/−9
animalgame/src/Application.hs view
@@ -15,6 +15,9 @@ AppSession(..) ) where +import Paths_mysnapsession_example++import Control.Monad.Trans import Snap.Extension import Snap.Extension.Heist.Impl import Snap.Extension.Session.Memory@@ -44,7 +47,8 @@ appInitializer :: Initializer AppState appInitializer = do- heist <- heistInitializer "animalgame/resources/templates"+ hPath <- liftIO $ getDataFileName "animalgame/resources/templates"+ heist <- heistInitializer hPath sessions <- memorySessionInitializer 1800 newSession return $ AppState heist sessions where
animalgame/src/Site.hs view
@@ -2,12 +2,15 @@ module Site (site) where +import Paths_mysnapsession_example+ import Data.ByteString.Char8 (ByteString) import Control.Applicative import Control.Monad+import Control.Monad.Trans import Snap.Extension.Heist+import Snap.Extension.Session import Snap.Dialogues-import Snap.SessionUtil import Snap.Util.FileServe import Snap.Types import Text.Templating.Heist@@ -17,14 +20,17 @@ data DiKey = Answer ByteString | Question ByteString DiKey DiKey +startingKey :: DiKey startingKey = Answer "elephant" +animalGame :: (MonadHeist n m) => DiKey -> Dlg m () animalGame key = do rulePage key' <- question key again <- goAgainPage if again then animalGame key' else conclusionPage +question :: (MonadHeist n m) => DiKey -> Dlg m DiKey question (Answer s) = do correct <- guessPage s if correct then return (Answer s)@@ -40,16 +46,19 @@ else do n' <- question n return (Question q y n') +rulePage :: MonadHeist n m => Dlg m () rulePage = showPage build parse where build t = heistLocal (bindStrings [("dlgid", t)]) $ render "rules" parse = return () +conclusionPage :: MonadHeist n m => Dlg m () conclusionPage = showPage build parse where build t = heistLocal (bindStrings [("dlgid", t)]) $ render "conclusion" parse = return () +goAgainPage :: MonadHeist n m => Dlg m Bool goAgainPage = showPage build parse where build t = heistLocal (bindStrings [("dlgid", t)]) $ render "goAgain"@@ -57,6 +66,7 @@ case p of Just "yes" -> return True _ -> return False +guessPage :: MonadHeist n m => ByteString -> Dlg m Bool guessPage animal = showPage build parse where build t = heistLocal (bindStrings@@ -65,6 +75,7 @@ case p of Just "yes" -> return True _ -> return False +questionPage :: MonadHeist n m => ByteString -> Dlg m Bool questionPage q = showPage build parse where build t = heistLocal (bindStrings@@ -73,20 +84,26 @@ case p of Just "yes" -> return True _ -> return False +detailsPage :: MonadHeist n m+ => ByteString+ -> Dlg m (ByteString, ByteString, Bool) detailsPage oldAnimal = showPage build parse where build t = heistLocal (bindStrings [("dlgid", t), ("oldAnimal", oldAnimal)]) $ render "details" parse = do- newAnimal <- getParam "newAnimal" >>= maybe mzero return- question <- getParam "question" >>= maybe mzero return- answerStr <- getParam "answer" >>= maybe mzero return+ newAnimal <- getParam "newAnimal" >>= maybe mzero return+ newQuestion <- getParam "question" >>= maybe mzero return+ answerStr <- getParam "answer" >>= maybe mzero return let answer = case answerStr of "yes" -> True _ -> False- return (newAnimal, question, answer)+ return (newAnimal, newQuestion, answer) site :: App ()-site = inSession $- ifTop (render "index")- <|> dialogue "animal" (animalGame startingKey)- <|> fileServe "animalgame/resources/static"+site = do+ sPath <- liftIO $ getDataFileName "animalgame/resources/static"+ inSession $+ ifTop (render "index")+ <|> dialogue "animal" (animalGame startingKey)+ <|> fileServe sPath+
clientcount/src/Application.hs view
@@ -15,6 +15,9 @@ appInitializer ) where +import Paths_mysnapsession_example++import Control.Monad.Trans import Data.ByteString.Char8 (ByteString) import Snap.Extension import Snap.Extension.Heist.Impl@@ -41,6 +44,7 @@ appInitializer :: Initializer AppState appInitializer = do- heist <- heistInitializer "clientcount/resources/templates"+ hPath <- liftIO $ getDataFileName "clientcount/resources/templates"+ heist <- heistInitializer hPath sessions <- clientSessionInitializer sessionKey 0 (Just 10) return $ AppState heist sessions
clientcount/src/Site.hs view
@@ -2,15 +2,16 @@ module Site (site) where +import Paths_mysnapsession_example+ import Control.Applicative+import Control.Monad.Trans import Snap.Extension.Heist import Snap.Extension.Session-import Snap.SessionUtil import Snap.Util.FileServe import Snap.Types import Text.Templating.Heist -import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Application@@ -18,10 +19,12 @@ index :: App () index = do i <- getSession- putSession (i+1)+ setSession (i+1) heistLocal (bindString "num" (B.pack $ show i)) $ render "index" site :: App ()-site = inSession $- ifTop index- <|> fileServe "clientcount/resources/static"+site = do+ sPath <- liftIO $ getDataFileName "clientcount/resources/static"+ inSession $+ ifTop index+ <|> fileServe sPath
mysnapsession-example.cabal view
@@ -1,8 +1,12 @@ Name: mysnapsession-example-Version: 0.2+Version: 0.3 Synopsis: Example projects using mysnapsession Description: This is a collection of simple web applications that use the mysnapsession package for stateful HTTP.+ .+ As of version 0.3, this uses Cabal's data file mechanism,+ so you'll need to install before you run to copy the+ data files to where they are expected. License: BSD3 License-file: LICENSE Author: Chris Smith <cdsmith@gmail.com>@@ -12,11 +16,10 @@ Build-type: Simple Cabal-version: >=1.6 -Extra-source-files: animalgame/resources/static/*.css,- animalgame/resources/templates/*.tpl--Extra-source-files: clientcount/resources/static/*.css,- clientcount/resources/templates/*.tpl+Data-files: animalgame/resources/static/*.css,+ animalgame/resources/templates/*.tpl,+ clientcount/resources/static/*.css,+ clientcount/resources/templates/*.tpl Executable animalgame Hs-source-dirs: animalgame/src@@ -31,7 +34,7 @@ snap >= 0.3 && < 0.4, snap-core >= 0.3 && < 0.4, snap-server >= 0.3 && <0.4,- mysnapsession == 0.2.*,+ mysnapsession == 0.3.*, clientsession == 0.4.* Ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields@@ -50,8 +53,8 @@ snap >= 0.3 && < 0.4, snap-core >= 0.3 && < 0.4, snap-server >= 0.3 && <0.4,- time == 1.1.*,- mysnapsession == 0.2.*+ time >= 1.1 && < 1.3,+ mysnapsession == 0.3.* Ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-orphans