Common.hs

module Lucienne.View.Common
  ( Infos, Errors, template, stringHtml, cstringHtml, stringValue, preescapedStringHtml
  , symbol, form, hidden, button, setTitle)
where

import           Control.Monad (when)
import           Data.CompactString.UTF8 (CompactString,unpack)
import           Text.Blaze ((!))
import qualified Text.Blaze.Html4.Strict as H
import qualified Text.Blaze.Html4.Strict.Attributes as A
import           Lucienne.Constant (programName)

type Infos  = [String]
type Errors = [String]

template :: String -> Infos -> Errors -> H.Html -> H.Html
template title infos errors body =
  H.docTypeHtml $
   do H.head $ 
       do H.title $ stringHtml title'
          H.meta ! A.httpEquiv "Content-Type" ! A.content "text/html;charset=utf-8"
          H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "/static/css.css"
          H.script ! A.src "/static/js.js" ! A.type_ "text/javascript" $ return ()
      H.body $ do
       when (not . null $ errors) $ showErrors errors
       when (not . null $ infos)  $ showInfos  infos
       body
       
  where
    title' = if null title then programName else unwords [programName,"-",title]

showInfos :: Infos -> H.Html
showInfos infos = 
  H.div ! A.class_ "infoBox" $ do
    H.strong $ H.toHtml ("Information" :: String)
    H.br
    H.ul $ mapM_ showInfo infos  

showErrors :: Errors -> H.Html
showErrors errors =
  H.div ! A.class_ "errorBox" $ do
    H.strong $ H.toHtml ("Error" :: String)
    H.br
    H.ul $ mapM_ showError errors  

showInfo :: String -> H.Html
showInfo = H.li . H.toHtml

showError :: String -> H.Html
showError = H.li . H.toHtml

stringHtml :: String -> H.Html
stringHtml = H.toHtml

cstringHtml :: CompactString -> H.Html
cstringHtml = H.toHtml . unpack

stringValue :: String -> H.AttributeValue
stringValue = H.toValue

preescapedStringHtml :: String -> H.Html
preescapedStringHtml = H.preEscapedString

symbol :: String -> H.Html  
symbol code = H.span ! A.class_ "symbol" $ preescapedStringHtml code

form :: String -> H.Html -> H.Html
form destination nested = 
  H.form ! A.action (stringValue destination) 
  ! A.method "post" ! A.enctype "multipart/form-data" $ nested
  
hidden :: String -> String -> H.Html
hidden name value = 
  H.input ! A.type_ "hidden" ! A.name (stringValue name) ! A.value (stringValue value)
  
button :: String -> String -> Maybe String -> H.Html
button name label = 
  let b = H.input ! A.type_ "submit" ! A.name  (stringValue name)
          ! A.value (stringValue label)
  in
   maybe b (\accessKey -> b ! A.accesskey (stringValue accessKey))

setTitle :: String -> H.Html -> H.Html
setTitle title html = html ! A.title (stringValue title)