1 files changed, 108 insertions, 0 deletions
diff --git a/standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch b/standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch
new file mode 100644
index 000000000..b6334d31f
--- /dev/null
+++ b/standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch
@@ -0,0 +1,108 @@
+From b53713fbb4f3bb6bdd25b07afcaed4940b32dfa8 Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Wed, 18 Dec 2013 03:32:44 +0000
+Subject: [PATCH] remove TH
+
+---
+ Text/Hamlet/XML.hs | 81 +-----------------------------------------------------
+ 1 file changed, 1 insertion(+), 80 deletions(-)
+
+diff --git a/Text/Hamlet/XML.hs b/Text/Hamlet/XML.hs
+index f587410..4e830bd 100644
+--- a/Text/Hamlet/XML.hs
++++ b/Text/Hamlet/XML.hs
+@@ -1,9 +1,7 @@
+ {-# LANGUAGE TemplateHaskell #-}
+ {-# OPTIONS_GHC -fno-warn-missing-fields #-}
+ module Text.Hamlet.XML
+-    ( xml
+-    , xmlFile
+-    ) where
++    () where
+ 
+ import Language.Haskell.TH.Syntax
+ import Language.Haskell.TH.Quote
+@@ -19,80 +17,3 @@ import qualified Data.Foldable as F
+ import Data.Maybe (fromMaybe)
+ import qualified Data.Map as Map
+ 
+-xml :: QuasiQuoter
+-xml = QuasiQuoter { quoteExp = strToExp }
+-
+-xmlFile :: FilePath -> Q Exp
+-xmlFile = strToExp . TL.unpack <=< qRunIO . readUtf8File
+-
+-strToExp :: String -> Q Exp
+-strToExp s =
+-    case parseDoc s of
+-        Error e -> error e
+-        Ok x -> docsToExp [] x
+-
+-docsToExp :: Scope -> [Doc] -> Q Exp
+-docsToExp scope docs = [| concat $(fmap ListE $ mapM (docToExp scope) docs) |]
+-
+-docToExp :: Scope -> Doc -> Q Exp
+-docToExp scope (DocTag name attrs cs) =
+-    [| [ X.NodeElement (X.Element ($(liftName name)) $(mkAttrs scope attrs) $(docsToExp scope cs))
+-       ] |]
+-docToExp _ (DocContent (ContentRaw s)) = [| [ X.NodeContent (pack $(lift s)) ] |]
+-docToExp scope (DocContent (ContentVar d)) = [| [ X.NodeContent $(return $ derefToExp scope d) ] |]
+-docToExp scope (DocContent (ContentEmbed d)) = return $ derefToExp scope d
+-docToExp scope (DocForall deref ident@(Ident ident') inside) = do
+-    let list' = derefToExp scope deref
+-    name <- newName ident'
+-    let scope' = (ident, VarE name) : scope
+-    inside' <- docsToExp scope' inside
+-    let lam = LamE [VarP name] inside'
+-    [| F.concatMap $(return lam) $(return list') |]
+-docToExp scope (DocWith [] inside) = docsToExp scope inside
+-docToExp scope (DocWith ((deref, ident@(Ident name)):dis) inside) = do
+-    let deref' = derefToExp scope deref
+-    name' <- newName name
+-    let scope' = (ident, VarE name') : scope
+-    inside' <- docToExp scope' (DocWith dis inside)
+-    let lam = LamE [VarP name'] inside'
+-    return $ lam `AppE` deref'
+-docToExp scope (DocMaybe deref ident@(Ident name) just nothing) = do
+-    let deref' = derefToExp scope deref
+-    name' <- newName name
+-    let scope' = (ident, VarE name') : scope
+-    inside' <- docsToExp scope' just
+-    let inside'' = LamE [VarP name'] inside'
+-    nothing' <-
+-        case nothing of
+-            Nothing -> [| [] |]
+-            Just n -> docsToExp scope n
+-    [| maybe $(return nothing') $(return inside'') $(return deref') |]
+-docToExp scope (DocCond conds final) = do
+-    unit <- [| () |]
+-    body <- fmap GuardedB $ mapM go $ conds ++ [(DerefIdent $ Ident "otherwise", fromMaybe [] final)]
+-    return $ CaseE unit [Match (TupP []) body []]
+-  where
+-    go (deref, inside) = do
+-        inside' <- docsToExp scope inside
+-        return (NormalG $ derefToExp scope deref, inside')
+-
+-mkAttrs :: Scope -> [(Maybe Deref, String, [Content])] -> Q Exp
+-mkAttrs _ [] = [| Map.empty |]
+-mkAttrs scope ((mderef, name, value):rest) = do
+-    rest' <- mkAttrs scope rest
+-    this <- [| Map.insert $(liftName name) (T.concat $(fmap ListE $ mapM go value)) |]
+-    let with = [| $(return this) $(return rest') |]
+-    case mderef of
+-        Nothing -> with
+-        Just deref -> [| if $(return $ derefToExp scope deref) then $(with) else $(return rest') |]
+-  where
+-    go (ContentRaw s) = [| pack $(lift s) |]
+-    go (ContentVar d) = return $ derefToExp scope d
+-    go ContentEmbed{} = error "Cannot use embed interpolation in attribute value"
+-
+-liftName :: String -> Q Exp
+-liftName s = do
+-    X.Name local mns _ <- return $ fromString s
+-    case mns of
+-        Nothing -> [| X.Name (pack $(lift $ unpack local)) Nothing Nothing |]
+-        Just ns -> [| X.Name (pack $(lift $ unpack local)) (Just $ pack $(lift $ unpack ns)) Nothing |]
+-- 
+1.8.5.1
+