packages feed

mysnapsession-example 0.1 → 0.2

raw patch · 28 files changed

+487/−347 lines, 28 filesdep +clientsessiondep −MonadCatchIO-transformersdep −hexpatdep −textdep ~mysnapsessiondep ~timenew-component:exe:animalgamenew-component:exe:clientcount

Dependencies added: clientsession

Dependencies removed: MonadCatchIO-transformers, hexpat, text

Dependency ranges changed: mysnapsession, time

Files

+ animalgame/resources/static/screen.css view
@@ -0,0 +1,26 @@+html {+   padding: 0;+   margin: 0;+   background-color: #ffffff;+   font-family: Verdana, Helvetica, sans-serif;+}+body {+   padding: 0;+   margin: 0;+}+a {+   text-decoration: underline;+}+a :hover {+   cursor: pointer;+   text-decoration: underline;+}+img {+   border: none;+}+#content {+   padding-left: 1em;+}+#info {+   font-size: 60%;+}
+ animalgame/resources/templates/conclusion.tpl view
@@ -0,0 +1,15 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">+<html xmlns="http://www.w3.org/1999/xhtml">+  <head>+    <title>mysnapsessions Sample Application</title>+    <link rel="stylesheet" type="text/css" href="screen.css"/>+  </head>+  <body>+    <div id="content">+      <h1>Conclusion</h1>+      <p>+        Thank you for playing!+      </p>+    </div>+  </body>+</html>
+ animalgame/resources/templates/details.tpl view
@@ -0,0 +1,30 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">+<html xmlns="http://www.w3.org/1999/xhtml">+  <head>+    <title>mysnapsessions Sample Application</title>+    <link rel="stylesheet" type="text/css" href="screen.css"/>+  </head>+  <body>+    <div id="content">+      <h1>Drat!</h1>+      <p>+        Well, perhaps you can help me learn for next time.+      </p>+      <form method="POST" action="/$(dlgid)">+      <p>+        What was the right answer?+        <br/><input type="text" name="newAnimal" value="" />+      </p>+      <p>+        What is a question that distinguishes your animal from a(n) <oldAnimal/>?+        <br/><input type="text" name="question" value="" />+      </p>+      <p>+        Finally, what is the correct answer for your animal?<br/>+        <input type="submit" name="answer" value="yes" />+        <input type="submit" name="answer" value="no" />+      </p>+      </form>+    </div>+  </body>+</html>
+ animalgame/resources/templates/goAgain.tpl view
@@ -0,0 +1,21 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">+<html xmlns="http://www.w3.org/1999/xhtml">+  <head>+    <title>mysnapsessions Sample Application</title>+    <link rel="stylesheet" type="text/css" href="screen.css"/>+  </head>+  <body>+    <div id="content">+      <h1>All done.</h1>+      <p>+        That was fun!  Would you like to play again?+      </p>+      <form method="POST" action="/$(dlgid)">+      <p>+        <input type="submit" name="answer" value="yes" />+        <input type="submit" name="answer" value="no" />+      </p>+      </form>+    </div>+  </body>+</html>
+ animalgame/resources/templates/guess.tpl view
@@ -0,0 +1,21 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">+<html xmlns="http://www.w3.org/1999/xhtml">+  <head>+    <title>mysnapsessions Sample Application</title>+    <link rel="stylesheet" type="text/css" href="screen.css"/>+  </head>+  <body>+    <div id="content">+      <h1>I've got it!</h1>+      <p>+        I guess: <b><animal/></b>  Am I right?+      </p>+      <form method="POST" action="/$(dlgid)">+      <p>+        <input type="submit" name="answer" value="yes" />+        <input type="submit" name="answer" value="no" />+      </p>+      </form>+    </div>+  </body>+</html>
+ animalgame/resources/templates/index.tpl view
@@ -0,0 +1,22 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">+<html xmlns="http://www.w3.org/1999/xhtml">+  <head>+    <title>mysnapsessions Sample Application</title>+    <link rel="stylesheet" type="text/css" href="screen.css"/>+  </head>+  <body>+    <div id="content">+      <h1>Welcome!</h1>+      <p>+        This simple application demonstrates the continuation-based programming+        model in the <code>mysnapsessions</code> package.  You'll be asked to+        think of an animal, and the application will try to guess it.  The+        state of the game is stored in your session, so it's not shared between+        users.+      </p>+      <p>+        <a href="/animal">get started!</a>+      </p>+    </div>+  </body>+</html>
+ animalgame/resources/templates/question.tpl view
@@ -0,0 +1,21 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">+<html xmlns="http://www.w3.org/1999/xhtml">+  <head>+    <title>mysnapsessions Sample Application</title>+    <link rel="stylesheet" type="text/css" href="screen.css"/>+  </head>+  <body>+    <div id="content">+      <h1>Hmm...</h1>+      <p>+        Next question: <b><question/></b>+      </p>+      <form method="POST" action="/$(dlgid)">+      <p>+        <input type="submit" name="answer" value="yes" />+        <input type="submit" name="answer" value="no" />+      </p>+      </form>+    </div>+  </body>+</html>
+ animalgame/resources/templates/rules.tpl view
@@ -0,0 +1,20 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">+<html xmlns="http://www.w3.org/1999/xhtml">+  <head>+    <title>mysnapsessions Sample Application</title>+    <link rel="stylesheet" type="text/css" href="screen.css"/>+  </head>+  <body>+    <div id="content">+      <h1>Rules</h1>+      <p>+        Think of an animal, and click OK to get started when you are ready.+      </p>+      <form method="POST" action="/$(dlgid)">+      <p>+        <input type="submit" value="Continue" />+      </p>+      </form>+    </div>+  </body>+</html>
+ animalgame/src/Application.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeSynonymInstances  #-}++{-++This module defines our application's monad and any application-specific+information it requires.++-}++module Application (+    App,+    appInitializer,+    AppSession(..)+    ) where++import Snap.Extension+import Snap.Extension.Heist.Impl+import Snap.Extension.Session.Memory+import Snap.Dialogues++type App = SnapExtend AppState++data AppState = AppState {+    templateState :: HeistState App,+    sessionMgr    :: MemorySessionManager AppSession+    }++instance HasHeistState App AppState where+    getHeistState     = templateState+    setHeistState s a = a { templateState = s }++instance HasMemorySessionManager AppState where+    type MemorySessionValue AppState = AppSession+    memorySessionMgr = sessionMgr++data AppSession = AppSession {+    dlgManager :: DlgManager App+    }++instance HasDlgManager App AppSession where+    getDlgManager = dlgManager++appInitializer :: Initializer AppState+appInitializer = do+    heist    <- heistInitializer "animalgame/resources/templates"+    sessions <- memorySessionInitializer 1800 newSession+    return $ AppState heist sessions+  where+    newSession = fmap AppSession makeDlgManager+
+ animalgame/src/Main.hs view
@@ -0,0 +1,8 @@+module Main where++import           Snap.Extension.Server+import           Application+import           Site++main :: IO ()+main = quickHttpServe appInitializer site
+ animalgame/src/Site.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}++module Site (site) where++import Data.ByteString.Char8 (ByteString)+import Control.Applicative+import Control.Monad+import Snap.Extension.Heist+import Snap.Dialogues+import Snap.SessionUtil+import Snap.Util.FileServe+import Snap.Types+import Text.Templating.Heist++import Application++data DiKey = Answer   ByteString+           | Question ByteString DiKey DiKey++startingKey = Answer "elephant"++animalGame key = do+    rulePage+    key'  <- question key+    again <- goAgainPage+    if again then animalGame key' else conclusionPage++question (Answer s) = do+    correct <- guessPage s+    if correct then return (Answer s)+               else do+        (anim, newq, newa) <- detailsPage s+        if newa then return (Question newq (Answer anim) (Answer s))+                else return (Question newq (Answer s) (Answer anim))++question (Question q y n) = do+    ans <- questionPage q+    if ans then do y' <- question y+                   return (Question q y' n)+           else do n' <- question n+                   return (Question q y n')++rulePage = showPage build parse+  where+    build t = heistLocal (bindStrings [("dlgid", t)]) $ render "rules"+    parse   = return ()++conclusionPage = showPage build parse+  where+    build t = heistLocal (bindStrings [("dlgid", t)]) $ render "conclusion"+    parse   = return ()++goAgainPage = showPage build parse+  where+    build t = heistLocal (bindStrings [("dlgid", t)]) $ render "goAgain"+    parse   = do p <- getParam "answer"+                 case p of Just "yes" -> return True+                           _          -> return False++guessPage animal = showPage build parse+  where+    build t = heistLocal (bindStrings+                 [("dlgid", t), ("animal", animal)]) $ render "guess"+    parse   = do p <- getParam "answer"+                 case p of Just "yes" -> return True+                           _          -> return False++questionPage q = showPage build parse+  where+    build t = heistLocal (bindStrings+                 [("dlgid", t), ("question", q)]) $ render "question"+    parse   = do p <- getParam "answer"+                 case p of Just "yes" -> return True+                           _          -> return False++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+        let answer = case answerStr of "yes" -> True+                                       _     -> False+        return (newAnimal, question, answer)++site :: App ()+site = inSession $+    ifTop (render "index")+    <|> dialogue "animal" (animalGame startingKey)+    <|> fileServe "animalgame/resources/static"
+ clientcount/resources/static/screen.css view
@@ -0,0 +1,26 @@+html {+   padding: 0;+   margin: 0;+   background-color: #ffffff;+   font-family: Verdana, Helvetica, sans-serif;+}+body {+   padding: 0;+   margin: 0;+}+a {+   text-decoration: underline;+}+a :hover {+   cursor: pointer;+   text-decoration: underline;+}+img {+   border: none;+}+#content {+   padding-left: 1em;+}+#info {+   font-size: 60%;+}
+ clientcount/resources/templates/index.tpl view
@@ -0,0 +1,18 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">+<html xmlns="http://www.w3.org/1999/xhtml">+  <head>+    <title>mysnapsessions Sample Application</title>+    <link rel="stylesheet" type="text/css" href="screen.css"/>+  </head>+  <body>+    <div id="content">+      <h1>Welcome!</h1>+      <p>+        Your current session count is <num/>.+      </p>+      <p>+        <a href="/">Bump me up one more!</a>+      </p>+    </div>+  </body>+</html>
+ clientcount/src/Application.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeSynonymInstances  #-}++{-++This module defines our application's monad and any application-specific+information it requires.++-}++module Application (+    App,+    appInitializer+    ) where++import Data.ByteString.Char8 (ByteString)+import Snap.Extension+import Snap.Extension.Heist.Impl+import Snap.Extension.Session.Client+import Web.ClientSession++type App = SnapExtend AppState++data AppState = AppState {+    templateState :: HeistState App,+    sessionMgr    :: ClientSessionManager Int+    }++instance HasHeistState App AppState where+    getHeistState     = templateState+    setHeistState s a = a { templateState = s }++instance HasClientSessionManager AppState where+    type ClientSessionValue AppState = Int+    clientSessionMgr = sessionMgr++sessionKey :: ByteString+sessionKey = $(embedDefaultKey)++appInitializer :: Initializer AppState+appInitializer = do+    heist    <- heistInitializer "clientcount/resources/templates"+    sessions <- clientSessionInitializer sessionKey 0 (Just 10)+    return $ AppState heist sessions
+ clientcount/src/Main.hs view
@@ -0,0 +1,8 @@+module Main where++import           Snap.Extension.Server+import           Application+import           Site++main :: IO ()+main = quickHttpServe appInitializer site
+ clientcount/src/Site.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}++module Site (site) where++import Control.Applicative+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++index :: App ()+index = do+    i <- getSession+    putSession (i+1)+    heistLocal (bindString "num" (B.pack $ show i)) $ render "index"++site :: App ()+site = inSession $+    ifTop index+    <|> fileServe "clientcount/resources/static"
mysnapsession-example.cabal view
@@ -1,9 +1,8 @@ Name:                mysnapsession-example-Version:             0.1-Synopsis:            Example project using mysnapsession-Description:         This is a simple web application that uses the-                     mysnapsession package's continuation programming model-                     to build an animal guessing game.+Version:             0.2+Synopsis:            Example projects using mysnapsession+Description:         This is a collection of simple web applications that use+                     the mysnapsession package for stateful HTTP. License:             BSD3 License-file:        LICENSE Author:              Chris Smith <cdsmith@gmail.com>@@ -13,33 +12,46 @@ Build-type:          Simple Cabal-version:       >=1.6 -Extra-source-files:  resources/static/*.css, resources/templates/*.tpl+Extra-source-files:  animalgame/resources/static/*.css,+                     animalgame/resources/templates/*.tpl -Executable testsnap-  Hs-source-dirs: src-  Main-is: Main.hs-  Other-modules: Main, Application, Site+Extra-source-files:  clientcount/resources/static/*.css,+                     clientcount/resources/templates/*.tpl +Executable animalgame+  Hs-source-dirs:      animalgame/src+  Main-is:             Main.hs+  Other-modules:       Main, Application, Site+   Build-depends:     base >= 4 && < 5,     bytestring >= 0.9.1 && < 0.10,     heist >= 0.4 && < 0.5,-    hexpat >= 0.19 && < 0.20,-    MonadCatchIO-transformers >= 0.2.1 && < 0.3,     mtl >= 2 && < 3,     snap >= 0.3 && < 0.4,     snap-core >= 0.3 && < 0.4,     snap-server >= 0.3 && <0.4,-    text >= 0.11 && < 0.12,-    time >= 1.1 && < 1.3,-    mysnapsession == 0.1.*+    mysnapsession == 0.2.*,+    clientsession == 0.4.* -  extensions: TypeSynonymInstances MultiParamTypeClasses+  Ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields+               -fno-warn-orphans -  if impl(ghc >= 6.12.0)-    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields-                 -fno-warn-orphans -fno-warn-unused-do-bind-  else-    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields-                 -fno-warn-orphans+Executable clientcount+  Hs-source-dirs:      clientcount/src+  Main-is:             Main.hs+  Other-modules:       Main, Application, Site +  Build-depends:+    base >= 4 && < 5,+    bytestring >= 0.9.1 && < 0.10,+    heist >= 0.4 && < 0.5,+    mtl >= 2 && < 3,+    snap >= 0.3 && < 0.4,+    snap-core >= 0.3 && < 0.4,+    snap-server >= 0.3 && <0.4,+    time == 1.1.*,+    mysnapsession == 0.2.*++  Ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields+               -fno-warn-orphans
− resources/static/screen.css 
@@ -1,26 +0,0 @@-html {-   padding: 0;-   margin: 0;-   background-color: #ffffff;-   font-family: Verdana, Helvetica, sans-serif;-}-body {-   padding: 0;-   margin: 0;-}-a {-   text-decoration: underline;-}-a :hover {-   cursor: pointer;-   text-decoration: underline;-}-img {-   border: none;-}-#content {-   padding-left: 1em;-}-#info {-   font-size: 60%;-}
− resources/templates/conclusion.tpl 
@@ -1,15 +0,0 @@-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">-<html xmlns="http://www.w3.org/1999/xhtml">-  <head>-    <title>mysnapsessions Sample Application</title>-    <link rel="stylesheet" type="text/css" href="screen.css"/>-  </head>-  <body>-    <div id="content">-      <h1>Conclusion</h1>-      <p>-        Thank you for playing!-      </p>-    </div>-  </body>-</html>
− resources/templates/details.tpl 
@@ -1,30 +0,0 @@-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">-<html xmlns="http://www.w3.org/1999/xhtml">-  <head>-    <title>mysnapsessions Sample Application</title>-    <link rel="stylesheet" type="text/css" href="screen.css"/>-  </head>-  <body>-    <div id="content">-      <h1>Drat!</h1>-      <p>-        Well, perhaps you can help me learn for next time.-      </p>-      <form method="POST" action="/$(dlgid)">-      <p>-        What was the right answer?-        <br/><input type="text" name="newAnimal" value="" />-      </p>-      <p>-        What is a question that distinguishes your animal from a(n) <oldAnimal/>?-        <br/><input type="text" name="question" value="" />-      </p>-      <p>-        Finally, what is the correct answer for your animal?<br/>-        <input type="submit" name="answer" value="yes" />-        <input type="submit" name="answer" value="no" />-      </p>-      </form>-    </div>-  </body>-</html>
− resources/templates/goAgain.tpl 
@@ -1,21 +0,0 @@-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">-<html xmlns="http://www.w3.org/1999/xhtml">-  <head>-    <title>mysnapsessions Sample Application</title>-    <link rel="stylesheet" type="text/css" href="screen.css"/>-  </head>-  <body>-    <div id="content">-      <h1>All done.</h1>-      <p>-        That was fun!  Would you like to play again?-      </p>-      <form method="POST" action="/$(dlgid)">-      <p>-        <input type="submit" name="answer" value="yes" />-        <input type="submit" name="answer" value="no" />-      </p>-      </form>-    </div>-  </body>-</html>
− resources/templates/guess.tpl 
@@ -1,21 +0,0 @@-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">-<html xmlns="http://www.w3.org/1999/xhtml">-  <head>-    <title>mysnapsessions Sample Application</title>-    <link rel="stylesheet" type="text/css" href="screen.css"/>-  </head>-  <body>-    <div id="content">-      <h1>I've got it!</h1>-      <p>-        I guess: <b><animal/></b>  Am I right?-      </p>-      <form method="POST" action="/$(dlgid)">-      <p>-        <input type="submit" name="answer" value="yes" />-        <input type="submit" name="answer" value="no" />-      </p>-      </form>-    </div>-  </body>-</html>
− resources/templates/index.tpl 
@@ -1,22 +0,0 @@-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">-<html xmlns="http://www.w3.org/1999/xhtml">-  <head>-    <title>mysnapsessions Sample Application</title>-    <link rel="stylesheet" type="text/css" href="screen.css"/>-  </head>-  <body>-    <div id="content">-      <h1>Welcome!</h1>-      <p>-        This simple application demonstrates the continuation-based programming-        model in the <code>mysnapsessions</code> package.  You'll be asked to-        think of an animal, and the application will try to guess it.  The-        state of the game is stored in your session, so it's not shared between-        users.-      </p>-      <p>-        <a href="/animal">get started!</a>-      </p>-    </div>-  </body>-</html>
− resources/templates/question.tpl 
@@ -1,21 +0,0 @@-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">-<html xmlns="http://www.w3.org/1999/xhtml">-  <head>-    <title>mysnapsessions Sample Application</title>-    <link rel="stylesheet" type="text/css" href="screen.css"/>-  </head>-  <body>-    <div id="content">-      <h1>Hmm...</h1>-      <p>-        Next question: <b><question/></b>-      </p>-      <form method="POST" action="/$(dlgid)">-      <p>-        <input type="submit" name="answer" value="yes" />-        <input type="submit" name="answer" value="no" />-      </p>-      </form>-    </div>-  </body>-</html>
− resources/templates/rules.tpl 
@@ -1,20 +0,0 @@-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">-<html xmlns="http://www.w3.org/1999/xhtml">-  <head>-    <title>mysnapsessions Sample Application</title>-    <link rel="stylesheet" type="text/css" href="screen.css"/>-  </head>-  <body>-    <div id="content">-      <h1>Rules</h1>-      <p>-        Think of an animal, and click OK to get started when you are ready.-      </p>-      <form method="POST" action="/$(dlgid)">-      <p>-        <input type="submit" value="Continue" />-      </p>-      </form>-    </div>-  </body>-</html>
− src/Application.hs 
@@ -1,50 +0,0 @@-{-# LANGUAGE TypeFamilies #-}--{---This module defines our application's monad and any application-specific-information it requires.---}--module Application (-    App,-    appInitializer,-    AppSession(..)-    ) where--import Snap.Extension-import Snap.Extension.Heist.Impl-import Snap.Extension.Session.Memory-import Snap.Extension.Dialogues--type App = SnapExtend AppState--data AppState = AppState {-    templateState :: HeistState App,-    sessionMgr    :: MemorySessionManager AppSession-    }--instance HasHeistState App AppState where-    getHeistState     = templateState-    setHeistState s a = a { templateState = s }--instance HasMemorySessionManager AppState where-    type MemorySessionValue AppState = AppSession-    memorySessionMgr = sessionMgr--data AppSession = AppSession {-    dlgManager :: DlgManager App-    }--instance HasDlgManager App AppSession where-    getDlgManager = dlgManager--appInitializer :: Initializer AppState-appInitializer = do-    heist    <- heistInitializer "resources/templates"-    sessions <- memorySessionInitializer 1800 newSession-    return $ AppState heist sessions-  where-    newSession = fmap AppSession makeDlgManager-
− src/Main.hs 
@@ -1,8 +0,0 @@-module Main where--import           Snap.Extension.Server-import           Application-import           Site--main :: IO ()-main = quickHttpServe appInitializer site
− src/Site.hs 
@@ -1,91 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Site (site) where--import Data.ByteString.Char8 (ByteString)-import Control.Applicative-import Control.Monad-import Snap.Extension.Heist-import Snap.Extension.Dialogues-import Snap.Util.FileServe-import Snap.Types-import Text.Templating.Heist--import Application--data DiKey = Answer   ByteString-           | Question ByteString DiKey DiKey--startingKey = Answer "elephant"--animalGame key = do-    rulePage-    key'  <- question key-    again <- goAgainPage-    if again then animalGame key' else conclusionPage--question (Answer s) = do-    correct <- guessPage s-    if correct then return (Answer s)-               else do-        (anim, newq, newa) <- detailsPage s-        if newa then return (Question newq (Answer anim) (Answer s))-                else return (Question newq (Answer s) (Answer anim))--question (Question q y n) = do-    ans <- questionPage q-    if ans then do y' <- question y-                   return (Question q y' n)-           else do n' <- question n-                   return (Question q y n')--rulePage = showPage build parse-  where-    build t = heistLocal (bindStrings [("dlgid", t)]) $ render "rules"-    parse   = return ()--conclusionPage = showPage build parse-  where-    build t = heistLocal (bindStrings [("dlgid", t)]) $ render "conclusion"-    parse   = return ()--goAgainPage = showPage build parse-  where-    build t = heistLocal (bindStrings [("dlgid", t)]) $ render "goAgain"-    parse   = do p <- getParam "answer"-                 case p of Just "yes" -> return True-                           _          -> return False--guessPage animal = showPage build parse-  where-    build t = heistLocal (bindStrings-                 [("dlgid", t), ("animal", animal)]) $ render "guess"-    parse   = do p <- getParam "answer"-                 case p of Just "yes" -> return True-                           _          -> return False--questionPage q = showPage build parse-  where-    build t = heistLocal (bindStrings-                 [("dlgid", t), ("question", q)]) $ render "question"-    parse   = do p <- getParam "answer"-                 case p of Just "yes" -> return True-                           _          -> return False--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-        let answer = case answerStr of "yes" -> True-                                       _     -> False-        return (newAnimal, question, answer)--site :: App ()-site = ifTop (render "index")-       <|> dialogue "animal" (animalGame startingKey)-       <|> fileServe "resources/static"-