From 675085c2e0b0b851378da08b7d73024766107c87 Mon Sep 17 00:00:00 2001
From: Johannes Gerer <oss@johannesgerer.com>
Date: Wed, 26 Oct 2016 02:07:02 +0200
Subject: Initial

---
 src/Util/GenerateHtmlTCombinators.hs | 62 ++++++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)
 create mode 100755 src/Util/GenerateHtmlTCombinators.hs

(limited to 'src/Util/GenerateHtmlTCombinators.hs')

diff --git a/src/Util/GenerateHtmlTCombinators.hs b/src/Util/GenerateHtmlTCombinators.hs
new file mode 100755
index 0000000..0dd5444
--- /dev/null
+++ b/src/Util/GenerateHtmlTCombinators.hs
@@ -0,0 +1,62 @@
+{-# 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
-- 
cgit v1.2.3