208 lines
8 KiB
Diff
208 lines
8 KiB
Diff
From 10484c5f68431349b249f07517c392c4a90bdb05 Mon Sep 17 00:00:00 2001
|
|
From: Joey Hess <joey@kitenet.net>
|
|
Date: Wed, 8 May 2013 01:47:19 -0400
|
|
Subject: [PATCH] remove TH
|
|
|
|
---
|
|
Text/Shakespeare.hs | 109 ----------------------------------------------
|
|
Text/Shakespeare/Base.hs | 28 ------------
|
|
shakespeare.cabal | 2 +-
|
|
3 files changed, 1 insertion(+), 138 deletions(-)
|
|
|
|
diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
|
|
index 7750135..fabbf66 100644
|
|
--- a/Text/Shakespeare.hs
|
|
+++ b/Text/Shakespeare.hs
|
|
@@ -12,11 +12,7 @@ module Text.Shakespeare
|
|
, WrapInsertion (..)
|
|
, PreConversion (..)
|
|
, defaultShakespeareSettings
|
|
- , shakespeare
|
|
- , shakespeareFile
|
|
- , shakespeareFileReload
|
|
-- * low-level
|
|
- , shakespeareFromString
|
|
, shakespeareUsedIdentifiers
|
|
, RenderUrl
|
|
, VarType
|
|
@@ -135,39 +131,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 ab ac) =
|
|
- [|WrapInsertion $(lift indent) $(lift sb) $(lift sep) $(lift sc) $(lift e) $(lift ab) $(lift ac)|]
|
|
-
|
|
-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)
|
|
type Shakespeare url = RenderUrl url -> Builder
|
|
@@ -302,54 +265,6 @@ 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 $ wrap rs `AppE` (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 r 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)]
|
|
@@ -369,30 +284,6 @@ data VarExp url = EPlain Builder
|
|
shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)]
|
|
shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings
|
|
|
|
-shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp
|
|
-shakespeareFileReload rs fp = do
|
|
- str <- readFileQ fp
|
|
- s <- qRunIO $ preFilter rs str
|
|
- let b = shakespeareUsedIdentifiers rs s
|
|
- c <- mapM vtToExp b
|
|
- rt <- [|shakespeareRuntime|]
|
|
- wrap' <- [|\x -> $(return $ wrap rs) . x|]
|
|
- r' <- lift rs
|
|
- return $ wrap' `AppE` (rt `AppE` r' `AppE` (LitE $ StringL fp) `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 $ toBuilder rs)|]
|
|
- c VTUrl = [|EUrl|]
|
|
- c VTUrlParam = [|EUrlParam|]
|
|
- c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap rs) $ x r|]
|
|
-
|
|
-
|
|
shakespeareRuntime :: ShakespeareSettings -> FilePath -> [(Deref, VarExp url)] -> Shakespeare url
|
|
shakespeareRuntime rs fp cd render' = unsafePerformIO $ do
|
|
str <- readFileUtf8 fp
|
|
diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs
|
|
index 7c96898..ef769b1 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
|
|
diff --git a/shakespeare.cabal b/shakespeare.cabal
|
|
index 01c8d5d..0fff966 100644
|
|
--- a/shakespeare.cabal
|
|
+++ b/shakespeare.cabal
|
|
@@ -27,7 +27,7 @@ library
|
|
, template-haskell
|
|
, parsec >= 2 && < 4
|
|
, text >= 0.7 && < 0.12
|
|
- , process >= 1.0 && < 1.2
|
|
+ , process >= 1.0 && < 1.3
|
|
|
|
exposed-modules:
|
|
Text.Shakespeare
|
|
--
|
|
1.7.10.4
|
|
|