diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs --- a/Text/Shakespeare.hs +++ b/Text/Shakespeare.hs @@ -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)) diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs --- a/Text/Shakespeare/Base.hs +++ b/Text/Shakespeare/Base.hs @@ -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 diff --git a/shakespeare.cabal b/shakespeare.cabal --- a/shakespeare.cabal +++ b/shakespeare.cabal @@ -1,5 +1,5 @@ name: shakespeare -version: 1.0.2 +version: 1.0.3 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/test/ShakespeareBaseTest.hs b/test/ShakespeareBaseTest.hs --- a/test/ShakespeareBaseTest.hs +++ b/test/ShakespeareBaseTest.hs @@ -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}"