blaze-from-html 0.2.2 → 0.3.0.0
raw patch · 3 files changed
+117/−110 lines, 3 files
Files
- Util/GenerateHtmlCombinators.hs +104/−105
- Util/Sanitize.hs +12/−4
- blaze-from-html.cabal +1/−1
Util/GenerateHtmlCombinators.hs view
@@ -1,13 +1,13 @@ {-# LANGUAGE CPP #-} -#define LINE codeLine __FILE__ __LINE__+#define DO_NOT_EDIT (doNotEdit __FILE__ __LINE__) -- | Generates code for HTML tags. -- module Util.GenerateHtmlCombinators where import Control.Arrow ((&&&))-import Data.List (isPrefixOf, sort, sortBy, intersperse, intercalate)+import Data.List (sort, sortBy, intersperse, intercalate) import Data.Ord (comparing) import System.Directory (createDirectoryIfMissing) import System.FilePath ((</>), (<.>))@@ -52,14 +52,6 @@ | sanitize t `S.member` prelude = True | otherwise = False --- | Annotate a line of code with the line by which it was generated.----codeLine :: String -> Int -> String -> String-codeLine filename lineNo line- | "--" `isPrefixOf` line = line- | otherwise = line ++ replicate (79 - length line) ' '- ++ " -- " ++ filename ++ ":" ++ show lineNo- -- | Write an HTML variant. -- writeHtmlVariant :: HtmlVariant -> IO ()@@ -74,19 +66,20 @@ -- Write the main module. writeFile' (basePath <.> "hs") $ removeTrailingNewlines $ unlines- [ doNotEdit- , LINE "{-# LANGUAGE OverloadedStrings #-}"- , LINE "-- | This module exports HTML combinators used to create documents."- , LINE "--"+ [ DO_NOT_EDIT+ , "{-# LANGUAGE OverloadedStrings #-}"+ , "-- | This module exports HTML combinators used to create documents."+ , "--" , exportList modulName $ "module Text.Blaze" : "docType" : "docTypeHtml" : map (sanitize . fst) sortedTags- , LINE "import Prelude ((>>), (.))"- , LINE ""- , LINE "import Text.Blaze"- , LINE "import Text.Blaze.Internal"- , LINE ""+ , DO_NOT_EDIT+ , "import Prelude ((>>), (.))"+ , ""+ , "import Text.Blaze"+ , "import Text.Blaze.Internal"+ , "" , makeDocType $ docType htmlVariant , makeDocTypeHtml $ docType htmlVariant , unlines appliedTags@@ -96,16 +89,17 @@ -- Write the attribute module. writeFile' (basePath </> "Attributes.hs") $ removeTrailingNewlines $ unlines- [ doNotEdit- , LINE "-- | This module exports combinators that provide you with the"- , LINE "-- ability to set attributes on HTML elements."- , LINE "--"- , LINE "{-# LANGUAGE OverloadedStrings #-}"+ [ 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- , LINE "import Prelude ()"- , LINE ""- , LINE "import Text.Blaze.Internal (Attribute, AttributeValue, attribute)"- , LINE ""+ , DO_NOT_EDIT+ , "import Prelude ()"+ , ""+ , "import Text.Blaze.Internal (Attribute, AttributeValue, attribute)"+ , "" , unlines (map makeAttribute sortedAttributes) ] where@@ -134,11 +128,11 @@ -- | A warning to not edit the generated code. ---doNotEdit :: String-doNotEdit = unlines- [ "-- WARNING: This code was automatically generated. You should *never*"- , "-- edit it directly. Instead, edit the files who generated this code,"- , "-- you can find them in the @util/@ directory."+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.@@ -148,29 +142,30 @@ -> String -- ^ Resulting string. exportList _ [] = error "exportList without functions." exportList name (f:functions) = unlines $- [ LINE $ "module " ++ name- , LINE $ " ( " ++ sanitize f+ [ "module " ++ name+ , " ( " ++ f ] ++- map (LINE . (" , " ++)) functions ++- [ LINE " ) where"]+ map (" , " ++) functions +++ [ " ) where"] -- | Generate a function for a doctype. -- makeDocType :: [String] -> String makeDocType lines' = unlines- [ LINE "-- | Combinator for the document type. This should be placed at the top"- , LINE "-- of every HTML page."- , LINE "--"- , LINE "-- Example:"- , LINE "--"- , LINE "-- > docType"- , LINE "--"- , LINE "-- Result:"- , LINE "--"+ [ 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') ++ "--"- , LINE "docType :: Html -- ^ The document type HTML."- , LINE $ "docType = preEscapedText " ++ show (unlines lines')- , LINE "{-# INLINE docType #-}"+ , "docType :: Html -- ^ The document type HTML."+ , "docType = preEscapedText " ++ show (unlines lines')+ , "{-# INLINE docType #-}" ] -- | Generate a function for the HTML tag (including the doctype).@@ -178,42 +173,44 @@ makeDocTypeHtml :: [String] -- ^ The doctype. -> String -- ^ Resulting combinator function. makeDocTypeHtml lines' = unlines- [ LINE "-- | Combinator for the @\\<html>@ element. This combinator will also"- , LINE "-- insert the correct doctype."- , LINE "--"- , LINE "-- Example:"- , LINE "--"- , LINE "-- > docTypeHtml $ span $ text \"foo\""- , LINE "--"- , LINE "-- Result:"- , LINE "--"- , LINE $ unlines (map ("-- > " ++) lines') ++ "-- > <html><span>foo</span></html>"- , LINE "--"- , LINE "docTypeHtml :: Html -- ^ Inner HTML."- , LINE " -> Html -- ^ Resulting HTML."- , LINE "docTypeHtml inner = docType >> html inner"- , LINE "{-# INLINE docTypeHtml #-}"+ [ DO_NOT_EDIT+ , "-- | Combinator for the @\\<html>@ element. This combinator will also"+ , "-- insert the correct doctype."+ , "--"+ , "-- Example:"+ , "--"+ , "-- > docTypeHtml $ span $ text \"foo\""+ , "--"+ , "-- Result:"+ , "--"+ , unlines (map ("-- > " ++) lines') ++ "-- > <html><span>foo</span></html>"+ , "--"+ , "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- [ LINE $ "-- | Combinator for the @\\<" ++ tag ++ ">@ element."- , LINE "--"- , LINE "-- Example:"- , LINE "--"- , LINE $ "-- > " ++ function ++ " $ span $ text \"foo\""- , LINE "--"- , LINE "-- Result:"- , LINE "--"- , LINE $ "-- > <" ++ tag ++ "><span>foo</span></" ++ tag ++ ">"- , LINE "--"- , LINE $ function ++ " :: Html -- ^ Inner HTML."- , LINE $ spaces function ++ " -> Html -- ^ Resulting HTML."- , LINE $ function ++ " = Parent \"<" ++ tag+ [ DO_NOT_EDIT+ , "-- | Combinator for the @\\<" ++ tag ++ ">@ element."+ , "--"+ , "-- Example:"+ , "--"+ , "-- > " ++ function ++ " $ span $ text \"foo\""+ , "--"+ , "-- Result:"+ , "--"+ , "-- > <" ++ tag ++ "><span>foo</span></" ++ tag ++ ">"+ , "--"+ , function ++ " :: Html -- ^ Inner HTML."+ , spaces function ++ " -> Html -- ^ Resulting HTML."+ , function ++ " = Parent \"<" ++ tag ++ "\" \"</" ++ tag ++ ">\"" ++ modifier- , LINE $ "{-# INLINE " ++ function ++ " #-}"+ , "{-# INLINE " ++ function ++ " #-}" ] where function = sanitize tag@@ -225,19 +222,20 @@ -> String -- ^ Tag for the combinator -> String -- ^ Combinator code makeLeaf openLeaf tag = unlines- [ LINE $ "-- | Combinator for the @\\<" ++ tag ++ " />@ element."- , LINE "--"- , LINE "-- Example:"- , LINE "--"- , LINE $ "-- > " ++ function- , LINE "--"- , LINE "-- Result:"- , LINE "--"- , LINE $ "-- > <" ++ tag ++ " />"- , LINE "--"- , LINE $ function ++ " :: Html -- ^ Resulting HTML."- , LINE $ function ++ " = Leaf \"<" ++ tag ++ "\" " ++ end- , LINE $ "{-# INLINE " ++ function ++ " #-}"+ [ DO_NOT_EDIT+ , "-- | Combinator for the @\\<" ++ tag ++ " />@ element."+ , "--"+ , "-- Example:"+ , "--"+ , "-- > " ++ function+ , "--"+ , "-- Result:"+ , "--"+ , "-- > <" ++ tag ++ " />"+ , "--"+ , function ++ " :: Html -- ^ Resulting HTML."+ , function ++ " = Leaf \"<" ++ tag ++ "\" " ++ end+ , "{-# INLINE " ++ function ++ " #-}" ] where function = sanitize tag@@ -247,20 +245,21 @@ -- makeAttribute :: String -> String makeAttribute name = unlines- [ LINE $ "-- | Combinator for the @" ++ name ++ "@ attribute."- , LINE "--"- , LINE "-- Example:"- , LINE "--"- , LINE $ "-- > div ! " ++ function ++ " \"bar\" $ \"Hello.\""- , LINE "--"- , LINE "-- Result:"- , LINE "--"- , LINE $ "-- > <div " ++ name ++ "=\"bar\">Hello.</div>"- , LINE "--"- , LINE $ function ++ " :: AttributeValue -- ^ Attribute value."- , LINE $ spaces function ++ " -> Attribute -- ^ Resulting attribute."- , LINE $ function ++ " = attribute \" " ++ name ++ "=\\\"\""- , LINE $ "{-# INLINE " ++ function ++ " #-}"+ [ DO_NOT_EDIT+ , "-- | Combinator for the @" ++ name ++ "@ attribute."+ , "--"+ , "-- Example:"+ , "--"+ , "-- > div ! " ++ function ++ " \"bar\" $ \"Hello.\""+ , "--"+ , "-- Result:"+ , "--"+ , "-- > <div " ++ name ++ "=\"bar\">Hello.</div>"+ , "--"+ , function ++ " :: AttributeValue -- ^ Attribute value."+ , spaces function ++ " -> Attribute -- ^ Resulting attribute."+ , function ++ " = attribute \" " ++ name ++ "=\\\"\""+ , "{-# INLINE " ++ function ++ " #-}" ] where function = sanitize name
Util/Sanitize.hs view
@@ -6,6 +6,7 @@ , prelude ) where +import Data.Char (toLower, toUpper) import Data.Set (Set) import qualified Data.Set as S @@ -15,13 +16,20 @@ -- Examples: -- -- > sanitize "class" == "class_"--- > sanitize "http-equiv" = "http_equiv"+-- > sanitize "http-equiv" == "httpEquiv" -- sanitize :: String -> String-sanitize = appendUnderscore . map replace'+sanitize = appendUnderscore . removeDash . map toLower where- replace' '-' = '_'- replace' x = x+ -- 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
blaze-from-html.cabal view
@@ -1,5 +1,5 @@ Name: blaze-from-html-Version: 0.2.2+Version: 0.3.0.0 Synopsis: Tool to convert HTML to BlazeHtml code. Description: Tool that converts HTML files to Haskell code, ready to be used with the BlazeHtml library.