+{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
module Text.Blaze.DTC where
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
+import Text.Blaze.XML (XML)
-- * Type 'DTC'
-type DTC = Markup
+type DTC = XML
xmlModel :: Text -> DTC
xmlModel rnc =
Leaf "xml-model" "<?xml-model" "?>\n" ()
! attribute "type" " type=\"" "application/relax-ng-compact-syntax"
- ! attribute "href" " href=\"" (attrValue rnc)
+ ! attribute "href" " href=\"" (attrify rnc)
xmlStylesheet :: Text -> DTC
xmlStylesheet xsl =
Leaf "xml-stylesheet" "<?xml-stylesheet" "?>\n" ()
! attribute "type" " type=\"" "text/xsl"
- ! attribute "href" " href=\"" (attrValue xsl)
+ ! attribute "href" " href=\"" (attrify xsl)
html5Stylesheet :: Text -> DTC
html5Stylesheet xsl =
Leaf "html5-stylesheet" "<?html5-stylesheet" "?>\n" ()
! attribute "type" " type=\"" "text/xsl"
- ! attribute "href" " href=\"" (attrValue xsl)
+ ! attribute "href" " href=\"" (attrify xsl)
atomStylesheet :: Text -> DTC
atomStylesheet xsl =
Leaf "atom-stylesheet" "<?atom-stylesheet" "?>\n" ()
! attribute "type" " type=\"" "text/xsl"
- ! attribute "href" " href=\"" (attrValue xsl)
+ ! attribute "href" " href=\"" (attrify xsl)
about :: DTC -> DTC
about = Parent "about" "<about" "</about>"
-address :: DTC -> DTC
-address = Parent "address" "<address" "</address>"
+alias :: DTC
+alias = Leaf "alias" "<alias" "/>" ()
artwork :: DTC -> DTC
artwork = Parent "artwork" "<artwork" "</artwork>"
author :: DTC -> DTC
b = Parent "b" "<b" "</b>"
br :: DTC
br = Leaf "br" "<br" " />" ()
+break :: DTC
+break = Leaf "break" "<break" " />" ()
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)
-
+comment :: Text -> DTC
+comment t = Comment (Text t) ()
+date :: DTC
+date = Leaf "date" "<date" "/>" ()
define :: DTC -> DTC
define = Parent "define" "<define" "</define>"
+del :: DTC -> DTC
+del = Parent "del" "<del" "</del>"
document :: DTC -> DTC
document = Parent "document" "<document" "</document>"
editor :: DTC -> DTC
editor = Parent "editor" "<editor" "</editor>"
email :: DTC -> DTC
email = Parent "email" "<email" "</email>"
+entity :: DTC
+entity = Leaf "entity" "<entity" "/>" ()
eref :: DTC -> DTC
eref (Empty a) = Leaf "eref" "<eref" "/>" a
eref x = Parent "eref" "<eref" "</eref>" x
figure = Parent "figure" "<figure" "</figure>"
i :: DTC -> DTC
i = Parent "i" "<i" "</i>"
-include :: Bool -> AttributeValue -> DTC
-include inc h =
+include :: Bool -> DTC
+include inc =
Leaf "include" "<include" "/>" ()
!? (not inc, attribute "include" " include=\"" "no")
- ! href h
-keyword :: DTC -> DTC
-keyword = Parent "keyword" "<keyword" "</keyword>"
+index :: DTC -> DTC
+index = Parent "index" "<index" "</index>"
+iref :: DTC -> DTC
+iref (Empty a) = Leaf "iref" "<iref" "/>" a
+iref x = Parent "iref" "<iref" "</iref>" x
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>"
+p :: DTC -> DTC
+p = Parent "p" "<p" "</p>"
para :: DTC -> DTC
para = Parent "para" "<para" "</para>"
q :: DTC -> DTC
rref :: DTC -> DTC
rref (Empty a) = Leaf "rref" "<rref" "/>" a
rref x = Parent "rref" "<rref" "</rref>" x
+sc :: DTC -> DTC
+sc = Parent "sc" "<sc" "</sc>"
section :: DTC -> DTC
section = Parent "section" "<section" "</section>"
+sub :: DTC -> DTC
+sub = Parent "sub" "<sub" "</sub>"
+sup :: DTC -> DTC
+sup = Parent "sup" "<sup" "</sup>"
+tag :: DTC -> DTC
+tag = Parent "tag" "<tag" "</tag>"
+title :: DTC -> DTC
+title = Parent "title" "<title" "</title>"
+toc :: DTC
+toc = Leaf "toc" "<toc" "/>" ()
+tof :: DTC -> DTC
+tof = Parent "tof" "<tof" "</tof>"
+u :: DTC -> DTC
+u = Parent "u" "<u" "</u>"
ul :: DTC -> DTC
ul = Parent "ul" "<ul" "</ul>"
+version :: DTC -> DTC
+version = Parent "version" "<version" "</version>"
--- * 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
- "editor" -> IndentTagChildren
- "figure" -> IndentTagChildren
- "ol" -> IndentTagChildren
- "postal" -> IndentTagChildren
- "reference" -> IndentTagChildren
- "references" -> IndentTagChildren
- "section" -> IndentTagChildren
- "ul" -> IndentTagChildren
- "a" -> IndentTagText
- "b" -> IndentTagText
- "i" -> IndentTagText
- "li" -> IndentTagText
- "para" -> IndentTagText
- "q" -> IndentTagText
- "quote" -> IndentTagText
- "note" -> IndentTagText
- _ -> IndentTagPreserve
-
-elems :: [Text]
-elems =
- [ "about"
- , "abstract"
- , "address"
- , "alias"
- , "annotation"
- , "area"
- , "artwork"
- , "aside"
- , "audio"
- , "author"
- , "authors"
- , "bcp14"
- , "br"
- , "call"
- , "city"
- , "code"
- , "comment"
- , "comments"
- , "country"
- , "date"
- , "dd"
- , "define"
- , "del"
- , "div"
- , "dl"
- , "document"
- , "dt"
- , "editor"
- , "email"
- , "embed"
- , "eref"
- , "fax"
- , "feed"
- , "feedback"
- , "figure"
- , "filter"
- , "format"
- , "from"
- , "h"
- , "hi"
- , "html5"
- , "i"
- , "index"
- , "iref"
- , "keyword"
- , "li"
- , "link"
- , "note"
- , "ol"
- , "organization"
- , "para"
- , "postamble"
- , "preamble"
- , "q"
- , "quote"
- , "ref"
- , "reference"
- , "references"
- , "region"
- , "rref"
- , "sc"
- , "section"
- , "serie"
- , "source"
- , "span"
- , "street"
- , "style"
- , "sub"
- , "sup"
- , "table"
- , "tbody"
- , "td"
- , "tel"
- , "tfoot"
- , "th"
- , "thead"
- , "toc"
- , "tof"
- , "tr"
- , "tt"
- , "ul"
- , "uri"
- , "video"
- , "workgroup"
- , "xml"
- , "zipcode"
- ]
+isInlinedElement :: Text -> Bool
+isInlinedElement = \case
+ "a" -> True
+ "b" -> True
+ "br" -> True
+ "code" -> True
+ "em" -> True
+ "i" -> True
+ "note" -> True
+ "q" -> True
+ "u" -> True
+ "sup" -> True
+ "sub" -> True
+ _ -> False
sourcephile / git / doclang.git / blobdiff