diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs --- a/Text/Shakespeare.hs +++ b/Text/Shakespeare.hs @@ -8,6 +8,8 @@ -- | For lack of a better name... a parameterized version of Julius. module Text.Shakespeare ( ShakespeareSettings (..) + , PreConvert (..) + , PreConversion (..) , defaultShakespeareSettings , shakespeare , shakespeareFile @@ -15,6 +17,10 @@ -- * low-level , shakespeareFromString , RenderUrl + +#ifdef TEST_EXPORT + , preFilter +#endif ) where import Text.ParserCombinators.Parsec hiding (Line) @@ -28,15 +34,44 @@ import qualified Data.Text.Lazy as TL import Text.Shakespeare.Base --- move to Shakespeare? +-- for pre conversion +import System.Process (readProcess) + +-- move to Shakespeare.Base? readFileQ :: FilePath -> Q String -readFileQ fp = - qRunIO $ readFileUtf8 fp +readFileQ fp = qRunIO $ readFileUtf8 fp --- move to Shakespeare? +-- move to Shakespeare.Base? readFileUtf8 :: FilePath -> IO String readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp +-- | The Coffeescript language compiles down to Javascript. +-- Previously we waited until the very end, at the rendering stage to perform this compilation. +-- Lets call is a post-conversion +-- This had the advantage that all Haskell values were inserted first: +-- for example a value could be inserted that Coffeescript would compile into Javascript. +-- While that is perhaps a safer approach, the advantage is not used in practice: +-- it was that way mainly for ease of implementation. +-- The down-side is the template must be compiled down to Javascript during every request. +-- If instead we do a pre-conversion to compile down to Javascript, +-- we only need to perform the compilation once. +-- During the pre-conversion we first modify all Haskell insertions +-- so that they will be ignored by the Coffeescript compiler (backticks). +-- So %{var} is change to `%{var}` using the preEscapeBegin and preEscapeEnd. +-- preEscapeIgnore is used to not insert backtacks for variable already inside strings - coffeescript will happily ignore them, and won't treat backticks as escaping + +data PreConvert = PreConvert + { preConvert :: PreConversion + , preEscapeBegin :: String + , preEscapeEnd :: String + , preEscapeIgnore :: [Char] + } + +data PreConversion = ReadProcess String [String] + | Id + + + data ShakespeareSettings = ShakespeareSettings { varChar :: Char , urlChar :: Char @@ -45,21 +80,32 @@ , wrap :: Exp , unwrap :: Exp , justVarInterpolation :: Bool + , preConversion :: Maybe PreConvert } + defaultShakespeareSettings :: ShakespeareSettings defaultShakespeareSettings = ShakespeareSettings { varChar = '#' , urlChar = '@' , intChar = '^' , justVarInterpolation = False + , preConversion = Nothing } +instance Lift PreConvert where + lift (PreConvert convert begin end ignore) = + [|PreConvert $(lift convert) $(lift begin) $(lift end) $(lift ignore)|] +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) = + lift (ShakespeareSettings x1 x2 x3 x4 x5 x6 x7 x8) = [|ShakespeareSettings $(lift x1) $(lift x2) $(lift x3) - $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7)|] + $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7) $(lift x8)|] where liftExp (VarE n) = [|VarE $(liftName n)|] liftExp (ConE n) = [|ConE $(liftName n)|] @@ -85,32 +131,69 @@ deriving (Show, Eq) type Contents = [Content] -contentFromString :: ShakespeareSettings -> (String -> [Content]) +eShowErrors :: Either ParseError c -> c +eShowErrors = either (error . show) id + +contentFromString :: ShakespeareSettings -> String -> [Content] contentFromString rs s = - compressContents $ either (error . show) id $ parse (parseContents rs) s s + compressContents $ eShowErrors $ parse (parseContents rs) s s where compressContents :: Contents -> Contents compressContents [] = [] compressContents (ContentRaw x:ContentRaw y:z) = compressContents $ ContentRaw (x ++ y) : z compressContents (x:y) = x : compressContents y - + parseContents :: ShakespeareSettings -> Parser Contents parseContents = many1 . parseContent where parseContent :: ShakespeareSettings -> Parser Content parseContent ShakespeareSettings {..} = - parseHash' <|> parseAt' <|> parseCaret' <|> parseChar + parseVar' <|> parseUrl' <|> parseInt' <|> parseChar' where - parseHash' = either ContentRaw ContentVar `fmap` parseVar varChar - parseAt' = - either ContentRaw go `fmap` parseUrl urlChar '?' + parseVar' = either ContentRaw ContentVar `fmap` parseVar varChar + parseUrl' = either ContentRaw contentUrl `fmap` parseUrl urlChar '?' where - go (d, False) = ContentUrl d - go (d, True) = ContentUrlParam d - parseCaret' = either ContentRaw ContentMix `fmap` parseInt intChar - parseChar = ContentRaw `fmap` many1 (noneOf [varChar, urlChar, intChar]) + contentUrl (d, False) = ContentUrl d + contentUrl (d, True) = ContentUrlParam d + parseInt' = either ContentRaw ContentMix `fmap` parseInt intChar + parseChar' = ContentRaw `fmap` many1 (noneOf [varChar, urlChar, intChar]) + + +preFilter :: ShakespeareSettings -> String -> IO String +preFilter ShakespeareSettings {..} s = + case preConversion of + Nothing -> return s + Just pre@(PreConvert convert _ _ _) -> + let parsed = mconcat $ eShowErrors $ parse (parseConvert pre) s s + in case convert of + Id -> return parsed + ReadProcess command args -> + readProcess command (args ++ [parsed]) [] + where + parseConvert PreConvert {..} = many1 $ choice $ + (map (try . escapedParse) preEscapeIgnore) ++ + [mainParser preEscapeIgnore] + + where + escapedParse ignoreC = do + _<- char ignoreC + inside <- many $ noneOf [ignoreC] + _<- char ignoreC + return $ ignoreC:inside ++ [ignoreC] + -- return $ ignoreC:(eShowErrors $ parse (mainParser escapeNone) "" inside) ++ [ignoreC] + + mainParser i = parseVar' <|> parseUrl' <|> parseInt' <|> parseChar' i + escape str = preEscapeBegin ++ str ++ preEscapeEnd + escapeRight = either id escape + + parseVar' = escapeRight `fmap` parseVarString varChar + parseUrl' = escapeRight `fmap` parseUrlString urlChar '?' + parseInt' = escapeRight `fmap` parseIntString intChar + parseChar' i = many1 (noneOf ([varChar, urlChar, intChar] ++ i)) + + contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp contentsToShakespeare rs a = do r <- newName "_render" @@ -145,11 +228,16 @@ shakespeare r = QuasiQuoter { quoteExp = shakespeareFromString r } shakespeareFromString :: ShakespeareSettings -> String -> Q Exp -shakespeareFromString r s = do - contentsToShakespeare r $ contentFromString r s +shakespeareFromString r str = do + s <- qRunIO $ preFilter r str + contentsToShakespeare r $ contentFromString r $ s shakespeareFile :: ShakespeareSettings -> FilePath -> Q Exp -shakespeareFile r fp = readFileQ fp >>= shakespeareFromString r +shakespeareFile r fp = do +#ifdef GHC_7_4 + qAddDependentFile fp +#endif + readFileQ fp >>= shakespeareFromString r data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin @@ -167,7 +255,8 @@ shakespeareFileDebug :: ShakespeareSettings -> FilePath -> Q Exp shakespeareFileDebug rs fp = do - s <- readFileQ fp + str <- readFileQ fp + s <- qRunIO $ preFilter rs str let b = concatMap getVars $ contentFromString rs s c <- mapM vtToExp b rt <- [|shakespeareRuntime|] @@ -190,7 +279,8 @@ shakespeareRuntime :: ShakespeareSettings -> FilePath -> [(Deref, VarExp url)] -> Shakespeare url shakespeareRuntime rs fp cd render' = unsafePerformIO $ do - s <- readFileUtf8 fp + str <- readFileUtf8 fp + s <- preFilter rs str return $ mconcat $ map go $ contentFromString rs s where go :: Content -> Builder diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs --- a/Text/Shakespeare/Base.hs +++ b/Text/Shakespeare/Base.hs @@ -10,11 +10,14 @@ , parseDeref , parseHash , parseVar + , parseVarString , parseAt , parseUrl + , parseUrlString , parseCaret , parseUnder , parseInt + , parseIntString , derefToExp , flattenDeref , readUtf8File @@ -184,6 +187,13 @@ parseHash :: Parser (Either String Deref) parseHash = parseVar '#' +curlyBrackets :: Parser String +curlyBrackets = do + _<- char '{' + var <- many1 $ noneOf "}" + _<- char '}' + return $ ('{':var) ++ "}" + parseVar :: Char -> Parser (Either String Deref) parseVar c = do _ <- char c @@ -207,6 +217,28 @@ deref <- derefCurlyBrackets return $ Right (deref, x)) <|> return (Left $ if x then [c, d] else [c])) + +parseInterpolatedString :: Char -> Parser (Either String String) +parseInterpolatedString c = do + _ <- char c + (char '\\' >> return (Left ['\\', c])) <|> (do + bracketed <- curlyBrackets + return $ Right (c:bracketed)) <|> return (Left [c]) + +parseVarString :: Char -> Parser (Either String String) +parseVarString = parseInterpolatedString + +parseUrlString :: Char -> Char -> Parser (Either String String) +parseUrlString c d = do + _ <- char c + (char '\\' >> return (Left [c, '\\'])) <|> (do + ds <- (char d >> return [d]) <|> return [] + (do bracketed <- curlyBrackets + return $ Right (c:ds ++ bracketed)) + <|> return (Left (c:ds))) + +parseIntString :: Char -> Parser (Either String String) +parseIntString = parseInterpolatedString parseCaret :: Parser (Either String Deref) parseCaret = parseInt '^' diff --git a/shakespeare.cabal b/shakespeare.cabal --- a/shakespeare.cabal +++ b/shakespeare.cabal @@ -1,16 +1,19 @@ name: shakespeare -version: 0.10.2 +version: 0.10.3 license: BSD3 license-file: LICENSE author: Michael Snoyman maintainer: Michael Snoyman synopsis: A toolkit for making compile-time interpolated templates description: - Shakespeare is a template family for type-safe, efficient templates with simple variable interpolation . Shakespeare templates can be used inline with a quasi-quoter or in an external file. Shakespeare interpolates variables according to the type being inserted. + Shakespeare is a family of type-safe, efficient template languages. Shakespeare templates are expanded at compile-time, ensuring that all interpolated variables are in scope. Variables are interpolated according to their type through a typeclass. . - Note there is no dependency on haskell-src-extras. + Shakespeare templates can be used inline with a quasi-quoter or in an external file. . - packages that use this: shakespeare-js, shakespeare-css, shakespeare-interpolated, hamlet, and xml-hamlet + Note there is no dependency on haskell-src-extras. Instead Shakespeare believes logic should stay out of templates and has its own minimal Haskell parser. + . + Packages that use this: shakespeare-js, shakespeare-css, shakespeare-text, hamlet, and xml-hamlet + . Please see the documentation at for more details. category: Web, Yesod @@ -24,10 +27,31 @@ , template-haskell , parsec >= 2 && < 4 , text >= 0.7 && < 0.12 + , process >= 1.0 && < 1.2 + exposed-modules: Text.Shakespeare Text.Shakespeare.Base ghc-options: -Wall + + if flag(test_export) + cpp-options: -DTEST_EXPORT + +Flag test_export + default: False + +test-suite test + hs-source-dirs: test + main-is: ../test.hs + type: exitcode-stdio-1.0 + + ghc-options: -Wall + build-depends: shakespeare >= 0.10.3 && < 0.11 + , base >= 4 && < 5 + , parsec >= 2 && < 4 + , HUnit + , hspec >= 0.8 && < 0.10 + , text >= 0.7 && < 0.12 source-repository head