git-annex/standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch

From b66f160fea86d8839572620892181eb4ada2ad29 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 17 Dec 2013 06:17:26 +0000
Subject: [PATCH 2/2] remove TH

---
 Text/Shakespeare.hs      | 131 +++--------------------------------------------
 Text/Shakespeare/Base.hs |  28 ----------
 2 files changed, 6 insertions(+), 153 deletions(-)

diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
index f908ff4..55cd1d1 100644
--- a/Text/Shakespeare.hs
+++ b/Text/Shakespeare.hs
@@ -12,14 +12,14 @@ module Text.Shakespeare
     , WrapInsertion (..)
     , PreConversion (..)
     , defaultShakespeareSettings
-    , shakespeare
-    , shakespeareFile
-    , shakespeareFileReload
+    --, shakespeare
+    --, shakespeareFile
+    -- , shakespeareFileReload
     -- * low-level
-    , shakespeareFromString
-    , shakespeareUsedIdentifiers
+    -- , shakespeareFromString
+    --, shakespeareUsedIdentifiers
     , RenderUrl
-    , VarType
+    --, VarType
     , Deref
     , Parser
 
@@ -151,38 +151,6 @@ defaultShakespeareSettings = ShakespeareSettings {
   , modifyFinalValue = Nothing
 }
 
-instance Lift PreConvert where
-    lift (PreConvert convert ignore comment wrapInsertion) =
-        [|PreConvert $(lift convert) $(lift ignore) $(lift comment) $(lift wrapInsertion)|]
-
-instance Lift WrapInsertion where
-    lift (WrapInsertion indent sb sep sc e wp) =
-        [|WrapInsertion $(lift indent) $(lift sb) $(lift sep) $(lift sc) $(lift e) $(lift wp)|]
-
-instance Lift PreConversion where
-    lift (ReadProcess command args) =
-        [|ReadProcess $(lift command) $(lift args)|]
-    lift Id = [|Id|]
-
-instance Lift ShakespeareSettings where
-    lift (ShakespeareSettings x1 x2 x3 x4 x5 x6 x7 x8 x9) =
-        [|ShakespeareSettings
-            $(lift x1) $(lift x2) $(lift x3)
-            $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7) $(lift x8) $(liftMExp x9)|]
-      where
-        liftExp (VarE n) = [|VarE $(liftName n)|]
-        liftExp (ConE n) = [|ConE $(liftName n)|]
-        liftExp _ = error "liftExp only supports VarE and ConE"
-        liftMExp Nothing = [|Nothing|]
-        liftMExp (Just e) = [|Just|] `appE` liftExp e
-        liftName (Name (OccName a) b) = [|Name (OccName $(lift a)) $(liftFlavour b)|]
-        liftFlavour NameS = [|NameS|]
-        liftFlavour (NameQ (ModName a)) = [|NameQ (ModName $(lift a))|]
-        liftFlavour (NameU _) = error "liftFlavour NameU" -- [|NameU $(lift $ fromIntegral a)|]
-        liftFlavour (NameL _) = error "liftFlavour NameL" -- [|NameU $(lift $ fromIntegral a)|]
-        liftFlavour (NameG ns (PkgName p) (ModName m)) = [|NameG $(liftNS ns) (PkgName $(lift p)) (ModName $(lift m))|]
-        liftNS VarName = [|VarName|]
-        liftNS DataName = [|DataName|]
 
 type QueryParameters = [(TS.Text, TS.Text)]
 type RenderUrl url = (url -> QueryParameters -> TS.Text)
@@ -346,77 +314,12 @@ pack' = TS.pack
 {-# NOINLINE pack' #-}
 #endif
 
-contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp
-contentsToShakespeare rs a = do
-    r <- newName "_render"
-    c <- mapM (contentToBuilder r) a
-    compiledTemplate <- case c of
-        -- Make sure we convert this mempty using toBuilder to pin down the
-        -- type appropriately
-        []  -> fmap (AppE $ wrap rs) [|mempty|]
-        [x] -> return x
-        _   -> do
-              mc <- [|mconcat|]
-              return $ mc `AppE` ListE c
-    fmap (maybe id AppE $ modifyFinalValue rs) $
-        if justVarInterpolation rs
-            then return compiledTemplate
-            else return $ LamE [VarP r] compiledTemplate
-      where
-        contentToBuilder :: Name -> Content -> Q Exp
-        contentToBuilder _ (ContentRaw s') = do
-            ts <- [|fromText . pack'|]
-            return $ wrap rs `AppE` (ts `AppE` LitE (StringL s'))
-        contentToBuilder _ (ContentVar d) =
-            return $ (toBuilder rs `AppE` derefToExp [] d)
-        contentToBuilder r (ContentUrl d) = do
-            ts <- [|fromText|]
-            return $ wrap rs `AppE` (ts `AppE` (VarE r `AppE` derefToExp [] d `AppE` ListE []))
-        contentToBuilder r (ContentUrlParam d) = do
-            ts <- [|fromText|]
-            up <- [|\r' (u, p) -> r' u p|]
-            return $ wrap rs `AppE` (ts `AppE` (up `AppE` VarE r `AppE` derefToExp [] d))
-        contentToBuilder r (ContentMix d) =
-            return $ derefToExp [] d `AppE` VarE r
-
-shakespeare :: ShakespeareSettings -> QuasiQuoter
-shakespeare r = QuasiQuoter { quoteExp = shakespeareFromString r }
-
-shakespeareFromString :: ShakespeareSettings -> String -> Q Exp
-shakespeareFromString r str = do
-    s <- qRunIO $ preFilter Nothing r $
-#ifdef WINDOWS
-          filter (/='\r')
-#endif
-          str
-    contentsToShakespeare r $ contentFromString r s
-
-shakespeareFile :: ShakespeareSettings -> FilePath -> Q Exp
-shakespeareFile r fp = do
-#ifdef GHC_7_4
-    qAddDependentFile fp
-#endif
-    readFileQ fp >>= shakespeareFromString r
-
-data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin
-
-getVars :: Content -> [(Deref, VarType)]
-getVars ContentRaw{} = []
-getVars (ContentVar d) = [(d, VTPlain)]
-getVars (ContentUrl d) = [(d, VTUrl)]
-getVars (ContentUrlParam d) = [(d, VTUrlParam)]
-getVars (ContentMix d) = [(d, VTMixin)]
 
 data VarExp url = EPlain Builder
                 | EUrl url
                 | EUrlParam (url, [(TS.Text, TS.Text)])
                 | EMixin (Shakespeare url)
 
--- | Determine which identifiers are used by the given template, useful for
--- creating systems like yesod devel.
-shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)]
-shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings
-
 type MTime = UTCTime
 
 {-# NOINLINE reloadMapRef #-}
@@ -432,28 +335,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content]
 insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef
   (\reloadMap -> (M.insert fp (mt, content) reloadMap, content))
 
-shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp
-shakespeareFileReload settings fp = do
-    str <- readFileQ fp
-    s <- qRunIO $ preFilter (Just fp) settings str
-    let b = shakespeareUsedIdentifiers settings s
-    c <- mapM vtToExp b
-    rt <- [|shakespeareRuntime settings fp|]
-    wrap' <- [|\x -> $(return $ wrap settings) . x|]
-    return $ wrap' `AppE` (rt `AppE` ListE c)
-  where
-    vtToExp :: (Deref, VarType) -> Q Exp
-    vtToExp (d, vt) = do
-        d' <- lift d
-        c' <- c vt
-        return $ TupE [d', c' `AppE` derefToExp [] d]
-      where
-        c :: VarType -> Q Exp
-        c VTPlain = [|EPlain . $(return $
-          InfixE (Just $ unwrap settings) (VarE '(.)) (Just $ toBuilder settings))|]
-        c VTUrl = [|EUrl|]
-        c VTUrlParam = [|EUrlParam|]
-        c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap settings) $ x r|]
 
 
 
diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs
index 9573533..49f1995 100644
--- a/Text/Shakespeare/Base.hs
+++ b/Text/Shakespeare/Base.hs
@@ -52,34 +52,6 @@ data Deref = DerefModulesIdent [String] Ident
            | DerefTuple [Deref]
     deriving (Show, Eq, Read, Data, Typeable, Ord)
 
-instance Lift Ident where
-    lift (Ident s) = [|Ident|] `appE` lift s
-instance Lift Deref where
-    lift (DerefModulesIdent v s) = do
-        dl <- [|DerefModulesIdent|]
-        v' <- lift v
-        s' <- lift s
-        return $ dl `AppE` v' `AppE` s'
-    lift (DerefIdent s) = do
-        dl <- [|DerefIdent|]
-        s' <- lift s
-        return $ dl `AppE` s'
-    lift (DerefBranch x y) = do
-        x' <- lift x
-        y' <- lift y
-        db <- [|DerefBranch|]
-        return $ db `AppE` x' `AppE` y'
-    lift (DerefIntegral i) = [|DerefIntegral|] `appE` lift i
-    lift (DerefRational r) = do
-        n <- lift $ numerator r
-        d <- lift $ denominator r
-        per <- [|(%) :: Int -> Int -> Ratio Int|]
-        dr <- [|DerefRational|]
-        return $ dr `AppE` InfixE (Just n) per (Just d)
-    lift (DerefString s) = [|DerefString|] `appE` lift s
-    lift (DerefList x) = [|DerefList $(lift x)|]
-    lift (DerefTuple x) = [|DerefTuple $(lift x)|]
-
 derefParens, derefCurlyBrackets :: UserParser a Deref
 derefParens        = between (char '(') (char ')') parseDeref
 derefCurlyBrackets = between (char '{') (char '}') parseDeref
-- 
1.8.5.1