Text/Blaze/DTC.hs

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