gdritter repos unalaq / bc854a6
Initial commit Getty Ritter 5 years ago
3 changed file(s) with 94 addition(s) and 0 deletion(s). Collapse all Expand all
1 {-# LANGUAGE OverloadedStrings #-}
2 module Main where
3
4 import Control.Applicative
5 import Snap.Core
6 import Snap.Util.FileServe
7 import Snap.Http.Server
8 import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)
9
10 import Template
11
12 main :: IO ()
13 main = quickHttpServe site
14
15 site :: Snap ()
16 site =
17 ifTop (writeBuilder $ renderHtmlBuilder $ page $ bigPane) <|>
18 route [ ("foo", writeBS "bar")
19 , ("echo/:echoparam", echoHandler)
20 ] <|>
21 dir "static" (serveDirectory ".")
22
23 echoHandler :: Snap ()
24 echoHandler = do
25 param <- getParam "echoparam"
26 maybe (writeBS "must specify echo/param in URL")
27 writeBS param
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Template(page, bigPane, littlePane) where
4
5 import Control.Monad (void)
6 import Prelude (String, ($), (++), (==), (.), sequence, show)
7 import qualified Prelude as P
8 import Text.Blaze.Internal (stringValue)
9 import Text.Blaze.Html5
10 import Text.Blaze.Html5.Attributes hiding (title)
11
12 page :: Html -> Html
13 page contents = docTypeHtml $ do
14 head $ do
15 meta ! charset "utf-8"
16 title ""
17 body $ do
18 div ! class_ "main" $ contents
19
20 table' :: [Html] -> Html
21 table' = table . void . sequence
22
23 tr' :: [Html] -> Html
24 tr' = tr . void . sequence
25
26 bigPane :: Html
27 bigPane = table' [ tr' [ td ! dataAttribute "x" (stringValue (show x))
28 ! dataAttribute "y" (stringValue (show y))
29 $ "[]"
30 | x <- [0..15]
31 ]
32 | y <- [0..15]
33 ]
34
35 littlePane :: Html
36 littlePane = P.undefined
1 Name: unalaq
2 Version: 0.1
3 Synopsis: Project Synopsis Here
4 Description: Project Description Here
5 License: AllRightsReserved
6 Author: Author
7 Maintainer: maintainer@example.com
8 Stability: Experimental
9 Category: Web
10 Build-type: Simple
11 Cabal-version: >=1.2
12
13 Executable unalaq
14 hs-source-dirs: src
15 main-is: Main.hs
16
17 Build-depends:
18 base >= 4 && < 5,
19 bytestring >= 0.9.1 && < 0.11,
20 MonadCatchIO-transformers >= 0.2.1 && < 0.4,
21 mtl >= 2 && < 3,
22 snap-core >= 0.9 && < 0.10,
23 snap-server >= 0.9 && < 0.10,
24 blaze-html,
25 blaze-markup
26
27 if impl(ghc >= 6.12.0)
28 ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
29 -fno-warn-unused-do-bind
30 else
31 ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2