Text/Blaze/DTC.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE RecordWildCards #-}
   3 module Text.Blaze.DTC where
   4
   5 import Data.Bool
   6 import Data.Eq (Eq)
   7 import Data.Function (($), (.))
   8 import Data.Int (Int)
   9 import Data.Maybe (Maybe(..))
  10 import Data.Text (Text)
  11 import Text.Blaze
  12 import Text.Blaze.Internal
  13 import Text.Show (Show(..))
  14
  15 import Text.Blaze.Utils
  16 import Text.Blaze.DTC.Attributes
  17
  18 -- * Type 'DTC'
  19 type DTC = Markup
  20
  21 xmlModel :: Text -> DTC
  22 xmlModel rnc =
  23         Leaf "xml-model" "<?xml-model" "?>\n" ()
  24          ! attribute "type" " type=\"" "application/relax-ng-compact-syntax"
  25          ! attribute "href" " href=\"" (attrValue rnc)
  26
  27 xmlStylesheet :: Text -> DTC
  28 xmlStylesheet xsl =
  29         Leaf "xml-stylesheet" "<?xml-stylesheet" "?>\n" ()
  30          ! attribute "type" " type=\"" "text/xsl"
  31          ! attribute "href" " href=\"" (attrValue xsl)
  32
  33 html5Stylesheet :: Text -> DTC
  34 html5Stylesheet xsl =
  35         Leaf "html5-stylesheet" "<?html5-stylesheet" "?>\n" ()
  36          ! attribute "type" " type=\"" "text/xsl"
  37          ! attribute "href" " href=\"" (attrValue xsl)
  38
  39 atomStylesheet :: Text -> DTC
  40 atomStylesheet xsl =
  41         Leaf "atom-stylesheet" "<?atom-stylesheet" "?>\n" ()
  42          ! attribute "type" " type=\"" "text/xsl"
  43          ! attribute "href" " href=\"" (attrValue xsl)
  44
  45 about :: DTC -> DTC
  46 about = Parent "about" "<about" "</about>"
  47 address :: DTC -> DTC
  48 address = Parent "address" "<address" "</address>"
  49 author :: DTC -> DTC
  50 author = Parent "author" "<author" "</author>"
  51 b :: DTC -> DTC
  52 b = Parent "b" "<b" "</b>"
  53 br :: DTC
  54 br = Leaf "br" "<br" " />" ()
  55 call :: DTC -> DTC
  56 call = Parent "call" "<call" "</call>"
  57 code :: DTC -> DTC
  58 code = Parent "code" "<code" "</code>"
  59
  60 -- * Type 'Date'
  61 data Date
  62  =   Date
  63  {   date_year  :: Int
  64  ,   date_month :: Maybe Int
  65  ,   date_day   :: Maybe Int
  66  } deriving (Eq,Show)
  67 date :: Date -> DTC
  68 date Date{..} =
  69         Leaf "date" "<date" "/>" ()
  70          ! attribute "year" " year=\"" (attrValue date_year)
  71          !?? (date_month, attribute "month" " month=\"" . attrValue)
  72          !?? (date_day, attribute "day" " day=\"" . attrValue)
  73
  74 define :: DTC -> DTC
  75 define = Parent "define" "<define" "</define>"
  76 document :: DTC -> DTC
  77 document = Parent "document" "<document" "</document>"
  78 editor :: DTC -> DTC
  79 editor = Parent "editor" "<editor" "</editor>"
  80 email :: DTC -> DTC
  81 email = Parent "email" "<email" "</email>"
  82 eref :: DTC -> DTC
  83 eref = Parent "eref" "<eref" "</eref>"
  84 i :: DTC -> DTC
  85 i = Parent "i" "<i" "</i>"
  86 include :: Bool -> AttributeValue -> DTC
  87 include inc h =
  88         Leaf "include" "<include" "/>" ()
  89          !? (not inc, attribute "include" " include=\"" "no")
  90          ! href h
  91 keyword :: DTC -> DTC
  92 keyword = Parent "keyword" "<keyword" "</keyword>"
  93 li :: DTC -> DTC
  94 li = Parent "li" "<li" "</li>"
  95 link :: DTC -> DTC
  96 link = Parent "link" "<link" "</link>"
  97 macro :: DTC -> DTC
  98 macro = Parent "macro" "<macro" "</macro>"
  99 name :: DTC -> DTC
 100 name = Parent "name" "<name" "</name>"
 101 note :: DTC -> DTC
 102 note = Parent "note" "<note" "</note>"
 103 ol :: DTC -> DTC
 104 ol = Parent "ol" "<ol" "</ol>"
 105 organization :: DTC -> DTC
 106 organization = Parent "organization" "<organization" "</organization>"
 107 para :: DTC -> DTC
 108 para = Parent "para" "<para" "</para>"
 109 q :: DTC -> DTC
 110 q = Parent "q" "<q" "</q>"
 111 quote :: DTC -> DTC
 112 quote = Parent "quote" "<quote" "</quote>"
 113 ref :: DTC -> DTC
 114 ref (Empty a) = Leaf "ref" "<ref" "/>" a
 115 ref x = Parent "ref" "<ref" "</ref>" x
 116 reference :: DTC -> DTC
 117 reference = Parent "reference" "<reference" "</reference>"
 118 references :: DTC -> DTC
 119 references = Parent "references" "<references" "</references>"
 120 rref :: DTC -> DTC
 121 rref = Parent "rref" "<rref" "</rref>"
 122 section :: DTC -> DTC
 123 section = Parent "section" "<section" "</section>"
 124 ul :: DTC -> DTC
 125 ul = Parent "ul" "<ul" "</ul>"
 126
 127 -- * Type 'Postal'
 128 data Postal
 129  =   Postal
 130  {   postal_street  :: Text
 131  ,   postal_zipcode :: Text
 132  ,   postal_city    :: Text
 133  ,   postal_region  :: Text
 134  ,   postal_country :: Text
 135  } deriving (Eq,Show)
 136 postal :: Postal -> DTC
 137 postal Postal{..} =
 138         Parent "postal" "<postal" "</postal>" $ do
 139                 Parent "street" "<street" "</street>"    $ toMarkup postal_street
 140                 Parent "zipcode" "<zipcode" "</zipcode>" $ toMarkup postal_zipcode
 141                 Parent "city" "<city" "</city>"          $ toMarkup postal_city
 142                 Parent "region" "<region" "</region>"    $ toMarkup postal_region
 143                 Parent "country" "<country" "</country>" $ toMarkup postal_country
 144
 145 indentTag :: Text -> IndentTag
 146 indentTag t =
 147         case t of
 148          "about"    -> IndentTagChildren
 149          "address"  -> IndentTagChildren
 150          "author"   -> IndentTagChildren
 151          "document" -> IndentTagChildren
 152          "ol"       -> IndentTagChildren
 153          "postal"   -> IndentTagChildren
 154          "section"  -> IndentTagChildren
 155          "ul"       -> IndentTagChildren
 156          "a"        -> IndentTagText
 157          "b"        -> IndentTagText
 158          "i"        -> IndentTagText
 159          "li"       -> IndentTagText
 160          "para"     -> IndentTagText
 161          "q"        -> IndentTagText
 162          "quote"    -> IndentTagText
 163          "note"     -> IndentTagText
 164          _          -> IndentTagPreserve