summaryrefslogtreecommitdiff
path: root/standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch
diff options
context:
space:
mode:
Diffstat (limited to 'standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch')
-rw-r--r--standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch223
1 files changed, 223 insertions, 0 deletions
diff --git a/standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch
new file mode 100644
index 000000000..38c2cb012
--- /dev/null
+++ b/standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch
@@ -0,0 +1,223 @@
+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
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-03 06:31:05 +0000