content: {-# 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 qualified Util.GenerateHtmlCombinators.Html5 as Html5
  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 @\\<html>@ element. This combinator will also"
      , "-- insert the correct doctype."
      , "--"
      , "-- Example:"
      , "--"
      , "-- > docTypeHtml $ span $ toHtml \"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
      [ DO_NOT_EDIT
      , "-- | Combinator for the @\\<" ++ tag ++ ">@ element."
      , "--"
      , "-- Example:"
      , "--"
      , "-- > " ++ function ++ " $ span $ toHtml \"foo\""
      , "--"
      , "-- Result:"
      , "--"
      , "-- > <" ++ tag ++ "><span>foo</span></" ++ 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:"
      , "--"
      , "-- > <div " ++ name ++ "=\"bar\">Hello.</div>"
      , "--"
      , function        ++ " :: AttributeValue  -- ^ Attribute value."
      , spaces function ++ " -> Attribute       -- ^ Resulting attribute."
      , function        ++ " = attribute \"" ++ name ++ "\" \" "
                        ++ name ++ "=\\\"\""
      , "{-# INLINE " ++ function ++ " #-}"
      ]
    where
      function = sanitize name
  
  -- | HTML 4.01 Strict.
  -- A good reference can be found here: http://www.w3schools.com/tags/default.asp
  --
  html4Strict :: HtmlVariant
  html4Strict = HtmlVariant
      { version = ["Html4", "Strict"]
      , docType =
          [ "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\""
          , "    \"http://www.w3.org/TR/html4/strict.dtd\">"
          ]
      , parents =
          [ "a", "abbr", "acronym", "address", "b", "bdo", "big", "blockquote"
          , "body" , "button", "caption", "cite", "code", "colgroup", "dd", "del"
          , "dfn", "div" , "dl", "dt", "em", "fieldset", "form", "h1", "h2", "h3"
          , "h4", "h5", "h6", "head", "html", "i", "ins" , "kbd", "label"
          , "legend", "li", "map", "noscript", "object", "ol", "optgroup"
          , "option", "p", "pre", "q", "samp", "script", "select", "small"
          , "span", "strong", "style", "sub", "sup", "table", "tbody", "td"
          , "textarea", "tfoot", "th", "thead", "title", "tr", "tt", "ul", "var"
          ]
      , leafs =
          [ "area", "br", "col", "hr", "link", "img", "input",  "meta", "param"
          ]
      , attributes =
          [ "abbr", "accept", "accesskey", "action", "align", "alt", "archive"
          , "axis", "border", "cellpadding", "cellspacing", "char", "charoff"
          , "charset", "checked", "cite", "class", "classid", "codebase"
          , "codetype", "cols", "colspan", "content", "coords", "data", "datetime"
          , "declare", "defer", "dir", "disabled", "enctype", "for", "frame"
          , "headers", "height", "href", "hreflang", "http-equiv", "id", "label"
          , "lang", "maxlength", "media", "method", "multiple", "name", "nohref"
          , "onabort", "onblur", "onchange", "onclick", "ondblclick", "onfocus"
          , "onkeydown", "onkeypress", "onkeyup", "onload", "onmousedown"
          , "onmousemove", "onmouseout", "onmouseover", "onmouseup", "onreset"
          , "onselect", "onsubmit", "onunload", "profile", "readonly", "rel"
          , "rev", "rows", "rowspan", "rules", "scheme", "scope", "selected"
          , "shape", "size", "span", "src", "standby", "style", "summary"
          , "tabindex", "title", "type", "usemap", "valign", "value", "valuetype"
          , "width"
          ]
      , selfClosing = False
      }
  
  -- | HTML 4.0 Transitional
  --
  html4Transitional :: HtmlVariant
  html4Transitional = HtmlVariant
      { version = ["Html4", "Transitional"]
      , docType =
          [ "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\""
          , "    \"http://www.w3.org/TR/html4/loose.dtd\">"
          ]
      , parents = parents html4Strict ++
          [ "applet", "center", "dir", "font", "iframe", "isindex", "menu"
          , "noframes", "s", "u"
          ]
      , leafs = leafs html4Strict ++ ["basefont"]
      , attributes = attributes html4Strict ++
          [ "background", "bgcolor", "clear", "compact", "hspace", "language"
          , "noshade", "nowrap", "start", "target", "vspace"
          ]
      , selfClosing = False
      }
  
  -- | HTML 4.0 FrameSet
  --
  html4FrameSet :: HtmlVariant
  html4FrameSet = HtmlVariant
      { version = ["Html4", "FrameSet"]
      , docType =
          [ "<!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
  -- Specified in a different file since this is the only one that is "alive".
  --
  html5 :: HtmlVariant
  html5 = HtmlVariant
      { version     = ["Html5"]
      , docType     = ["<!DOCTYPE HTML>"]
      , parents     = Html5.parents
      , leafs       = Html5.leafs
      , attributes  = Html5.attributes
      , selfClosing = False
      }
  
  -- | XHTML 5.0
  --
  xhtml5 :: HtmlVariant
  xhtml5 = HtmlVariant
      { version = ["XHtml5"]
      , docType = ["<!DOCTYPE html>"]
      , parents = parents html5
      , leafs = leafs html5
      , attributes = attributes html5
      , selfClosing = True
      }
  
  
  -- | A map of HTML variants, per version, lowercase.
  --
  htmlVariants :: Map String HtmlVariant
  htmlVariants = M.fromList $ map (show &&& id)
      [ html4Strict
      , html4Transitional
      , html4FrameSet
      , xhtml1Strict
      , xhtml1Transitional
      , xhtml1FrameSet
      , html5
      , xhtml5
      ]
  
  main :: IO ()
  main = mapM_ (writeHtmlVariant . snd) $ M.toList htmlVariants
  