Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Two proposed changes to blaze-html (xhtml support, don't escape ') #48

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion Text/Blaze/Renderer/String.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ escapeHtmlEntities (c:cs) k = case c of
'>' -> '&' : 'g' : 't' : ';' : escapeHtmlEntities cs k
'&' -> '&' : 'a' : 'm' : 'p' : ';' : escapeHtmlEntities cs k
'"' -> '&' : 'q' : 'u' : 'o' : 't' : ';' : escapeHtmlEntities cs k
'\'' -> '&' : '#' : '3' : '9' : ';' : escapeHtmlEntities cs k
x -> x : escapeHtmlEntities cs k

-- | Render a 'ChoiceString'.
Expand Down
1 change: 0 additions & 1 deletion Text/Blaze/Renderer/Text.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,6 @@ escapeHtmlEntities = T.foldr escape mempty
escape '>' b = B.fromText ">" `mappend` b
escape '&' b = B.fromText "&" `mappend` b
escape '"' b = B.fromText """ `mappend` b
escape '\'' b = B.fromText "'" `mappend` b
escape x b = B.singleton x `mappend` b

-- | Render a 'ChoiceString'. TODO: Optimization possibility, apply static
Expand Down
77 changes: 66 additions & 11 deletions Util/GenerateHtmlCombinators.hs
Original file line number Diff line number Diff line change
Expand Up @@ -21,11 +21,12 @@ import Util.Sanitize (sanitize, prelude)
-- | Datatype for an HTML variant.
--
data HtmlVariant = HtmlVariant
{ version :: [String]
, docType :: [String]
, parents :: [String]
, leafs :: [String]
, attributes :: [String]
{ version :: [String]
, docType :: [String]
, parents :: [String]
, leafs :: [String]
, attributes :: [String]
, selfClosing :: Bool
} deriving (Eq)

instance Show HtmlVariant where
Expand Down Expand Up @@ -59,7 +60,7 @@ writeHtmlVariant htmlVariant = do
createDirectoryIfMissing True basePath

let tags = zip parents' (repeat makeParent)
++ zip leafs' (repeat makeLeaf)
++ zip leafs' (repeat (makeLeaf $ selfClosing htmlVariant))
sortedTags = sortBy (comparing fst) tags
appliedTags = map (\(x, f) -> f x) sortedTags

Expand Down Expand Up @@ -217,9 +218,10 @@ makeParent tag = unlines

-- | Generate a function for an HTML tag that must be a leaf.
--
makeLeaf :: String -- ^ Tag for the combinator
makeLeaf :: Bool -- ^ Make leaf tags self-closing
-> String -- ^ Tag for the combinator
-> String -- ^ Combinator code
makeLeaf tag = unlines
makeLeaf selfClosing tag = unlines
[ DO_NOT_EDIT
, "-- | Combinator for the @\\<" ++ tag ++ " />@ element."
, "--"
Expand All @@ -232,7 +234,8 @@ makeLeaf tag = unlines
, "-- > <" ++ tag ++ " />"
, "--"
, function ++ " :: Html -- ^ Resulting HTML."
, function ++ " = Leaf \"" ++ tag ++ "\" \"<" ++ tag ++ "\" " ++ "\">\""
, function ++ " = Leaf \"" ++ tag ++ "\" \"<" ++ tag ++ "\" " ++ "\""
++ (if selfClosing then " /" else "") ++ ">\""
, "{-# INLINE " ++ function ++ " #-}"
]
where
Expand Down Expand Up @@ -302,6 +305,7 @@ html4Strict = HtmlVariant
, "tabindex", "title", "type", "usemap", "valign", "value", "valuetype"
, "width"
]
, selfClosing = False
}

-- | HTML 4.0 Transitional
Expand All @@ -322,22 +326,69 @@ html4Transitional = HtmlVariant
[ "background", "bgcolor", "clear", "compact", "hspace", "language"
, "noshade", "nowrap", "start", "target", "vspace"
]
, selfClosing = False
}

-- | HTML 4.0 Frameset
-- | HTML 4.0 FrameSet
--
html4FrameSet :: HtmlVariant
html4FrameSet = HtmlVariant
{ version = ["Html4", "FrameSet"]
, docType =
[ "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\""
[ "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 FrameSet//EN\""
, " \"http://www.w3.org/TR/html4/frameset.dtd\">"
]
, parents = parents html4Transitional ++ ["frameset"]
, leafs = leafs html4Transitional ++ ["frame"]
, attributes = attributes html4Transitional ++
[ "frameborder", "scrolling"
]
, selfClosing = False
}

-- | XHTML 1.0 Strict
--
xhtml1Strict :: HtmlVariant
xhtml1Strict = HtmlVariant
{ version = ["XHtml1", "Strict"]
, docType =
[ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\""
, " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
]
, parents = parents html4Strict
, leafs = leafs html4Strict
, attributes = attributes html4Strict
, selfClosing = True
}

-- | XHTML 1.0 Transitional
--
xhtml1Transitional :: HtmlVariant
xhtml1Transitional = HtmlVariant
{ version = ["XHtml1", "Transitional"]
, docType =
[ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\""
, " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">"
]
, parents = parents html4Transitional
, leafs = leafs html4Transitional
, attributes = attributes html4Transitional
, selfClosing = True
}

-- | XHTML 1.0 FrameSet
--
xhtml1FrameSet :: HtmlVariant
xhtml1FrameSet = HtmlVariant
{ version = ["XHtml1", "FrameSet"]
, docType =
[ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 FrameSet//EN\""
, " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">"
]
, parents = parents html4FrameSet
, leafs = leafs html4FrameSet
, attributes = attributes html4FrameSet
, selfClosing = True
}

-- | HTML 5.0
Expand Down Expand Up @@ -398,6 +449,7 @@ html5 = HtmlVariant
, "summary", "tabindex", "target", "title", "type", "usemap", "value"
, "width", "wrap", "xmlns"
]
, selfClosing = False
}

-- | A map of HTML variants, per version, lowercase.
Expand All @@ -407,6 +459,9 @@ htmlVariants = M.fromList $ map (show &&& id)
[ html4Strict
, html4Transitional
, html4FrameSet
, xhtml1Strict
, xhtml1Transitional
, xhtml1FrameSet
, html5
]

Expand Down
6 changes: 6 additions & 0 deletions blaze-html.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,12 @@ Library
Text.Blaze.Html4.Strict.Attributes
Text.Blaze.Html4.Transitional
Text.Blaze.Html4.Transitional.Attributes
Text.Blaze.XHtml1.FrameSet
Text.Blaze.XHtml1.FrameSet.Attributes
Text.Blaze.XHtml1.Strict
Text.Blaze.XHtml1.Strict.Attributes
Text.Blaze.XHtml1.Transitional
Text.Blaze.XHtml1.Transitional.Attributes
Text.Blaze.Html5
Text.Blaze.Html5.Attributes
Text.Blaze.Renderer.String
Expand Down