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 artwork :: DTC -> DTC
  50 artwork = Parent "artwork" "<artwork" "</artwork>"
  51 author :: DTC -> DTC
  52 author = Parent "author" "<author" "</author>"
  53 b :: DTC -> DTC
  54 b = Parent "b" "<b" "</b>"
  55 br :: DTC
  56 br = Leaf "br" "<br" " />" ()
  57 call :: DTC -> DTC
  58 call = Parent "call" "<call" "</call>"
  59 code :: DTC -> DTC
  60 code = Parent "code" "<code" "</code>"
  61
  62 -- * Type 'Date'
  63 data Date
  64  =   Date
  65  {   date_year  :: Int
  66  ,   date_month :: Maybe Int
  67  ,   date_day   :: Maybe Int
  68  } deriving (Eq,Show)
  69 date :: Date -> DTC
  70 date Date{..} =
  71         Leaf "date" "<date" "/>" ()
  72          ! attribute "year" " year=\"" (attrValue date_year)
  73          !?? (date_month, attribute "month" " month=\"" . attrValue)
  74          !?? (date_day, attribute "day" " day=\"" . attrValue)
  75
  76 define :: DTC -> DTC
  77 define = Parent "define" "<define" "</define>"
  78 document :: DTC -> DTC
  79 document = Parent "document" "<document" "</document>"
  80 editor :: DTC -> DTC
  81 editor = Parent "editor" "<editor" "</editor>"
  82 email :: DTC -> DTC
  83 email = Parent "email" "<email" "</email>"
  84 eref :: DTC -> DTC
  85 eref (Empty a) = Leaf "eref" "<eref" "/>" a
  86 eref x = Parent "eref" "<eref" "</eref>" x
  87 figure :: DTC -> DTC
  88 figure = Parent "figure" "<figure" "</figure>"
  89 i :: DTC -> DTC
  90 i = Parent "i" "<i" "</i>"
  91 include :: Bool -> AttributeValue -> DTC
  92 include inc h =
  93         Leaf "include" "<include" "/>" ()
  94          !? (not inc, attribute "include" " include=\"" "no")
  95          ! href h
  96 keyword :: DTC -> DTC
  97 keyword = Parent "keyword" "<keyword" "</keyword>"
  98 li :: DTC -> DTC
  99 li = Parent "li" "<li" "</li>"
 100 link :: DTC -> DTC
 101 link = Parent "link" "<link" "</link>"
 102 macro :: DTC -> DTC
 103 macro = Parent "macro" "<macro" "</macro>"
 104 name :: DTC -> DTC
 105 name = Parent "name" "<name" "</name>"
 106 note :: DTC -> DTC
 107 note = Parent "note" "<note" "</note>"
 108 ol :: DTC -> DTC
 109 ol = Parent "ol" "<ol" "</ol>"
 110 organization :: DTC -> DTC
 111 organization = Parent "organization" "<organization" "</organization>"
 112 para :: DTC -> DTC
 113 para = Parent "para" "<para" "</para>"
 114 q :: DTC -> DTC
 115 q = Parent "q" "<q" "</q>"
 116 quote :: DTC -> DTC
 117 quote = Parent "quote" "<quote" "</quote>"
 118 ref :: DTC -> DTC
 119 ref (Empty a) = Leaf "ref" "<ref" "/>" a
 120 ref x = Parent "ref" "<ref" "</ref>" x
 121 reference :: DTC -> DTC
 122 reference = Parent "reference" "<reference" "</reference>"
 123 references :: DTC -> DTC
 124 references = Parent "references" "<references" "</references>"
 125 rref :: DTC -> DTC
 126 rref (Empty a) = Leaf "rref" "<rref" "/>" a
 127 rref x = Parent "rref" "<rref" "</rref>" x
 128 section :: DTC -> DTC
 129 section = Parent "section" "<section" "</section>"
 130 ul :: DTC -> DTC
 131 ul = Parent "ul" "<ul" "</ul>"
 132
 133 -- * Type 'Postal'
 134 data Postal
 135  =   Postal
 136  {   postal_street  :: Text
 137  ,   postal_zipcode :: Text
 138  ,   postal_city    :: Text
 139  ,   postal_region  :: Text
 140  ,   postal_country :: Text
 141  } deriving (Eq,Show)
 142 postal :: Postal -> DTC
 143 postal Postal{..} =
 144         Parent "postal" "<postal" "</postal>" $ do
 145                 Parent "street" "<street" "</street>"    $ toMarkup postal_street
 146                 Parent "zipcode" "<zipcode" "</zipcode>" $ toMarkup postal_zipcode
 147                 Parent "city" "<city" "</city>"          $ toMarkup postal_city
 148                 Parent "region" "<region" "</region>"    $ toMarkup postal_region
 149                 Parent "country" "<country" "</country>" $ toMarkup postal_country
 150
 151 indentTag :: Text -> IndentTag
 152 indentTag t =
 153         case t of
 154          "about"      -> IndentTagChildren
 155          "address"    -> IndentTagChildren
 156          "author"     -> IndentTagChildren
 157          "document"   -> IndentTagChildren
 158          "editor"     -> IndentTagChildren
 159          "figure"     -> IndentTagChildren
 160          "ol"         -> IndentTagChildren
 161          "postal"     -> IndentTagChildren
 162          "reference"  -> IndentTagChildren
 163          "references" -> IndentTagChildren
 164          "section"    -> IndentTagChildren
 165          "ul"         -> IndentTagChildren
 166          "a"          -> IndentTagText
 167          "b"          -> IndentTagText
 168          "i"          -> IndentTagText
 169          "li"         -> IndentTagText
 170          "para"       -> IndentTagText
 171          "q"          -> IndentTagText
 172          "quote"      -> IndentTagText
 173          "note"       -> IndentTagText
 174          _            -> IndentTagPreserve
 175
 176 elems :: [Text]
 177 elems =
 178  [ "about"
 179  , "abstract"
 180  , "address"
 181  , "alias"
 182  , "annotation"
 183  , "area"
 184  , "artwork"
 185  , "aside"
 186  , "audio"
 187  , "author"
 188  , "authors"
 189  , "bcp14"
 190  , "br"
 191  , "call"
 192  , "city"
 193  , "code"
 194  , "comment"
 195  , "comments"
 196  , "country"
 197  , "date"
 198  , "dd"
 199  , "define"
 200  , "del"
 201  , "div"
 202  , "dl"
 203  , "document"
 204  , "dt"
 205  , "editor"
 206  , "email"
 207  , "embed"
 208  , "eref"
 209  , "fax"
 210  , "feed"
 211  , "feedback"
 212  , "figure"
 213  , "filter"
 214  , "format"
 215  , "from"
 216  , "h"
 217  , "hi"
 218  , "html5"
 219  , "i"
 220  , "index"
 221  , "iref"
 222  , "keyword"
 223  , "li"
 224  , "link"
 225  , "note"
 226  , "ol"
 227  , "organization"
 228  , "para"
 229  , "postamble"
 230  , "preamble"
 231  , "q"
 232  , "quote"
 233  , "ref"
 234  , "reference"
 235  , "references"
 236  , "region"
 237  , "rref"
 238  , "sc"
 239  , "section"
 240  , "serie"
 241  , "source"
 242  , "span"
 243  , "street"
 244  , "style"
 245  , "sub"
 246  , "sup"
 247  , "table"
 248  , "tbody"
 249  , "td"
 250  , "tel"
 251  , "tfoot"
 252  , "th"
 253  , "thead"
 254  , "toc"
 255  , "tof"
 256  , "tr"
 257  , "tt"
 258  , "ul"
 259  , "uri"
 260  , "video"
 261  , "workgroup"
 262  , "xml"
 263  , "zipcode"
 264  ]