iterio-server-0.1: Examples/BasicSite.hs

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad.Trans
import qualified Data.ByteString.Lazy.Char8 as L
import Data.IterIO.HttpRoute
import Data.IterIO.Server.TCPServer
import Data.Monoid
import System.Random

import Text.Blaze.Renderer.Utf8 (renderHtml)
import Text.Blaze.Html5 hiding (param)
import Text.Blaze.Html5.Attributes

import Data.IterIO.Http.Support.Action
import Data.IterIO.Http.Support.Responses

main :: IO ()
main = runTCPServer httpServer

quotes :: [String]
quotes = [  
            "Now with more cowbell."
          , "Hot potato grand champion."
          , "Goes all the way to eleven."
          , "Does the Kessel Run in less than 12 parsecs."
          , "Will work for hugs."
          , "Ate a whole wheel of cheese."
          , "Fueled by Mountain Dew"
          , "Saw a MiG 28 do a 4g negative dive."
          , "Has never started a land war in Asia."
          , "Has, like, a ton of Facebook friends."
          , "Always chooses the write homophone."]

httpServer = simpleHttpServer 8080 $ runHttpRoute $ mconcat [
    routeTop $ routeAction welcomeAction
  , routeActionPattern "/factoid/:index" quoteAction
  , routeActionPattern "/factoid" indexAction
  ]

welcomeAction :: Action t IO ()
welcomeAction = do
  render "text/html" $ renderHtml $ docTypeHtml $ do
    body $ do
      h1 "Welcome to my simple site!"
      p $ do
        "Click "; a ! href "/factoid" $ "here"; " to learn somethine about me."

indexAction :: Action t IO ()
indexAction = do
  idx <- liftIO $ getStdRandom (randomR (0,length quotes - 1)) 
  let quote = quotes !! idx
  render "text/html" $ renderHtml $ docTypeHtml $ do
    body $ do
      h1 "A Random quote:"
      p $ do
        "Johnny Carson "
        a ! href (toValue $ "/factoid/" ++ (show idx)) $ toHtml quote

quoteAction :: Action t IO ()
quoteAction = do
  (Just idx) <- param "index" 
  let quote = quotes !! (read $ (L.unpack . paramValue) idx)
  render "text/html" $ renderHtml $ docTypeHtml $ do
    body $ do
      h1 $ do "Johnny Carson "; toHtml quote
      p $ a ! href "/factoid" $ "Another random quote..."