shakespeare-1.0.2/0000755000000000000000000000000012044655007012176 5ustar0000000000000000shakespeare-1.0.2/shakespeare.cabal0000644000000000000000000000432512044655007015461 0ustar0000000000000000name: shakespeare version: 1.0.2 license: MIT license-file: LICENSE author: Michael Snoyman maintainer: Michael Snoyman synopsis: A toolkit for making compile-time interpolated templates description: 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. . Shakespeare templates can be used inline with a quasi-quoter or in an external file. . 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 stability: Stable cabal-version: >= 1.8 build-type: Simple homepage: http://www.yesodweb.com/book/shakespearean-templates library build-depends: base >= 4 && < 5 , 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 other-modules: ShakespeareBaseTest cpp-options: -DTEST_EXPORT type: exitcode-stdio-1.0 ghc-options: -Wall build-depends: base >= 4 && < 5 , parsec >= 2 && < 4 , hspec >= 1.3 , text >= 0.7 && < 0.12 , process , template-haskell source-repository head type: git location: git://github.com/yesodweb/shakespeare.git shakespeare-1.0.2/Setup.lhs0000644000000000000000000000021712044655007014006 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > import System.Cmd (system) > main :: IO () > main = defaultMain shakespeare-1.0.2/test.hs0000644000000000000000000000014112044655007013505 0ustar0000000000000000import Test.Hspec.Monadic import ShakespeareBaseTest (specs) main :: IO () main = hspec $ specs shakespeare-1.0.2/LICENSE0000644000000000000000000000207512044655007013207 0ustar0000000000000000Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. shakespeare-1.0.2/Text/0000755000000000000000000000000012044655007013122 5ustar0000000000000000shakespeare-1.0.2/Text/Shakespeare.hs0000644000000000000000000003113412044655007015713 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- | For lack of a better name... a parameterized version of Julius. module Text.Shakespeare ( ShakespeareSettings (..) , PreConvert (..) , PreConversion (..) , defaultShakespeareSettings , shakespeare , shakespeareFile , shakespeareFileReload -- * low-level , shakespeareFromString , shakespeareUsedIdentifiers , RenderUrl , VarType , Deref #ifdef TEST_EXPORT , preFilter #endif ) where import Text.ParserCombinators.Parsec hiding (Line) import Language.Haskell.TH.Quote (QuasiQuoter (..)) import Language.Haskell.TH (appE) import Language.Haskell.TH.Syntax #if !MIN_VERSION_template_haskell(2,8,0) import Language.Haskell.TH.Syntax.Internals #endif import Data.Text.Lazy.Builder (Builder, fromText) import Data.Monoid import System.IO.Unsafe (unsafePerformIO) import qualified Data.Text as TS import qualified Data.Text.Lazy as TL import Text.Shakespeare.Base -- for pre conversion import System.Process (readProcess) -- move to Shakespeare.Base? readFileQ :: FilePath -> Q String readFileQ fp = qRunIO $ readFileUtf8 fp -- 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. -- preEscapeIgnoreBalanced is used to not insert backtacks for variable already inside strings or backticks. -- coffeescript will happily ignore the interpolations, and backticks would not be treated as escaping in that context. -- preEscapeIgnoreLine was added to ignore comments (which in Coffeescript begin with a '#') data PreConvert = PreConvert { preConvert :: PreConversion , preEscapeBegin :: String , preEscapeEnd :: String , preEscapeIgnoreBalanced :: [Char] , preEscapeIgnoreLine :: [Char] } data PreConversion = ReadProcess String [String] | Id data ShakespeareSettings = ShakespeareSettings { varChar :: Char , urlChar :: Char , intChar :: Char , toBuilder :: Exp , wrap :: Exp , unwrap :: Exp , justVarInterpolation :: Bool , preConversion :: Maybe PreConvert , modifyFinalValue :: Maybe Exp -- ^ A transformation applied to the final expression. Most often, this -- would be used to force the type of the expression to help make more -- meaningful error messages. } defaultShakespeareSettings :: ShakespeareSettings defaultShakespeareSettings = ShakespeareSettings { varChar = '#' , urlChar = '@' , intChar = '^' , justVarInterpolation = False , preConversion = Nothing , modifyFinalValue = Nothing } instance Lift PreConvert where lift (PreConvert convert begin end ignore comment) = [|PreConvert $(lift convert) $(lift begin) $(lift end) $(lift ignore) $(lift comment)|] 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 data Content = ContentRaw String | ContentVar Deref | ContentUrl Deref | ContentUrlParam Deref | ContentMix Deref deriving (Show, Eq) type Contents = [Content] eShowErrors :: Either ParseError c -> c eShowErrors = either (error . show) id contentFromString :: ShakespeareSettings -> String -> [Content] contentFromString _ "" = [] contentFromString rs 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 {..} = parseVar' <|> parseUrl' <|> parseInt' <|> parseChar' where parseVar' = either ContentRaw ContentVar `fmap` parseVar varChar parseUrl' = either ContentRaw contentUrl `fmap` parseUrl urlChar '?' where 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) preEscapeIgnoreBalanced ++ [mainParser] where escapedParse ignoreC = do _<- char ignoreC inside <- many $ noneOf [ignoreC] _<- char ignoreC return $ ignoreC:inside ++ [ignoreC] mainParser = parseVar' <|> parseUrl' <|> parseInt' <|> parseCommentLine preEscapeIgnoreLine <|> parseChar' preEscapeIgnoreLine preEscapeIgnoreBalanced escape str = preEscapeBegin ++ str ++ preEscapeEnd escapeRight = either id escape newLine = "\r\n" parseCommentLine cs = do begin <- oneOf cs comment <- many $ noneOf newLine return $ begin : comment parseVar' = escapeRight `fmap` parseVarString varChar parseUrl' = escapeRight `fmap` parseUrlString urlChar '?' parseInt' = escapeRight `fmap` parseIntString intChar parseChar' comments ignores = many1 (noneOf ([varChar, urlChar, intChar] ++ comments ++ ignores)) pack' :: String -> TS.Text pack' = TS.pack #if !MIN_VERSION_text(0, 11, 2) {-# 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)] 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 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 s <- preFilter rs str return $ mconcat $ map go $ contentFromString rs s where go :: Content -> Builder go (ContentRaw s) = fromText $ TS.pack s go (ContentVar d) = case lookup d cd of Just (EPlain s) -> s _ -> error $ show d ++ ": expected EPlain" go (ContentUrl d) = case lookup d cd of Just (EUrl u) -> fromText $ render' u [] _ -> error $ show d ++ ": expected EUrl" go (ContentUrlParam d) = case lookup d cd of Just (EUrlParam (u, p)) -> fromText $ render' u p _ -> error $ show d ++ ": expected EUrlParam" go (ContentMix d) = case lookup d cd of Just (EMixin m) -> m render' _ -> error $ show d ++ ": expected EMixin" shakespeare-1.0.2/Text/Shakespeare/0000755000000000000000000000000012044655007015355 5ustar0000000000000000shakespeare-1.0.2/Text/Shakespeare/Base.hs0000644000000000000000000002170612044655007016571 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-} -- | General parsers, functions and datatypes for all Shakespeare languages. module Text.Shakespeare.Base ( Deref (..) , Ident (..) , Scope , parseDeref , parseHash , parseVar , parseVarString , parseAt , parseUrl , parseUrlString , parseCaret , parseUnder , parseInt , parseIntString , derefToExp , flattenDeref , readUtf8File ) where import Language.Haskell.TH.Syntax import Language.Haskell.TH (appE) import Data.Char (isUpper, isSymbol) import Text.ParserCombinators.Parsec import Data.List (intercalate) import Data.Ratio (Ratio, numerator, denominator, (%)) import Data.Data (Data) import Data.Typeable (Typeable) import qualified Data.Text.Lazy as TL import qualified System.IO as SIO import qualified Data.Text.Lazy.IO as TIO import Control.Monad (when) newtype Ident = Ident String deriving (Show, Eq, Read, Data, Typeable, Ord) type Scope = [(Ident, Exp)] data Deref = DerefModulesIdent [String] Ident | DerefIdent Ident | DerefIntegral Integer | DerefRational Rational | DerefString String | DerefBranch Deref Deref | DerefList [Deref] | 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 :: Parser Deref derefParens = between (char '(') (char ')') parseDeref derefCurlyBrackets = between (char '{') (char '}') parseDeref derefList, derefTuple :: Parser Deref derefList = between (char '[') (char ']') (fmap DerefList $ sepBy parseDeref (char ',')) derefTuple = try $ do _ <- char '(' x <- sepBy1 parseDeref (char ',') when (length x < 2) $ pzero _ <- char ')' return $ DerefTuple x parseDeref :: Parser Deref parseDeref = skipMany (oneOf " \t") >> (derefList <|> derefTuple <|> (do x <- derefSingle (derefInfix x) <|> (do res <- deref' $ (:) x skipMany $ oneOf " \t" return res))) where delim = (many1 (char ' ') >> return()) <|> lookAhead (oneOf "(\"" >> return ()) derefOp = try $ do _ <- char '(' x <- many1 $ noneOf " \t\n\r()" _ <- char ')' return $ DerefIdent $ Ident x derefInfix x = try $ do _ <- delim xs <- many $ try $ derefSingle >>= \x' -> delim >> return x' op <- many1 (satisfy $ \c -> isSymbol c || c `elem` "-") "operator" -- special handling for $, which we don't deal with when (op == "$") $ fail "don't handle $" let op' = DerefIdent $ Ident op ys <- many1 $ delim >> derefSingle return $ DerefBranch (DerefBranch op' $ foldl1 DerefBranch $ x : xs) (foldl1 DerefBranch ys) derefSingle = derefTuple <|> derefOp <|> derefParens <|> numeric <|> strLit<|> ident deref' lhs = dollar <|> derefSingle' <|> return (foldl1 DerefBranch $ lhs []) where dollar = do _ <- try $ delim >> char '$' rhs <- parseDeref let lhs' = foldl1 DerefBranch $ lhs [] return $ DerefBranch lhs' rhs derefSingle' = do x <- try $ delim >> derefSingle deref' $ lhs . (:) x numeric = do n <- (char '-' >> return "-") <|> return "" x <- many1 digit y <- (char '.' >> fmap Just (many1 digit)) <|> return Nothing return $ case y of Nothing -> DerefIntegral $ read' "Integral" $ n ++ x Just z -> DerefRational $ toRational (read' "Rational" $ n ++ x ++ '.' : z :: Double) strLit = do _ <- char '"' chars <- many quotedChar _ <- char '"' return $ DerefString chars quotedChar = (char '\\' >> escapedChar) <|> noneOf "\"" escapedChar = let cecs = [('n', '\n'), ('r', '\r'), ('b', '\b'), ('t', '\t') ,('\\', '\\'), ('"', '"'), ('\'', '\'')] in choice [ char c >> return ec | (c, ec) <- cecs] ident = do mods <- many modul func <- many1 (alphaNum <|> char '_' <|> char '\'') let func' = Ident func return $ if null mods then DerefIdent func' else DerefModulesIdent mods func' modul = try $ do c <- upper cs <- many (alphaNum <|> char '_') _ <- char '.' return $ c : cs read' :: Read a => String -> String -> a read' t s = case reads s of (x, _):_ -> x [] -> error $ t ++ " read failed: " ++ s expType :: Ident -> Name -> Exp expType (Ident (c:_)) = if isUpper c || c == ':' then ConE else VarE expType (Ident "") = error "Bad Ident" derefToExp :: Scope -> Deref -> Exp derefToExp s (DerefBranch x y) = derefToExp s x `AppE` derefToExp s y derefToExp _ (DerefModulesIdent mods i@(Ident s)) = expType i $ Name (mkOccName s) (NameQ $ mkModName $ intercalate "." mods) derefToExp scope (DerefIdent i@(Ident s)) = case lookup i scope of Just e -> e Nothing -> expType i $ mkName s derefToExp _ (DerefIntegral i) = LitE $ IntegerL i derefToExp _ (DerefRational r) = LitE $ RationalL r derefToExp _ (DerefString s) = LitE $ StringL s derefToExp s (DerefList ds) = ListE $ map (derefToExp s) ds derefToExp s (DerefTuple ds) = TupE $ map (derefToExp s) ds -- FIXME shouldn't we use something besides a list here? flattenDeref :: Deref -> Maybe [String] flattenDeref (DerefIdent (Ident x)) = Just [x] flattenDeref (DerefBranch (DerefIdent (Ident x)) y) = do y' <- flattenDeref y Just $ y' ++ [x] flattenDeref _ = Nothing 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 (char '\\' >> return (Left [c])) <|> (do deref <- derefCurlyBrackets return $ Right deref) <|> (do -- Check for hash just before newline _ <- lookAhead (oneOf "\r\n" >> return ()) <|> eof return $ Left "" ) <|> return (Left [c]) parseAt :: Parser (Either String (Deref, Bool)) parseAt = parseUrl '@' '?' parseUrl :: Char -> Char -> Parser (Either String (Deref, Bool)) parseUrl c d = do _ <- char c (char '\\' >> return (Left [c])) <|> (do x <- (char d >> return True) <|> return False (do 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 '^' parseInt :: Char -> Parser (Either String Deref) parseInt c = do _ <- char c (char '\\' >> return (Left [c])) <|> (do deref <- derefCurlyBrackets return $ Right deref) <|> return (Left [c]) parseUnder :: Parser (Either String Deref) parseUnder = do _ <- char '_' (char '\\' >> return (Left "_")) <|> (do deref <- derefCurlyBrackets return $ Right deref) <|> return (Left "_") readUtf8File :: FilePath -> IO TL.Text readUtf8File fp = do h <- SIO.openFile fp SIO.ReadMode SIO.hSetEncoding h SIO.utf8_bom TIO.hGetContents h shakespeare-1.0.2/test/0000755000000000000000000000000012044655007013155 5ustar0000000000000000shakespeare-1.0.2/test/ShakespeareBaseTest.hs0000644000000000000000000000372712044655007017410 0ustar0000000000000000module ShakespeareBaseTest (specs) where import Test.Hspec import Text.ParserCombinators.Parsec (parse, ParseError, (<|>)) import Text.Shakespeare.Base (parseVarString, parseUrlString, parseIntString) import Text.Shakespeare (preFilter, defaultShakespeareSettings, ShakespeareSettings(..), PreConvert(..), PreConversion(..)) -- run :: Text.Parsec.Prim.Parsec Text.Parsec.Pos.SourceName () c -> Text.Parsec.Pos.SourceName -> c specs :: Spec specs = describe "shakespeare-js" $ do it "parseStrings" $ do run varString "%{var}" `shouldBe` Right "%{var}" run urlString "@{url}" `shouldBe` Right "@{url}" run intString "^{int}" `shouldBe` Right "^{int}" run (varString <|> urlString <|> intString) "@{url} #{var}" `shouldBe` Right "@{url}" it "preFilter off" $ do preFilter defaultShakespeareSettings template `shouldReturn` template it "preFilter on" $ do preFilter preConversionSettings template `shouldReturn` "unchanged `#{var}` `@{url}` `^{int}`" it "preFilter ignore quotes" $ do preFilter preConversionSettings templateQuote `shouldReturn` "unchanged '#{var}' `@{url}` '^{int}'" it "preFilter ignore comments" $ do preFilter preConversionSettings templateCommented `shouldReturn` "unchanged & '#{var}' @{url} '^{int}'" where varString = parseVarString '%' urlString = parseUrlString '@' '?' intString = parseIntString '^' preConversionSettings = defaultShakespeareSettings { preConversion = Just PreConvert { preConvert = Id , preEscapeBegin = "`" , preEscapeEnd = "`" , preEscapeIgnoreBalanced = "'\"" , preEscapeIgnoreLine = "&" } } template = "unchanged #{var} @{url} ^{int}" templateQuote = "unchanged '#{var}' @{url} '^{int}'" templateCommented = "unchanged & '#{var}' @{url} '^{int}'" run parser str = eShowErrors $ parse parser str str eShowErrors :: Either ParseError c -> c eShowErrors = either (error . show) id