summaryrefslogtreecommitdiff
path: root/standalone/android/haskell-patches/xml-hamlet_0.4.0.3-0001-remove-TH-code.patch
diff options
context:
space:
mode:
Diffstat (limited to 'standalone/android/haskell-patches/xml-hamlet_0.4.0.3-0001-remove-TH-code.patch')
-rw-r--r--standalone/android/haskell-patches/xml-hamlet_0.4.0.3-0001-remove-TH-code.patch108
1 files changed, 108 insertions, 0 deletions
diff --git a/standalone/android/haskell-patches/xml-hamlet_0.4.0.3-0001-remove-TH-code.patch b/standalone/android/haskell-patches/xml-hamlet_0.4.0.3-0001-remove-TH-code.patch
new file mode 100644
index 000000000..e6bda563d
--- /dev/null
+++ b/standalone/android/haskell-patches/xml-hamlet_0.4.0.3-0001-remove-TH-code.patch
@@ -0,0 +1,108 @@
+From 3e988dec5ea248611d07d59914e3eb131dc6a165 Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Thu, 18 Apr 2013 17:44:46 -0400
+Subject: [PATCH] remove TH code
+
+---
+ 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..bf8ce9e 100644
+--- a/Text/Hamlet/XML.hs
++++ b/Text/Hamlet/XML.hs
+@@ -1,8 +1,7 @@
+ {-# LANGUAGE TemplateHaskell #-}
+ {-# OPTIONS_GHC -fno-warn-missing-fields #-}
+ module Text.Hamlet.XML
+- ( xml
+- , xmlFile
++ (
+ ) where
+
+ import Language.Haskell.TH.Syntax
+@@ -18,81 +17,3 @@ import Data.String (fromString)
+ 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.2.rc3
+