{-# LANGUAGE CPP #-}
  
module Util.GenerateHtmlTCombinators where

import Control.Applicative
import Data.List
import Language.Haskell.TH
import System.Directory
import System.FilePath
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 [m] else [mT, "Text.BlazeT.Html"]
          f = (joinPath $ ["src","Text","BlazeT"] ++ version v
               ++ [path]) <.> "hs"
          body = if attr then "" else unlines $
            map (printf "import           Text.BlazeT%s") ["", ".Html", ".Internal"]
            ++ ["", 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
        ,"   (" ++ intercalate "\n   ," (map ("module "++) exports)
        ,"   ) where"
        ,"import "++ quali ++ m
        , body]

main = mapM_ writeSource htmlVariants
        

getModuleName :: String -> HtmlVariant -> String
getModuleName base = (("Text."++base++".")++) . intercalate "." . version