Text/Blaze/DTC.hs

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