{-# LANGUAGE CPP #-} module Util.GenerateHtmlTCombinators where import Control.Applicative import Data.List import Language.Haskell.TH import System.Directory import System.FilePath import Text.BlazeT import Text.Printf import Text.Regex import Text.Regex.TDFA import Util.GenerateHtmlCombinators hiding (getModuleName, main) declare :: HtmlVariant -> [Dec] declare x = concatMap (\(w,ls) -> concatMap (g w) ls) [(("wrapMarkup2","Markup2"),"docTypeHtml" : parents x) ,(("wrapMarkup","Markup"), "docType" : leafs x)] where g (w',t') l' = [SigD l $ ConT t ,ValD (VarP l) (NormalB (AppE (VarE w) $ VarE $ mkName $ getModuleName "Blaze" x ++"."++l')) []] where [w,t,l] = fmap mkName [w',t',l'] writeSource :: HtmlVariant -> IO () writeSource v = mapM_ g [True, False] where g attr = do let path = if attr then "Attributes" else "" name = (if attr then "." else "") ++ path [mT,m] = ((++ name) . flip getModuleName v) <$> ["BlazeT","Blaze"] exports = if attr then " (\n module "++ m ++")" else "" f = (joinPath $ ["src","Text","BlazeT"] ++ version v ++ [path]) <.> "hs" body = if attr then "" else "import Text.BlazeT\n\n" ++ show ( ppr_list $ declare v) quali = if attr then "" else "qualified " docs True = "This module simply reexports the corresponding @blaze-html@ module." docs False = printf "This module wraps all exports of \"%s\" using 'wrapMarkup' and 'wrapMarkup'." m createDirectoryIfMissing True $ takeDirectory $ f writeFile f $ unlines $ ["-- !! DO NOT EDIT" ,"{-|" ,printf "(Automatically generated by @%s:%d@)\n" (subRegex (mkRegex "/") __FILE__ "\\\\/") ( __LINE__ :: Int) ,docs attr ,"-}" ,"module "++ mT ++ exports ++ " where" ,"import "++ quali ++ m , body] main = mapM_ writeSource htmlVariants getModuleName :: String -> HtmlVariant -> String getModuleName base = (("Text."++base++".")++) . intercalate "." . version