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)