git-annex-5.20141024: standalone/no-th/haskell-patches/hamlet_hack_TH.patch
From 0509d4383c328c20be61cf3e3bbc98a0a1161588 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 16 Oct 2014 02:21:17 +0000
Subject: [PATCH] hack TH
---
Text/Hamlet.hs | 86 +++++++++++++++++-----------------------------------
Text/Hamlet/Parse.hs | 3 +-
2 files changed, 29 insertions(+), 60 deletions(-)
diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
index 9500ecb..ec8471a 100644
--- a/Text/Hamlet.hs
+++ b/Text/Hamlet.hs
@@ -11,36 +11,36 @@
module Text.Hamlet
( -- * Plain HTML
Html
- , shamlet
- , shamletFile
- , xshamlet
- , xshamletFile
+ --, shamlet
+ --, shamletFile
+ --, xshamlet
+ --, xshamletFile
-- * Hamlet
, HtmlUrl
- , hamlet
- , hamletFile
- , hamletFileReload
- , ihamletFileReload
- , xhamlet
- , xhamletFile
+ --, hamlet
+ --, hamletFile
+ --, hamletFileReload
+ --, ihamletFileReload
+ --, xhamlet
+ --, xhamletFile
-- * I18N Hamlet
, HtmlUrlI18n
- , ihamlet
- , ihamletFile
+ --, ihamlet
+ --, ihamletFile
-- * Type classes
, ToAttributes (..)
-- * Internal, for making more
, HamletSettings (..)
, NewlineStyle (..)
- , hamletWithSettings
- , hamletFileWithSettings
+ --, hamletWithSettings
+ --, hamletFileWithSettings
, defaultHamletSettings
, xhtmlHamletSettings
- , Env (..)
- , HamletRules (..)
- , hamletRules
- , ihamletRules
- , htmlRules
+ --, Env (..)
+ --, HamletRules (..)
+ --, hamletRules
+ --, ihamletRules
+ --, htmlRules
, CloseStyle (..)
-- * Used by generated code
, condH
@@ -110,47 +110,9 @@ type HtmlUrl url = Render url -> Html
-- | A function generating an 'Html' given a message translator and a URL rendering function.
type HtmlUrlI18n msg url = Translate msg -> Render url -> Html
-docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp
-docsToExp env hr scope docs = do
- exps <- mapM (docToExp env hr scope) docs
- case exps of
- [] -> [|return ()|]
- [x] -> return x
- _ -> return $ DoE $ map NoBindS exps
-
unIdent :: Ident -> String
unIdent (Ident s) = s
-bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)])
-bindingPattern (BindAs i@(Ident s) b) = do
- name <- newName s
- (pattern, scope) <- bindingPattern b
- return (AsP name pattern, (i, VarE name):scope)
-bindingPattern (BindVar i@(Ident s))
- | all isDigit s = do
- return (LitP $ IntegerL $ read s, [])
- | otherwise = do
- name <- newName s
- return (VarP name, [(i, VarE name)])
-bindingPattern (BindTuple is) = do
- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
- return (TupP patterns, concat scopes)
-bindingPattern (BindList is) = do
- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
- return (ListP patterns, concat scopes)
-bindingPattern (BindConstr con is) = do
- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
- return (ConP (mkConName con) patterns, concat scopes)
-bindingPattern (BindRecord con fields wild) = do
- let f (Ident field,b) =
- do (p,s) <- bindingPattern b
- return ((mkName field,p),s)
- (patterns, scopes) <- fmap unzip $ mapM f fields
- (patterns1, scopes1) <- if wild
- then bindWildFields con $ map fst fields
- else return ([],[])
- return (RecP (mkConName con) (patterns++patterns1), concat scopes ++ scopes1)
-
mkConName :: DataConstr -> Name
mkConName = mkName . conToStr
@@ -158,6 +120,7 @@ conToStr :: DataConstr -> String
conToStr (DCUnqualified (Ident x)) = x
conToStr (DCQualified (Module xs) (Ident x)) = intercalate "." $ xs ++ [x]
+{-
-- Wildcards bind all of the unbound fields to variables whose name
-- matches the field name.
--
@@ -296,10 +259,12 @@ hamlet = hamletWithSettings hamletRules defaultHamletSettings
xhamlet :: QuasiQuoter
xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings
+-}
asHtmlUrl :: HtmlUrl url -> HtmlUrl url
asHtmlUrl = id
+{-
hamletRules :: Q HamletRules
hamletRules = do
i <- [|id|]
@@ -360,6 +325,7 @@ hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp
hamletFromString qhr set s = do
hr <- qhr
hrWithEnv hr $ \env -> docsToExp env hr [] $ docFromString set s
+-}
docFromString :: HamletSettings -> String -> [Doc]
docFromString set s =
@@ -367,6 +333,7 @@ docFromString set s =
Error s' -> error s'
Ok (_, d) -> d
+{-
hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
hamletFileWithSettings qhr set fp = do
#ifdef GHC_7_4
@@ -408,6 +375,7 @@ strToExp s@(c:_)
| isUpper c = ConE $ mkName s
| otherwise = VarE $ mkName s
strToExp "" = error "strToExp on empty string"
+-}
-- | Checks for truth in the left value in each pair in the first argument. If
-- a true exists, then the corresponding right action is performed. Only the
@@ -452,7 +420,7 @@ hamletUsedIdentifiers settings =
data HamletRuntimeRules = HamletRuntimeRules {
hrrI18n :: Bool
}
-
+{-
hamletFileReloadWithSettings :: HamletRuntimeRules
-> HamletSettings -> FilePath -> Q Exp
hamletFileReloadWithSettings hrr settings fp = do
@@ -479,7 +447,7 @@ hamletFileReloadWithSettings hrr settings fp = do
c VTUrlParam = [|EUrlParam|]
c VTMixin = [|\r -> EMixin $ \c -> r c|]
c VTMsg = [|EMsg|]
-
+-}
-- move to Shakespeare.Base?
readFileUtf8 :: FilePath -> IO String
readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp
diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs
index b7e2954..1f14946 100644
--- a/Text/Hamlet/Parse.hs
+++ b/Text/Hamlet/Parse.hs
@@ -616,6 +616,7 @@ data NewlineStyle = NoNewlines -- ^ never add newlines
| DefaultNewlineStyle
deriving Show
+{-
instance Lift NewlineStyle where
lift NoNewlines = [|NoNewlines|]
lift NewlinesText = [|NewlinesText|]
@@ -627,7 +628,7 @@ instance Lift (String -> CloseStyle) where
instance Lift HamletSettings where
lift (HamletSettings a b c d) = [|HamletSettings $(lift a) $(lift b) $(lift c) $(lift d)|]
-
+-}
htmlEmptyTags :: Set String
htmlEmptyTags = Set.fromAscList
--
2.1.1