Permalink
Browse files

Beginning switch to mustache templates.

  • Loading branch information...
1 parent ab8bc62 commit 35f2082b049be7908e70cfec3a43c50bc132ec9d @clanehin committed Sep 25, 2012
View
35 Roguestar/Lib/HTML/Mustache.hs
@@ -0,0 +1,35 @@
+
+module Roguestar.Lib.HTML.Mustache (renderPage, roguestar_muconfig) where
+
+import Text.Hastache
+import Data.ByteString as BS
+import Data.Text.Lazy as T
+import Data.Aeson as Aeson
+import Data.Attoparsec.Number as AesonNumber
+import Data.HashMap.Strict as Map
+import Data.Vector as V
+import Data.Text.Encoding as Encoding
+import Data.Text.Lazy.Encoding as LazyEncoding
+import Control.Monad
+
+roguestar_muconfig :: MuConfig
+roguestar_muconfig = MuConfig {
+ muEscapeFunc = htmlEscape,
+ muTemplateFileDir = Just "static/",
+ muTemplateFileExt = Just ".mustache" }
+
+mkAesonContext :: (Monad m) => Aeson.Value -> MuContext m
+mkAesonContext (Object obj) key = maybe MuNothing aesonToMu $ Map.lookup (Encoding.decodeUtf8 key) obj
+mkAesonContext x _ = aesonToMu x
+
+aesonToMu :: (Monad m) => Aeson.Value -> MuType m
+aesonToMu obj@(Object {}) = MuList [mkAesonContext obj]
+aesonToMu (Array arr) = MuList $ Prelude.map mkAesonContext $ V.toList arr
+aesonToMu (String txt) = MuVariable txt
+aesonToMu (Number (I num)) = MuVariable num
+aesonToMu (Number (D num)) = MuVariable num
+aesonToMu (Bool bool) = MuBool bool
+aesonToMu Null = MuNothing
+
+renderPage :: FilePath -> Aeson.Value -> IO T.Text
+renderPage filepath value = liftM LazyEncoding.decodeUtf8 $ hastacheFile roguestar_muconfig filepath (mkAesonContext value)
View
35 Roguestar/Server/Main.hs
@@ -4,6 +4,7 @@ import Prelude
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
import Data.Text.Read
import Data.Text.Encoding
import qualified Text.XHtmlCombinators.Escape as XH
@@ -43,13 +44,16 @@ import Roguestar.Lib.Facing
import Roguestar.Lib.Logging
import Roguestar.Lib.UnitTests
import Roguestar.Lib.DBData (Reference,ToolRef,toUID)
+import Roguestar.Lib.HTML.Mustache
import Data.UUID
import qualified System.UUID.V4 as V4
import GHC.Stats
+import Data.Aeson as Aeson
data App = App {
_heist :: Snaplet (Heist App),
- _app_game_state :: GameState }
+ _app_game_state :: GameState,
+ _globals :: Aeson.Value }
makeLenses [''App]
@@ -58,21 +62,29 @@ instance HasHeist App where heistLens = subSnaplet heist
appInit :: SnapletInit App App
appInit = makeSnaplet "roguestar-server-snaplet" "Roguestar Server" Nothing $
do hs <- nestSnaplet "heist" heist $ heistInit "templates"
- (unit_test_result,unit_tests_passed) <- liftIO runTests
+ globals <- liftIO makeGlobals
addRoutes [("/start", start),
("/play", play),
("/static", static),
("/hidden", handle404),
("/fail", handle500 (do error "my brain exploded")),
- ("/feedback", feedback),
+ ("/feedback", postFeedback <|> staticTemplate "static/feedback.mustache"),
+ ("/feedback-thanks", staticTemplate "static/feedback-thanks.mustache"),
("/options", options),
- ("/unit", writeText unit_test_result),
+ ("", staticTemplate "static/index.mustache"),
("", heistServe)]
config <- liftIO $ getConfiguration default_timeout
game <- liftIO $ createGameState config
wrapSite (<|> handle404)
wrapSite handle500
- return $ App hs game
+ return $ App hs game globals
+
+makeGlobals :: IO Aeson.Value
+makeGlobals =
+ do (unit_test_result,unit_tests_passed) <- liftIO runTests
+ return $ object $ concat $ [
+ (if not unit_tests_passed then ["failed_unit_tests" .= object ["text_content" .= String unit_test_result]] else [])
+ ]
handle500 :: MonadSnap m => m a -> m ()
handle500 m = (m >> return ()) `CatchIO.catch` \(e::SomeException) -> do
@@ -91,13 +103,20 @@ handle500 m = (m >> return ()) `CatchIO.catch` \(e::SomeException) -> do
handle404 :: Handler App App ()
handle404 =
do modifyResponse $ setResponseCode 404
- render "404"
+ globals <- gets _globals
+ writeLazyText =<< liftIO (renderPage "static/404.mustache" globals)
static :: Handler App App ()
static = serveDirectory "./static/"
-feedback :: Handler App App ()
-feedback = method POST $
+staticTemplate :: FilePath -> Handler App App ()
+staticTemplate filepath = method GET $ ifTop $
+ do globals <- gets _globals
+ t <- liftIO $ renderPage filepath globals
+ writeLazyText t
+
+postFeedback :: Handler App App ()
+postFeedback = method POST $ ifTop $
do feedback <- liftM (fromMaybe $ error "No feedback.") $ getPostParam "feedback"
liftIO $
do uuid <- V4.uuid
View
16 roguestar.cabal
@@ -15,7 +15,7 @@ tested-with: GHC ==7.4.1
executable roguestar-server
Main-is: Roguestar/Server/Main.hs
hs-source-dirs: .
- build-depends:
+ build-depends: aeson >= 0.6.0.2,
snap >=0.8,
snap-core >=0.8,
snap-server >= 0.8,
@@ -35,10 +35,16 @@ executable roguestar-server
ghc-options: -threaded -fno-warn-type-defaults -rtsopts=all
else
ghc-options: -threaded -fno-warn-type-defaults
+ other-modules: Roguestar.Lib.HTML.Mustache
library
hs-source-dirs: .
- build-depends: hslogger >=1.1.0,
+ build-depends: aeson >= 0.6.0.2,
+ attoparsec >= 0.10.2.0,
+ vector >= 0.9.1,
+ unordered-containers >= 0.2.2.0,
+ hastache >= 0.4.2,
+ hslogger >=1.1.0,
bytestring >=0.9.1.5,
parallel >=2.2.0.1,
stm >=2.1.1.2,
@@ -99,12 +105,14 @@ library
Roguestar.Lib.Logging,
Roguestar.Lib.CharacterAdvancement,
Roguestar.Lib.PersistantData,
- Roguestar.Lib.PowerUpData
+ Roguestar.Lib.PowerUpData,
+ Roguestar.Lib.HTML.Mustache
ghc-prof-options: -prof -auto-all
ghc-shared-options: -prof -auto-all
if impl(ghc >= 7.0)
ghc-options: -threaded -fno-warn-type-defaults -rtsopts=all
else
ghc-options: -threaded -fno-warn-type-defaults
- exposed-modules: Roguestar.Lib.UnitTests
+ exposed-modules: Roguestar.Lib.UnitTests,
+ Roguestar.Lib.Roguestar
View
6 snaplets/heist/templates/404.tpl → static/404.mustache
@@ -1,7 +1,9 @@
-<apply template="/hidden/context">
+{{> header}}
+
<div id="documenttext" class="roguebox">
<h1>404 Not Found</h1>
<p>You has a sad roguestar :(</p>
</div>
-</apply>
+
+{{> footer}}
View
4 snaplets/heist/templates/feedback-thanks.tpl → static/feedback-thanks.mustache
@@ -1,4 +1,4 @@
-<apply template="/hidden/context">
+{{> header}}
<div class="documenttext">
@@ -8,4 +8,4 @@
</div>
-</apply>
+{{> footer}}
View
4 snaplets/heist/templates/feedback.tpl → static/feedback.mustache
@@ -1,4 +1,4 @@
-<apply template="/hidden/context">
+{{> header}}
<div class="documenttext">
@@ -13,4 +13,4 @@ Please enter your comments here. Thank you for your time and insight.
</div>
-</apply>
+{{footer}}
View
4 static/footer.mustache
@@ -0,0 +1,4 @@
+ </div>
+ </body>
+</html>
+
View
20 static/header.mustache
@@ -0,0 +1,20 @@
+<!DOCTYPE html>
+
+<html>
+ <head>
+ <title>Roguestar</title>
+ <link rel="stylesheet" type="text/css" href="/static/roguebasic.css"/>
+ </head>
+ <body>
+ <div id="main">
+ <div id="menu">
+ <ul>
+ <li><a id="menu-home" href="/">Home</a></li>
+ <li><a id="menu-play" href="/play">Play</a></li>
+ <li><a id="menu-contribute" href="/contribute">Contribute</a></li>
+ <li><a id="menu-blog" href="http://blog.downstairspeople.org/">Blog</a></li>
+ <li class="right"><a id="menu-options" href="/options">Options</a></li>
+ <li class="right"><a id="menu-help" href="/help">Help</a></li>
+ </ul>
+ </div>
+
View
13 snaplets/heist/templates/index.tpl → static/index.mustache
@@ -1,8 +1,17 @@
-<apply template="/hidden/context">
+{{> header}}
<div id="documenttext" class="roguebox">
<h1>Roguestar</h1>
<p>Roguestar is a text-based tactical role-playing game set in a science-fiction universe. You can begin playing right now, in your web browser: <a href="/play/">Play Now</a>.<p>
+
+{{#failed_unit_tests}}
+<p>One or more unit tests failed:</p>
+<pre>
+{{{text_content}}}
+</pre>
+{{/failed_unit_tests}}
+
</div>
-</apply>
+
+{{> footer}}
View
66 static/play.mustache
@@ -0,0 +1,66 @@
+{{> header}}
+
+<div id="magicbox">
+
+<div id="gameplaybox" class="roguebox">
+ {{{map}}}
+ <a href="/help-map" class="help">?</a>
+</div>
+
+<div id="messagebox" class="roguebox">
+ {{#messages}}
+ <p>{{{text}}}
+ {{/messages}}
+</div>
+
+<div id="controls" class="roguebox">
+ {{#stats}}
+ {{{text}}}
+ {{/stats}}
+<form action="/play/move" method="post">
+
+<div>
+<select name="mode">
+<option value="normal" selected="selected">Normal</option>
+<!--
+<option value="attack">Attack</option>
+<option value="fire">Fire</option>
+-->
+<option value="jump">Teleport</option>
+</select>
+</div>
+
+<div>
+<div class="buttonrow">
+<button type="submit" name="direction" value="nw">NorthWest</button>
+<button type="submit" name="direction" value="n">North</button>
+<button type="submit" name="direction" value="ne">NorthEast</button>
+</div>
+
+<div class="buttonrow">
+<button type="submit" name="direction" value="w">West</button>
+<button type="submit" name="direction" value="wait">Wait</button>
+<button type="submit" name="direction" value="e">East</button>
+</div>
+
+<div class="buttonrow">
+<button type="submit" name="direction" value="sw">SouthWest</button>
+<button type="submit" name="direction" value="s">South</button>
+<button type="submit" name="direction" value="se">SouthEast</button>
+</div>
+</div>
+
+<a href="/help-actions" class="help">?</a>
+
+</form>
+
+<!--
+<form action="/play/inventory" method="get">
+<button type="submit">Inventory</button>
+</form>
+-->
+</div>
+
+</div>
+
+{{> footer}}

0 comments on commit 35f2082

Please sign in to comment.