ccef06da41
Was able to reuse many of the android patches, but several had to be re-done. On Android, ghc is a stage2 build, so can compile, but not run TH code. But debian's ghc on armel cannot even compile TH code, so it has to be patched out. Some haskell packages have been updated to new versions, including yesod and DAV, and their patches had to be redone. The Makefile now has 2 new targets. The first is run on a companion x86 system to do the build and get TH splices. Then the second target is run the same source tree on the arm system to build without needing TH. This commit was sponsored by Svenne Krap.
108 lines
4 KiB
Diff
108 lines
4 KiB
Diff
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
|
|
|