{-# LANGUAGE CPP #-}
module Util.GenerateHtmlTCombinators where
import Data.List
import Language.Haskell.TH
import System.Directory
import System.FilePath
import Text.BlazeT
import Control.Applicative
import Text.Printf
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 "
createDirectoryIfMissing True $ takeDirectory $ f
writeFile f $ unlines $
["-- !! DO NOT EDIT Automatically generated by "
, printf "-- %s:%d" __FILE__ ( __LINE__ :: Int)
,"module "++ mT ++ exports ++ " where"
,"import "++ quali ++ m
, body]
main = mapM_ writeSource htmlVariants
getModuleName :: String -> HtmlVariant -> String
getModuleName base = (("Text."++base++".")++) . intercalate "." . version