web-page-0.2.0: test/Test.hs

-- |
-- Module:     Main
-- Copyright:  (c) 2014 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <ertesx@gmx.de>

module Main where

import qualified Text.Blaze.Html5 as H
import Clay hiding ((!))
import Control.Monad.State
import Data.Text (Text)
import Language.Javascript.JMacro
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Handler.Warp
import System.IO
import Text.Blaze.Html
import Web.Page
import Web.Page.GenId


myWidget :: (HasIdStream a, MonadState a m, MonadWidget Text Html m) => m ()
myWidget = do
    setTitle "Test page"

    myId <- newId

    addBody $
        H.h1 "My example page" <>
        H.p "My boring paragraph." ! domId myId

    addStyle $ idSel myId ? do
        background white
        color black

    addStyle $ idSel myId # ".groovy" ? do
        background darkblue
        color pink
        fontWeight bold

    addScriptLink "static/jquery.js"
    addScript [jmacro|
        fun init ->
            window.setTimeout
                (\() {
                    $("#" + `myId`).addClass("groovy");
                    $(".groovy").text("My grooooooovy paragraph!") })
                1000;

        $(init) |]


handler :: Application
handler req k | pathInfo req == ["static", "jquery.js"] = do
    let ctype = (hContentType, "text/javascript; charset=UTF-8")
    k (responseFile ok200 [ctype] "static/jquery.js" Nothing)

handler req k = do
    let w = execWriter (evalStateT myWidget (idsFrom ['a'..'z']))
        p = realiseInline (renderWidget (titleMajor ": ") w)

        hdrs = [(hContentType, "text/html; charset=UTF-8")]

    k (responseBuilder ok200 hdrs p)


main :: IO ()
main =
    run 8000 handler