packages feed

redHandlers-0.1: Example/HtmlExample.hs

module Main where

import Text.XHtml.Strict
import Network.HTTP.RedHandler

-----------------------------------------------
-- Main daemon and port
-----------------------------------------------
main :: IO ()
main = runHttpServer 8080 mainHandlers

-----------------------------------------------
-- Routes and handlers
-----------------------------------------------
mainHandlers :: [IORqHandler BasicRsp]
mainHandlers = map (modResp htmlRespToRsp) [greetHandler, inputFormHandler]

inputFormHandler :: IORqHandler (HandlerRsp Html)
inputFormHandler = okHtml $ page "Handlers Example" inputForm

greetHandler :: IORqHandler (HandlerRsp Html)
greetHandler =  ifPost $ 
                 withPostField "name" (\n -> if null n 
                                               then notMe 
                                               else okHtml (page "Handlers Example" (greet n))
                                       )


inputForm :: Html
inputForm = form![method "post"] << [paragraph << ("My name is " +++ textfield "name"),
                     submit "" "Submit"]

greet :: String -> Html 
greet n = paragraph << ("Hello " ++ n ++ "!")
 
page t b = header << thetitle << t +++ body << b


-----------------------------------------------
-- Utilities for Html responses
-----------------------------------------------
okHtml :: Monad m => Html -> RqHandlerT m (HandlerRsp Html)
okHtml = return . return

htmlRespToRsp :: HandlerRsp Html -> BasicRsp
htmlRespToRsp = basicRspWith prettyHtmlFragment