banana
banana
bad
" $ p ! class_ (preEscapedToValue ("'&!;" :: String)) $ "bad" -- Unicode cases , HtmlTest "\206\187" $ H.span ! id "&" $ "λ" , HtmlTest "\226\136\128x. x \226\136\136 A" "∀x. x ∈ A" , HtmlTest "$6, \226\130\172\&7.01, \194\163\&75" "$6, €7.01, £75" -- Control cases , HtmlTest "A paragraph
" $ p ! (dataAttribute "foo" "bar") $ "A paragraph" , HtmlTest "Hello
" $ p ! mempty $ "Hello" , HtmlTest "

A paragraph
" $ customParent "p" $ "A paragraph" , HtmlTest "
A paragraph
" $ p ! (customAttribute "dojoType" "select") $ "A paragraph" ] where names = map (("Test case " ++) . show) [1 :: Int ..] blaze-html-0.9.0.1/tests/Text/Blaze/Html/Tests/ 0000755 0000000 0000000 00000000000 13043670060 017234 5 ustar 00 0000000 0000000 blaze-html-0.9.0.1/tests/Text/Blaze/Html/Tests/Util.hs 0000644 0000000 0000000 00000002125 13043670060 020505 0 ustar 00 0000000 0000000 -- | Utility functions for the blaze tests -- module Text.Blaze.Html.Tests.Util ( renderUsingString , renderUsingText , renderUsingUtf8 ) where import Blaze.ByteString.Builder as B (toLazyByteString) import Blaze.ByteString.Builder.Char.Utf8 as B (fromString) import Data.Text.Lazy.Encoding (encodeUtf8) import Text.Blaze.Html (Html) import qualified Data.ByteString.Lazy as LB import qualified Text.Blaze.Html.Renderer.String as String (renderHtml) import qualified Text.Blaze.Html.Renderer.Text as Text (renderHtml) import qualified Text.Blaze.Html.Renderer.Utf8 as Utf8 (renderHtml) -- | Render HTML to an UTF-8 encoded ByteString using the String renderer -- renderUsingString :: Html -> LB.ByteString renderUsingString = toLazyByteString . fromString . String.renderHtml -- | Render HTML to an UTF-8 encoded ByteString using the Text renderer -- renderUsingText :: Html -> LB.ByteString renderUsingText = encodeUtf8 . Text.renderHtml -- | Render HTML to an UTF-8 encoded ByteString using the Utf8 renderer -- renderUsingUtf8 :: Html -> LB.ByteString renderUsingUtf8 = Utf8.renderHtml blaze-html-0.9.0.1/src/ 0000755 0000000 0000000 00000000000 13043670060 012672 5 ustar 00 0000000 0000000 blaze-html-0.9.0.1/src/Util/ 0000755 0000000 0000000 00000000000 13043670060 013607 5 ustar 00 0000000 0000000 blaze-html-0.9.0.1/src/Util/Sanitize.hs 0000644 0000000 0000000 00000006446 13043670060 015743 0 ustar 00 0000000 0000000 -- | A program to sanitize an HTML tag to a Haskell function. -- module Util.Sanitize ( sanitize , keywords , prelude ) where import Data.Char (toLower, toUpper) import Data.Set (Set) import qualified Data.Set as S -- | Sanitize a tag. This function returns a name that can be used as -- combinator in haskell source code. -- -- Examples: -- -- > sanitize "class" == "class_" -- > sanitize "http-equiv" == "httpEquiv" -- sanitize :: String -> String sanitize str | lower == "doctypehtml" = "docTypeHtml" | otherwise = appendUnderscore $ removeDash lower where lower = map toLower str -- Remove a dash, replacing it by camelcase notation -- -- Example: -- -- > removeDash "foo-bar" == "fooBar" -- removeDash ('-' : x : xs) = toUpper x : removeDash xs removeDash (x : xs) = x : removeDash xs removeDash [] = [] appendUnderscore t | t `S.member` keywords = t ++ "_" | otherwise = t -- | A set of standard Haskell keywords, which cannot be used as combinators. -- keywords :: Set String keywords = S.fromList [ "case", "class", "data", "default", "deriving", "do", "else", "if" , "import", "in", "infix", "infixl", "infixr", "instance" , "let", "module" , "newtype", "of", "then", "type", "where" ] -- | Set of functions from the Prelude, which we do not use as combinators. -- prelude :: Set String prelude = S.fromList [ "abs", "acos", "acosh", "all", "and", "any", "appendFile", "asTypeOf" , "asin", "asinh", "atan", "atan2", "atanh", "break", "catch", "ceiling" , "compare", "concat", "concatMap", "const", "cos", "cosh", "curry", "cycle" , "decodeFloat", "div", "divMod", "drop", "dropWhile", "either", "elem" , "encodeFloat", "enumFrom", "enumFromThen", "enumFromThenTo", "enumFromTo" , "error", "even", "exp", "exponent", "fail", "filter", "flip" , "floatDigits", "floatRadix", "floatRange", "floor", "fmap", "foldl" , "foldl1", "foldr", "foldr1", "fromEnum", "fromInteger", "fromIntegral" , "fromRational", "fst", "gcd", "getChar", "getContents", "getLine", "head" , "id", "init", "interact", "ioError", "isDenormalized", "isIEEE" , "isInfinite", "isNaN", "isNegativeZero", "iterate", "last", "lcm" , "length", "lex", "lines", "log", "logBase", "lookup", "map", "mapM" , "mapM_", "max", "maxBound", "maximum", "maybe", "min", "minBound" , "minimum", "mod", "negate", "not", "notElem", "null", "odd", "or" , "otherwise", "pi", "pred", "print", "product", "properFraction", "putChar" , "putStr", "putStrLn", "quot", "quotRem", "read", "readFile", "readIO" , "readList", "readLn", "readParen", "reads", "readsPrec", "realToFrac" , "recip", "rem", "repeat", "replicate", "return", "reverse", "round" , "scaleFloat", "scanl", "scanl1", "scanr", "scanr1", "seq", "sequence" , "sequence_", "show", "showChar", "showList", "showParen", "showString" , "shows", "showsPrec", "significand", "signum", "sin", "sinh", "snd" , "span", "splitAt", "sqrt", "subtract", "succ", "sum", "tail", "take" , "takeWhile", "tan", "tanh", "toEnum", "toInteger", "toRational" , "truncate", "uncurry", "undefined", "unlines", "until", "unwords", "unzip" , "unzip3", "userError", "words", "writeFile", "zip", "zip3", "zipWith" , "zipWith3" ] blaze-html-0.9.0.1/src/Util/GenerateHtmlCombinators.hs 0000644 0000000 0000000 00000042276 13043670060 020736 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-} #define DO_NOT_EDIT (doNotEdit __FILE__ __LINE__) -- | Generates code for HTML tags. -- module Util.GenerateHtmlCombinators where import Control.Arrow ((&&&)) import Data.List (sort, sortBy, intersperse, intercalate) import Data.Ord (comparing) import System.Directory (createDirectoryIfMissing) import System.FilePath ((>), (<.>)) import Data.Map (Map) import qualified Data.Map as M import Data.Char (toLower) import qualified Data.Set as S import Util.Sanitize (sanitize, prelude) -- | Datatype for an HTML variant. -- data HtmlVariant = HtmlVariant { version :: [String] , docType :: [String] , parents :: [String] , leafs :: [String] , attributes :: [String] , selfClosing :: Bool } deriving (Eq) instance Show HtmlVariant where show = map toLower . intercalate "-" . version -- | Get the full module name for an HTML variant. -- getModuleName :: HtmlVariant -> String getModuleName = ("Text.Blaze." ++) . intercalate "." . version -- | Get the attribute module name for an HTML variant. -- getAttributeModuleName :: HtmlVariant -> String getAttributeModuleName = (++ ".Attributes") . getModuleName -- | Check if a given name causes a name clash. -- isNameClash :: HtmlVariant -> String -> Bool isNameClash v t -- Both an element and an attribute | (t `elem` parents v || t `elem` leafs v) && t `elem` attributes v = True -- Already a prelude function | sanitize t `S.member` prelude = True | otherwise = False -- | Write an HTML variant. -- writeHtmlVariant :: HtmlVariant -> IO () writeHtmlVariant htmlVariant = do -- Make a directory. createDirectoryIfMissing True basePath let tags = zip parents' (repeat makeParent) ++ zip leafs' (repeat (makeLeaf $ selfClosing htmlVariant)) sortedTags = sortBy (comparing fst) tags appliedTags = map (\(x, f) -> f x) sortedTags -- Write the main module. writeFile' (basePath <.> "hs") $ removeTrailingNewlines $ unlines [ DO_NOT_EDIT , "{-# LANGUAGE OverloadedStrings #-}" , "-- | This module exports HTML combinators used to create documents." , "--" , exportList modulName $ "module Text.Blaze.Html" : "docType" : "docTypeHtml" : map (sanitize . fst) sortedTags , DO_NOT_EDIT , "import Prelude ((>>), (.))" , "" , "import Text.Blaze" , "import Text.Blaze.Internal" , "import Text.Blaze.Html" , "" , makeDocType $ docType htmlVariant , makeDocTypeHtml $ docType htmlVariant , unlines appliedTags ] let sortedAttributes = sort attributes' -- Write the attribute module. writeFile' (basePath > "Attributes.hs") $ removeTrailingNewlines $ unlines [ DO_NOT_EDIT , "-- | This module exports combinators that provide you with the" , "-- ability to set attributes on HTML elements." , "--" , "{-# LANGUAGE OverloadedStrings #-}" , exportList attributeModuleName $ map sanitize sortedAttributes , DO_NOT_EDIT , "import Prelude ()" , "" , "import Text.Blaze.Internal (Attribute, AttributeValue, attribute)" , "" , unlines (map makeAttribute sortedAttributes) ] where basePath = "src" > "Text" > "Blaze" > foldl1 (>) version' modulName = getModuleName htmlVariant attributeModuleName = getAttributeModuleName htmlVariant attributes' = attributes htmlVariant parents' = parents htmlVariant leafs' = leafs htmlVariant version' = version htmlVariant removeTrailingNewlines = reverse . drop 2 . reverse writeFile' file content = do putStrLn ("Generating " ++ file) writeFile file content -- | Create a string, consisting of @x@ spaces, where @x@ is the length of the -- argument. -- spaces :: String -> String spaces = flip replicate ' ' . length -- | Join blocks of code with a newline in between. -- unblocks :: [String] -> String unblocks = unlines . intersperse "\n" -- | A warning to not edit the generated code. -- doNotEdit :: FilePath -> Int -> String doNotEdit fileName lineNumber = init $ unlines [ "-- WARNING: The next block of code was automatically generated by" , "-- " ++ fileName ++ ":" ++ show lineNumber , "--" ] -- | Generate an export list for a Haskell module. -- exportList :: String -- ^ Module name. -> [String] -- ^ List of functions. -> String -- ^ Resulting string. exportList _ [] = error "exportList without functions." exportList name (f:functions) = unlines $ [ "module " ++ name , " ( " ++ f ] ++ map (" , " ++) functions ++ [ " ) where"] -- | Generate a function for a doctype. -- makeDocType :: [String] -> String makeDocType lines' = unlines [ DO_NOT_EDIT , "-- | Combinator for the document type. This should be placed at the top" , "-- of every HTML page." , "--" , "-- Example:" , "--" , "-- > docType" , "--" , "-- Result:" , "--" , unlines (map ("-- > " ++) lines') ++ "--" , "docType :: Html -- ^ The document type HTML." , "docType = preEscapedText " ++ show (unlines lines') , "{-# INLINE docType #-}" ] -- | Generate a function for the HTML tag (including the doctype). -- makeDocTypeHtml :: [String] -- ^ The doctype. -> String -- ^ Resulting combinator function. makeDocTypeHtml lines' = unlines [ DO_NOT_EDIT , "-- | Combinator for the @\\@ element. This combinator will also" , "-- insert the correct doctype." , "--" , "-- Example:" , "--" , "-- > docTypeHtml $ span $ toHtml \"foo\"" , "--" , "-- Result:" , "--" , unlines (map ("-- > " ++) lines') ++ "-- > foo" , "--" , "docTypeHtml :: Html -- ^ Inner HTML." , " -> Html -- ^ Resulting HTML." , "docTypeHtml inner = docType >> html inner" , "{-# INLINE docTypeHtml #-}" ] -- | Generate a function for an HTML tag that can be a parent. -- makeParent :: String -> String makeParent tag = unlines [ DO_NOT_EDIT , "-- | Combinator for the @\\<" ++ tag ++ ">@ element." , "--" , "-- Example:" , "--" , "-- > " ++ function ++ " $ span $ toHtml \"foo\"" , "--" , "-- Result:" , "--" , "-- > <" ++ tag ++ ">foo" ++ tag ++ ">" , "--" , function ++ " :: Html -- ^ Inner HTML." , spaces function ++ " -> Html -- ^ Resulting HTML." , function ++ " = Parent \"" ++ tag ++ "\" \"<" ++ tag ++ "\" \"" ++ tag ++ ">\"" ++ modifier , "{-# INLINE " ++ function ++ " #-}" ] where function = sanitize tag modifier = if tag `elem` ["style", "script"] then " . external" else "" -- | Generate a function for an HTML tag that must be a leaf. -- makeLeaf :: Bool -- ^ Make leaf tags self-closing -> String -- ^ Tag for the combinator -> String -- ^ Combinator code makeLeaf closing tag = unlines [ DO_NOT_EDIT , "-- | Combinator for the @\\<" ++ tag ++ " />@ element." , "--" , "-- Example:" , "--" , "-- > " ++ function , "--" , "-- Result:" , "--" , "-- > <" ++ tag ++ " />" , "--" , function ++ " :: Html -- ^ Resulting HTML." , function ++ " = Leaf \"" ++ tag ++ "\" \"<" ++ tag ++ "\" " ++ "\"" ++ (if closing then " /" else "") ++ ">\" ()" , "{-# INLINE " ++ function ++ " #-}" ] where function = sanitize tag -- | Generate a function for an HTML attribute. -- makeAttribute :: String -> String makeAttribute name = unlines [ DO_NOT_EDIT , "-- | Combinator for the @" ++ name ++ "@ attribute." , "--" , "-- Example:" , "--" , "-- > div ! " ++ function ++ " \"bar\" $ \"Hello.\"" , "--" , "-- Result:" , "--" , "-- >