shakespeare 1.0.2 → 1.0.3
raw patch · 4 files changed
+133/−47 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- Text/Shakespeare.hs +96/−24
- Text/Shakespeare/Base.hs +20/−16
- shakespeare.cabal +1/−1
- test/ShakespeareBaseTest.hs +16/−6
Text/Shakespeare.hs view
@@ -9,6 +9,7 @@ module Text.Shakespeare ( ShakespeareSettings (..) , PreConvert (..)+ , WrapInsertion (..) , PreConversion (..) , defaultShakespeareSettings , shakespeare@@ -20,13 +21,17 @@ , RenderUrl , VarType , Deref+ , Parser #ifdef TEST_EXPORT , preFilter #endif ) where -import Text.ParserCombinators.Parsec hiding (Line)+import Data.List (intersperse)+import Data.Char (isAlphaNum, isSpace)+import Text.ParserCombinators.Parsec hiding (Line, parse, Parser)+import Text.Parsec.Prim (modifyState, Parsec) import Language.Haskell.TH.Quote (QuasiQuoter (..)) import Language.Haskell.TH (appE) import Language.Haskell.TH.Syntax@@ -43,6 +48,12 @@ -- for pre conversion import System.Process (readProcess) +-- | A parser with a user state of [String]+type Parser = Parsec String [String]+-- | run a parser with a user state of [String]+parse :: GenParser tok [a1] a -> SourceName -> [tok] -> Either ParseError a+parse p = runParser p []+ -- move to Shakespeare.Base? readFileQ :: FilePath -> Q String readFileQ fp = qRunIO $ readFileUtf8 fp@@ -51,7 +62,7 @@ readFileUtf8 :: FilePath -> IO String readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp --- | The Coffeescript language compiles down to Javascript.+-- | Coffeescript, TypeScript, and other languages 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:@@ -61,21 +72,37 @@ -- 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.+--+-- The problem then is the insertion of Haskell values: we need a hole for+-- them. This can be done with variables known to the language. -- 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.+-- So #{a} is change to shakespeare_var_a+-- Then we can place the Haskell values in a function wrapper that exposes+-- those variables: (function(shakespeare_var_a){ ... shakespeare_var_a ...})+-- TypeScript can compile that, and then we tack an application of the+-- Haskell values onto the result: (#{a})+-- -- 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]+ , wrapInsertion :: Maybe WrapInsertion } +data WrapInsertion = WrapInsertion {+ wrapInsertionIndent :: Maybe String+ , wrapInsertionStartBegin :: String+ , wrapInsertionSeparator :: String+ , wrapInsertionStartClose :: String+ , wrapInsertionEnd :: String+ , wrapInsertionApplyBegin :: String+ , wrapInsertionApplyClose :: String+ }+ data PreConversion = ReadProcess String [String] | Id @@ -107,9 +134,13 @@ } instance Lift PreConvert where- lift (PreConvert convert begin end ignore comment) =- [|PreConvert $(lift convert) $(lift begin) $(lift end) $(lift ignore) $(lift comment)|]+ 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)|]@@ -179,20 +210,60 @@ preFilter :: ShakespeareSettings -> String -> IO String-preFilter ShakespeareSettings {..} s = +preFilter ShakespeareSettings {..} template = 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+ Nothing -> return template+ Just pre@(PreConvert convert _ _ mwi) ->+ if all isSpace template then return template else+ let (groups, rvars) = eShowErrors $ parse+ (parseConvertWrapInsertion mwi pre)+ template+ (indentedTemplate mwi)+ vars = reverse rvars+ parsed = mconcat groups+ in applyVars mwi vars `fmap` (case convert of+ Id -> return + ReadProcess command args -> readProcess command args+ ) (addVars mwi vars parsed) where- parseConvert PreConvert {..} = many1 $ choice $- map (try . escapedParse) preEscapeIgnoreBalanced ++- [mainParser]+ indentedTemplate Nothing = template+ indentedTemplate (Just wi) = addIndent $ wrapInsertionIndent wi+ where+ addIndent Nothing = template+ addIndent (Just indent) = mapLines (\line -> indent <> line) template+ mapLines f = unlines . map f . lines + shakespeare_prefix = "shakespeare_var_"+ shakespeare_var_conversion ('@':'?':'{':str) = shakespeare_var_conversion ('@':'{':str)+ shakespeare_var_conversion (_:'{':str) = shakespeare_prefix <> filter isAlphaNum (init str)+ shakespeare_var_conversion err = error $ "did not expect: " <> err++ applyVars Nothing _ str = str+ applyVars _ [] str = str+ applyVars (Just WrapInsertion {..}) vars str =+ reverse (dropWhile (\c -> c == ';' || isSpace c) (reverse str))+ <> wrapInsertionApplyBegin+ <> (mconcat $ intersperse wrapInsertionSeparator vars)+ <> wrapInsertionApplyClose++ addVars Nothing _ str = str+ addVars _ [] str = str+ addVars (Just WrapInsertion {..}) vars str =+ wrapInsertionStartBegin+ <> (mconcat $ intersperse wrapInsertionSeparator $ map shakespeare_var_conversion vars)+ <> wrapInsertionStartClose+ <> str+ <> wrapInsertionEnd++ parseConvertWrapInsertion Nothing = parseConvert id+ parseConvertWrapInsertion (Just _) = parseConvert shakespeare_var_conversion++ parseConvert varConvert PreConvert {..} = do+ str <- many1 $ choice $+ map (try . escapedParse) preEscapeIgnoreBalanced ++ [mainParser]+ st <- getState+ return (str, st)+ where escapedParse ignoreC = do _<- char ignoreC@@ -207,8 +278,8 @@ parseCommentLine preEscapeIgnoreLine <|> parseChar' preEscapeIgnoreLine preEscapeIgnoreBalanced - escape str = preEscapeBegin ++ str ++ preEscapeEnd- escapeRight = either id escape+ recordRight (Left str) = return str+ recordRight (Right str) = modifyState (\vars -> str:vars) >> (return $ varConvert str) newLine = "\r\n" parseCommentLine cs = do@@ -216,9 +287,10 @@ comment <- many $ noneOf newLine return $ begin : comment - parseVar' = escapeRight `fmap` parseVarString varChar- parseUrl' = escapeRight `fmap` parseUrlString urlChar '?'- parseInt' = escapeRight `fmap` parseIntString intChar+ parseVar' :: (Parsec String [String]) String+ parseVar' = recordRight =<< parseVarString varChar+ parseUrl' = recordRight =<< parseUrlString urlChar '?'+ parseInt' = recordRight =<< parseIntString intChar parseChar' comments ignores = many1 (noneOf ([varChar, urlChar, intChar] ++ comments ++ ignores))
Text/Shakespeare/Base.hs view
@@ -27,6 +27,7 @@ import Language.Haskell.TH (appE) import Data.Char (isUpper, isSymbol) import Text.ParserCombinators.Parsec+import Text.Parsec.Prim (Parsec) import Data.List (intercalate) import Data.Ratio (Ratio, numerator, denominator, (%)) import Data.Data (Data)@@ -79,11 +80,11 @@ lift (DerefList x) = [|DerefList $(lift x)|] lift (DerefTuple x) = [|DerefTuple $(lift x)|] -derefParens, derefCurlyBrackets :: Parser Deref+derefParens, derefCurlyBrackets :: UserParser a Deref derefParens = between (char '(') (char ')') parseDeref derefCurlyBrackets = between (char '{') (char '}') parseDeref -derefList, derefTuple :: Parser Deref+derefList, derefTuple :: UserParser a Deref derefList = between (char '[') (char ']') (fmap DerefList $ sepBy parseDeref (char ',')) derefTuple = try $ do _ <- char '('@@ -92,7 +93,7 @@ _ <- char ')' return $ DerefTuple x -parseDeref :: Parser Deref+parseDeref :: UserParser a Deref parseDeref = skipMany (oneOf " \t") >> (derefList <|> derefTuple <|> (do x <- derefSingle@@ -194,17 +195,20 @@ Just $ y' ++ [x] flattenDeref _ = Nothing -parseHash :: Parser (Either String Deref)+parseHash :: UserParser a (Either String Deref) parseHash = parseVar '#' -curlyBrackets :: Parser String+curlyBrackets :: UserParser a String curlyBrackets = do _<- char '{' var <- many1 $ noneOf "}" _<- char '}' return $ ('{':var) ++ "}" -parseVar :: Char -> Parser (Either String Deref)++type UserParser a = Parsec String a++parseVar :: Char -> UserParser a (Either String Deref) parseVar c = do _ <- char c (char '\\' >> return (Left [c])) <|> (do@@ -215,10 +219,10 @@ return $ Left "" ) <|> return (Left [c]) -parseAt :: Parser (Either String (Deref, Bool))+parseAt :: UserParser a (Either String (Deref, Bool)) parseAt = parseUrl '@' '?' -parseUrl :: Char -> Char -> Parser (Either String (Deref, Bool))+parseUrl :: Char -> Char -> UserParser a (Either String (Deref, Bool)) parseUrl c d = do _ <- char c (char '\\' >> return (Left [c])) <|> (do@@ -228,17 +232,17 @@ return $ Right (deref, x)) <|> return (Left $ if x then [c, d] else [c])) -parseInterpolatedString :: Char -> Parser (Either String String)+parseInterpolatedString :: Char -> UserParser a (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 :: Char -> UserParser a (Either String String) parseVarString = parseInterpolatedString -parseUrlString :: Char -> Char -> Parser (Either String String)+parseUrlString :: Char -> Char -> UserParser a (Either String String) parseUrlString c d = do _ <- char c (char '\\' >> return (Left [c, '\\'])) <|> (do@@ -247,20 +251,20 @@ return $ Right (c:ds ++ bracketed)) <|> return (Left (c:ds))) -parseIntString :: Char -> Parser (Either String String)+parseIntString :: Char -> UserParser a (Either String String) parseIntString = parseInterpolatedString -parseCaret :: Parser (Either String Deref)+parseCaret :: UserParser a (Either String Deref) parseCaret = parseInt '^' -parseInt :: Char -> Parser (Either String Deref)+parseInt :: Char -> UserParser a (Either String Deref) parseInt c = do _ <- char c- (char '\\' >> return (Left [c])) <|> (do+ (try $ char '\\' >> char '{' >> return (Left [c, '{'])) <|> (do deref <- derefCurlyBrackets return $ Right deref) <|> return (Left [c]) -parseUnder :: Parser (Either String Deref)+parseUnder :: UserParser a (Either String Deref) parseUnder = do _ <- char '_' (char '\\' >> return (Left "_")) <|> (do
shakespeare.cabal view
@@ -1,5 +1,5 @@ name: shakespeare-version: 1.0.2+version: 1.0.3 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>
test/ShakespeareBaseTest.hs view
@@ -1,6 +1,7 @@ module ShakespeareBaseTest (specs) where import Test.Hspec+import Text.Shakespeare import Text.ParserCombinators.Parsec (parse, ParseError, (<|>)) import Text.Shakespeare.Base (parseVarString, parseUrlString, parseIntString)@@ -10,24 +11,26 @@ 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}`"+ preFilter preConversionSettings template `shouldReturn`+ "(function(shakespeare_var_var, shakespeare_var_url, shakespeare_var_int){unchanged shakespeare_var_var shakespeare_var_url shakespeare_var_int})(#{var}, @{url}, ^{int})" it "preFilter ignore quotes" $ do- preFilter preConversionSettings templateQuote- `shouldReturn` "unchanged '#{var}' `@{url}` '^{int}'"+ preFilter preConversionSettings templateQuote `shouldReturn`+ "(function(shakespeare_var_url){unchanged '#{var}' shakespeare_var_url '^{int}'})(@{url})" it "preFilter ignore comments" $ do preFilter preConversionSettings templateCommented@@ -41,10 +44,17 @@ preConversionSettings = defaultShakespeareSettings { preConversion = Just PreConvert { preConvert = Id- , preEscapeBegin = "`"- , preEscapeEnd = "`" , preEscapeIgnoreBalanced = "'\"" , preEscapeIgnoreLine = "&"+ , wrapInsertion = Just WrapInsertion { + wrapInsertionIndent = Nothing+ , wrapInsertionStartBegin = "(function("+ , wrapInsertionSeparator = ", "+ , wrapInsertionStartClose = "){"+ , wrapInsertionEnd = "})"+ , wrapInsertionApplyBegin = "("+ , wrapInsertionApplyClose = ")"+ } } } template = "unchanged #{var} @{url} ^{int}"