summaryrefslogtreecommitdiff
path: root/standalone/android/haskell-patches/hamlet-1.1.6.1_0001-axe-murdered.patch
diff options
context:
space:
mode:
Diffstat (limited to 'standalone/android/haskell-patches/hamlet-1.1.6.1_0001-axe-murdered.patch')
-rw-r--r--standalone/android/haskell-patches/hamlet-1.1.6.1_0001-axe-murdered.patch276
1 files changed, 276 insertions, 0 deletions
diff --git a/standalone/android/haskell-patches/hamlet-1.1.6.1_0001-axe-murdered.patch b/standalone/android/haskell-patches/hamlet-1.1.6.1_0001-axe-murdered.patch
new file mode 100644
index 000000000..c1188ee14
--- /dev/null
+++ b/standalone/android/haskell-patches/hamlet-1.1.6.1_0001-axe-murdered.patch
@@ -0,0 +1,276 @@
+From 7be8bf3ba75acc5209066e6ba31ae589c541f344 Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Thu, 28 Feb 2013 23:30:01 -0400
+Subject: [PATCH] axe murdered
+
+---
+ Text/Hamlet.hs | 215 +-------------------------------------------------------
+ 1 file changed, 2 insertions(+), 213 deletions(-)
+
+diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
+index 4ac870a..bc8edd5 100644
+--- a/Text/Hamlet.hs
++++ b/Text/Hamlet.hs
+@@ -11,35 +11,22 @@
+ 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
+ ) where
+
+ import Text.Shakespeare.Base
+@@ -90,14 +77,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 +138,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 +152,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
+--
+1.7.10.4
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-04 01:41:59 +0000