diff --git a/animalgame/src/Application.hs b/animalgame/src/Application.hs --- a/animalgame/src/Application.hs +++ b/animalgame/src/Application.hs @@ -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 diff --git a/animalgame/src/Site.hs b/animalgame/src/Site.hs --- a/animalgame/src/Site.hs +++ b/animalgame/src/Site.hs @@ -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 + diff --git a/clientcount/src/Application.hs b/clientcount/src/Application.hs --- a/clientcount/src/Application.hs +++ b/clientcount/src/Application.hs @@ -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 diff --git a/clientcount/src/Site.hs b/clientcount/src/Site.hs --- a/clientcount/src/Site.hs +++ b/clientcount/src/Site.hs @@ -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 diff --git a/mysnapsession-example.cabal b/mysnapsession-example.cabal --- a/mysnapsession-example.cabal +++ b/mysnapsession-example.cabal @@ -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 @@ -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