{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Text.Blaze.DTC where -- import Control.Monad (Monad(..)) import Data.Bool import Data.Eq (Eq) import Data.Function (($), (.)) import Data.Int (Int) import Data.Maybe (Maybe(..)) import Data.Text (Text) import Text.Blaze import Text.Blaze.Internal import Text.Show (Show(..)) import Text.Blaze.Utils import Text.Blaze.DTC.Attributes -- * Type 'DTC' type DTC = Markup xmlModel :: Text -> DTC xmlModel rnc = Leaf "xml-model" "<?xml-model" "?>\n" () ! attribute "type" " type=\"" "application/relax-ng-compact-syntax" ! attribute "href" " href=\"" (attrValue rnc) xmlStylesheet :: Text -> DTC xmlStylesheet xsl = Leaf "xml-stylesheet" "<?xml-stylesheet" "?>\n" () ! attribute "type" " type=\"" "text/xsl" ! attribute "href" " href=\"" (attrValue xsl) html5Stylesheet :: Text -> DTC html5Stylesheet xsl = Leaf "html5-stylesheet" "<?html5-stylesheet" "?>\n" () ! attribute "type" " type=\"" "text/xsl" ! attribute "href" " href=\"" (attrValue xsl) atomStylesheet :: Text -> DTC atomStylesheet xsl = Leaf "atom-stylesheet" "<?atom-stylesheet" "?>\n" () ! attribute "type" " type=\"" "text/xsl" ! attribute "href" " href=\"" (attrValue xsl) about :: DTC -> DTC about = Parent "about" "<about" "</about>" address :: DTC -> DTC address = Parent "address" "<address" "</address>" author :: DTC -> DTC author = Parent "author" "<author" "</author>" b :: DTC -> DTC b = Parent "b" "<b" "</b>" br :: DTC br = Leaf "br" "<br" " />" () call :: DTC -> DTC call = Parent "call" "<call" "</call>" code :: DTC -> DTC code = Parent "code" "<code" "</code>" -- * Type 'Date' data Date = Date { date_year :: Int , date_month :: Maybe Int , date_day :: Maybe Int } deriving (Eq,Show) date :: Date -> DTC date Date{..} = Leaf "date" "<date" "/>" () ! attribute "year" " year=\"" (attrValue date_year) !?? (date_month, attribute "month" " month=\"" . attrValue) !?? (date_day, attribute "day" " day=\"" . attrValue) define :: DTC -> DTC define = Parent "define" "<define" "</define>" document :: DTC -> DTC document = Parent "document" "<document" "</document>" editor :: DTC -> DTC editor = Parent "editor" "<editor" "</editor>" email :: DTC -> DTC email = Parent "email" "<email" "</email>" eref :: DTC -> DTC eref = Parent "eref" "<eref" "</eref>" i :: DTC -> DTC i = Parent "i" "<i" "</i>" include :: Bool -> AttributeValue -> DTC include inc h = Leaf "include" "<include" "/>" () !? (not inc, attribute "include" " include=\"" "no") ! href h keyword :: DTC -> DTC keyword = Parent "keyword" "<keyword" "</keyword>" li :: DTC -> DTC li = Parent "li" "<li" "</li>" link :: DTC -> DTC link = Parent "link" "<link" "</link>" macro :: DTC -> DTC macro = Parent "macro" "<macro" "</macro>" name :: DTC -> DTC name = Parent "name" "<name" "</name>" note :: DTC -> DTC note = Parent "note" "<note" "</note>" ol :: DTC -> DTC ol = Parent "ol" "<ol" "</ol>" organization :: DTC -> DTC organization = Parent "organization" "<organization" "</organization>" para :: DTC -> DTC para = Parent "para" "<para" "</para>" q :: DTC -> DTC q = Parent "q" "<q" "</q>" quote :: DTC -> DTC quote = Parent "quote" "<quote" "</quote>" ref :: DTC -> DTC ref (Empty a) = Leaf "ref" "<ref" "/>" a ref x = Parent "ref" "<ref" "</ref>" x reference :: DTC -> DTC reference = Parent "reference" "<reference" "</reference>" references :: DTC -> DTC references = Parent "references" "<references" "</references>" rref :: DTC -> DTC rref = Parent "rref" "<rref" "</rref>" section :: DTC -> DTC section = Parent "section" "<section" "</section>" ul :: DTC -> DTC ul = Parent "ul" "<ul" "</ul>" -- * Type 'Postal' data Postal = Postal { postal_street :: Text , postal_zipcode :: Text , postal_city :: Text , postal_region :: Text , postal_country :: Text } deriving (Eq,Show) postal :: Postal -> DTC postal Postal{..} = Parent "postal" "<postal" "</postal>" $ do Parent "street" "<street" "</street>" $ toMarkup postal_street Parent "zipcode" "<zipcode" "</zipcode>" $ toMarkup postal_zipcode Parent "city" "<city" "</city>" $ toMarkup postal_city Parent "region" "<region" "</region>" $ toMarkup postal_region Parent "country" "<country" "</country>" $ toMarkup postal_country indentTag :: Text -> IndentTag indentTag t = case t of "about" -> IndentTagChildren "address" -> IndentTagChildren "author" -> IndentTagChildren "document" -> IndentTagChildren "ol" -> IndentTagChildren "postal" -> IndentTagChildren "section" -> IndentTagChildren "ul" -> IndentTagChildren "b" -> IndentTagText "i" -> IndentTagText "li" -> IndentTagText "para" -> IndentTagText "quote" -> IndentTagText "note" -> IndentTagText _ -> IndentTagPreserve