path: root/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