git-annex-4.20130516: standalone/android/haskell-patches/hamlet_1.1.6.1_0001-remove-TH.patch
From b2c677ed39f1aca3a1111691ba51b26f7fd414a4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 8 May 2013 01:50:58 -0400
Subject: [PATCH] remove TH
---
Text/Hamlet.hs | 219 ++------------------------------------------------------
hamlet.cabal | 2 +-
2 files changed, 7 insertions(+), 214 deletions(-)
diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
index 4ac870a..63b8555 100644
--- a/Text/Hamlet.hs
+++ b/Text/Hamlet.hs
@@ -11,35 +11,26 @@
module Text.Hamlet
( -- * Plain HTML
Html
- , shamlet
- , shamletFile
- , xshamlet
- , xshamletFile
-- * Hamlet
, HtmlUrl
- , hamlet
- , hamletFile
- , xhamlet
- , xhamletFile
-- * I18N Hamlet
, HtmlUrlI18n
- , ihamlet
- , ihamletFile
-- * Type classes
, ToAttributes (..)
-- * Internal, for making more
, HamletSettings (..)
, NewlineStyle (..)
- , hamletWithSettings
- , hamletFileWithSettings
, defaultHamletSettings
, xhtmlHamletSettings
, Env (..)
, HamletRules (..)
- , hamletRules
- , ihamletRules
- , htmlRules
, CloseStyle (..)
+ , condH
+ , maybeH
+
+ -- referred to in TH splices
+ , attrsToHtml
+ , asHtmlUrl
) where
import Text.Shakespeare.Base
@@ -90,14 +81,6 @@ 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
@@ -159,169 +142,9 @@ recordToFieldNames conStr = do
[fields] <- return [fields | RecC name fields <- cons, name == conName]
return [fieldName | (fieldName, _, _) <- fields]
-docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp
-docToExp env hr scope (DocForall list idents inside) = do
- let list' = derefToExp scope list
- (pat, extraScope) <- bindingPattern idents
- let scope' = extraScope ++ scope
- mh <- [|F.mapM_|]
- inside' <- docsToExp env hr scope' inside
- let lam = LamE [pat] inside'
- return $ mh `AppE` lam `AppE` list'
-docToExp env hr scope (DocWith [] inside) = do
- inside' <- docsToExp env hr scope inside
- return $ inside'
-docToExp env hr scope (DocWith ((deref, idents):dis) inside) = do
- let deref' = derefToExp scope deref
- (pat, extraScope) <- bindingPattern idents
- let scope' = extraScope ++ scope
- inside' <- docToExp env hr scope' (DocWith dis inside)
- let lam = LamE [pat] inside'
- return $ lam `AppE` deref'
-docToExp env hr scope (DocMaybe val idents inside mno) = do
- let val' = derefToExp scope val
- (pat, extraScope) <- bindingPattern idents
- let scope' = extraScope ++ scope
- inside' <- docsToExp env hr scope' inside
- let inside'' = LamE [pat] inside'
- ninside' <- case mno of
- Nothing -> [|Nothing|]
- Just no -> do
- no' <- docsToExp env hr scope no
- j <- [|Just|]
- return $ j `AppE` no'
- mh <- [|maybeH|]
- return $ mh `AppE` val' `AppE` inside'' `AppE` ninside'
-docToExp env hr scope (DocCond conds final) = do
- conds' <- mapM go conds
- final' <- case final of
- Nothing -> [|Nothing|]
- Just f -> do
- f' <- docsToExp env hr scope f
- j <- [|Just|]
- return $ j `AppE` f'
- ch <- [|condH|]
- return $ ch `AppE` ListE conds' `AppE` final'
- where
- go :: (Deref, [Doc]) -> Q Exp
- go (d, docs) = do
- let d' = derefToExp scope d
- docs' <- docsToExp env hr scope docs
- return $ TupE [d', docs']
-docToExp env hr scope (DocCase deref cases) = do
- let exp_ = derefToExp scope deref
- matches <- mapM toMatch cases
- return $ CaseE exp_ matches
- where
- readMay s =
- case reads s of
- (x, ""):_ -> Just x
- _ -> Nothing
- toMatch (idents, inside) = do
- let pat = case map unIdent idents of
- ["_"] -> WildP
- [str]
- | Just i <- readMay str -> LitP $ IntegerL i
- strs -> let (constr:fields) = map mkName strs
- in ConP constr (map VarP fields)
- insideExp <- docsToExp env hr scope inside
- return $ Match pat (NormalB insideExp) []
-docToExp env hr v (DocContent c) = contentToExp env hr v c
-
-contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp
-contentToExp _ hr _ (ContentRaw s) = do
- os <- [|preEscapedText . pack|]
- let s' = LitE $ StringL s
- return $ hrFromHtml hr `AppE` (os `AppE` s')
-contentToExp _ hr scope (ContentVar d) = do
- str <- [|toHtml|]
- return $ hrFromHtml hr `AppE` (str `AppE` derefToExp scope d)
-contentToExp env hr scope (ContentUrl hasParams d) =
- case urlRender env of
- Nothing -> error "URL interpolation used, but no URL renderer provided"
- Just wrender -> wrender $ \render -> do
- let render' = return render
- ou <- if hasParams
- then [|\(u, p) -> $(render') u p|]
- else [|\u -> $(render') u []|]
- let d' = derefToExp scope d
- pet <- [|toHtml|]
- return $ hrFromHtml hr `AppE` (pet `AppE` (ou `AppE` d'))
-contentToExp env hr scope (ContentEmbed d) = hrEmbed hr env $ derefToExp scope d
-contentToExp env hr scope (ContentMsg d) =
- case msgRender env of
- Nothing -> error "Message interpolation used, but no message renderer provided"
- Just wrender -> wrender $ \render ->
- return $ hrFromHtml hr `AppE` (render `AppE` derefToExp scope d)
-contentToExp _ hr scope (ContentAttrs d) = do
- html <- [|attrsToHtml . toAttributes|]
- return $ hrFromHtml hr `AppE` (html `AppE` derefToExp scope d)
-
-shamlet :: QuasiQuoter
-shamlet = hamletWithSettings htmlRules defaultHamletSettings
-
-xshamlet :: QuasiQuoter
-xshamlet = hamletWithSettings htmlRules xhtmlHamletSettings
-
-htmlRules :: Q HamletRules
-htmlRules = do
- i <- [|id|]
- return $ HamletRules i ($ (Env Nothing Nothing)) (\_ b -> return b)
-
-hamlet :: QuasiQuoter
-hamlet = hamletWithSettings hamletRules defaultHamletSettings
-
-xhamlet :: QuasiQuoter
-xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings
-
asHtmlUrl :: HtmlUrl url -> HtmlUrl url
asHtmlUrl = id
-hamletRules :: Q HamletRules
-hamletRules = do
- i <- [|id|]
- let ur f = do
- r <- newName "_render"
- let env = Env
- { urlRender = Just ($ (VarE r))
- , msgRender = Nothing
- }
- h <- f env
- return $ LamE [VarP r] h
- return $ HamletRules i ur em
- where
- em (Env (Just urender) Nothing) e = do
- asHtmlUrl' <- [|asHtmlUrl|]
- urender $ \ur' -> return ((asHtmlUrl' `AppE` e) `AppE` ur')
- em _ _ = error "bad Env"
-
-ihamlet :: QuasiQuoter
-ihamlet = hamletWithSettings ihamletRules defaultHamletSettings
-
-ihamletRules :: Q HamletRules
-ihamletRules = do
- i <- [|id|]
- let ur f = do
- u <- newName "_urender"
- m <- newName "_mrender"
- let env = Env
- { urlRender = Just ($ (VarE u))
- , msgRender = Just ($ (VarE m))
- }
- h <- f env
- return $ LamE [VarP m, VarP u] h
- return $ HamletRules i ur em
- where
- em (Env (Just urender) (Just mrender)) e =
- urender $ \ur' -> mrender $ \mr -> return (e `AppE` mr `AppE` ur')
- em _ _ = error "bad Env"
-
-hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter
-hamletWithSettings hr set =
- QuasiQuoter
- { quoteExp = hamletFromString hr set
- }
-
data HamletRules = HamletRules
{ hrFromHtml :: Exp
, hrWithEnv :: (Env -> Q Exp) -> Q Exp
@@ -333,36 +156,6 @@ data Env = Env
, msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
}
-hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp
-hamletFromString qhr set s = do
- hr <- qhr
- case parseDoc set s of
- Error s' -> error s'
- Ok (_mnl, d) -> hrWithEnv hr $ \env -> docsToExp env hr [] d
-
-hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
-hamletFileWithSettings qhr set fp = do
-#ifdef GHC_7_4
- qAddDependentFile fp
-#endif
- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
- hamletFromString qhr set contents
-
-hamletFile :: FilePath -> Q Exp
-hamletFile = hamletFileWithSettings hamletRules defaultHamletSettings
-
-xhamletFile :: FilePath -> Q Exp
-xhamletFile = hamletFileWithSettings hamletRules xhtmlHamletSettings
-
-shamletFile :: FilePath -> Q Exp
-shamletFile = hamletFileWithSettings htmlRules defaultHamletSettings
-
-xshamletFile :: FilePath -> Q Exp
-xshamletFile = hamletFileWithSettings htmlRules xhtmlHamletSettings
-
-ihamletFile :: FilePath -> Q Exp
-ihamletFile = hamletFileWithSettings ihamletRules defaultHamletSettings
-
varName :: Scope -> String -> Exp
varName _ "" = error "Illegal empty varName"
varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope
diff --git a/hamlet.cabal b/hamlet.cabal
index 73fa6a8..4348508 100644
--- a/hamlet.cabal
+++ b/hamlet.cabal
@@ -50,7 +50,7 @@ library
, text >= 0.7 && < 0.12
, containers >= 0.2
, blaze-builder >= 0.2 && < 0.4
- , process >= 1.0 && < 1.2
+ , process >= 1.0 && < 1.3
, blaze-html >= 0.5 && < 0.6
, blaze-markup >= 0.5.1 && < 0.6
--
1.7.10.4