Initial commit
Getty Ritter
10 years ago
| 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
|