diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +## Stache 2.0.0 + +* Uses Megaparsec 7. In particular, the parser now returns + `ParseErrorBundle` on failure and the bundle is also inside + `MustacheException`. + ## Stache 1.2.1 * Fixed a bug in `compileMustacheDir'` from `Text.Mustache.Compile.TH`: it diff --git a/LICENSE.md b/LICENSE.md --- a/LICENSE.md +++ b/LICENSE.md @@ -1,4 +1,4 @@ -Copyright © 2016–2017 Stack Builders +Copyright © 2016–2018 Stack Builders All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,7 +5,6 @@ [![Stackage Nightly](http://stackage.org/package/stache/badge/nightly)](http://stackage.org/nightly/package/stache) [![Stackage LTS](http://stackage.org/package/stache/badge/lts)](http://stackage.org/lts/package/stache) [![Build Status](https://travis-ci.org/stackbuilders/stache.svg?branch=master)](https://travis-ci.org/stackbuilders/stache) -[![Coverage Status](https://coveralls.io/repos/github/stackbuilders/stache/badge.svg?branch=master)](https://coveralls.io/github/stackbuilders/stache?branch=master) This is a Haskell implementation of Mustache templates. The implementation conforms to the version 1.1.3 of the @@ -51,7 +50,7 @@ let res = compileMustacheText "foo" "Hi, {{name}}! You have:\n{{#things}}\n * {{.}}\n{{/things}}\n" case res of - Left err -> putStrLn (parseErrorPretty err) + Left bundle -> putStrLn (errorBundlePretty bundle) Right template -> TIO.putStr $ renderMustache template $ object [ "name" .= ("John" :: Text) , "things" .= ["pen" :: Text, "candle", "egg"] @@ -84,6 +83,6 @@ ## License -Copyright © 2016–2017 Stack Builders +Copyright © 2016–2018 Stack Builders Distributed under BSD 3 clause license. diff --git a/Text/Mustache.hs b/Text/Mustache.hs --- a/Text/Mustache.hs +++ b/Text/Mustache.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Mustache --- Copyright : © 2016–2017 Stack Builders +-- Copyright : © 2016–2018 Stack Builders -- License : BSD 3 clause -- -- Maintainer : Mark Karpov diff --git a/Text/Mustache/Compile.hs b/Text/Mustache/Compile.hs --- a/Text/Mustache/Compile.hs +++ b/Text/Mustache/Compile.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Mustache.Compile --- Copyright : © 2016–2017 Stack Builders +-- Copyright : © 2016–2018 Stack Builders -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -112,7 +112,7 @@ -> m Template compileMustacheFile path = liftIO $ do input <- T.readFile path - withException input (compile input) + withException (compile input) where pname = pathToPName path compile = fmap (Template pname . M.singleton pname) . parseMustache path @@ -123,7 +123,7 @@ compileMustacheText :: PName -- ^ How to name the template? -> Text -- ^ The template to compile - -> Either (ParseError Char Void) Template -- ^ The result + -> Either (ParseErrorBundle Text Void) Template -- ^ The result compileMustacheText pname txt = Template pname . M.singleton pname <$> parseMustache "" txt @@ -139,7 +139,6 @@ -- inside 'Right'. withException - :: Text -- ^ Original input - -> Either (ParseError Char Void) Template -- ^ Value to process + :: Either (ParseErrorBundle Text Void) Template -- ^ Value to process -> IO Template -- ^ The result -withException input = either (throwIO . MustacheParserException input) return +withException = either (throwIO . MustacheParserException) return diff --git a/Text/Mustache/Compile/TH.hs b/Text/Mustache/Compile/TH.hs --- a/Text/Mustache/Compile/TH.hs +++ b/Text/Mustache/Compile/TH.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Mustache.Compile.TH --- Copyright : © 2016–2017 Stack Builders +-- Copyright : © 2016–2018 Stack Builders -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -97,7 +97,7 @@ -> Text -- ^ The template to compile -> Q Exp compileMustacheText pname text = - (handleEither . either (Left . MustacheParserException text) Right) + (handleEither . either (Left . MustacheParserException) Right) (C.compileMustacheText pname text) -- | Compile Mustache using QuasiQuoter. Usage: @@ -117,9 +117,9 @@ mustache :: QuasiQuoter mustache = QuasiQuoter { quoteExp = compileMustacheText "quasi-quoted" . T.pack - , quotePat = undefined - , quoteType = undefined - , quoteDec = undefined } + , quotePat = error "This usage is not supported." + , quoteType = error "This usage is not supported." + , quoteDec = error "This usage is not supported." } -- | Given an 'Either' result return 'Right' and signal pretty-printed error -- if we have a 'Left'. @@ -127,12 +127,7 @@ handleEither :: Either MustacheException Template -> Q Exp handleEither val = case val of - Left err -> fail . indentNicely $ -#if MIN_VERSION_base(4,8,0) - displayException err -#else - show err -#endif + Left err -> (fail . indentNicely . displayException) err Right template -> dataToExpQ (fmap liftText . cast) template where -- NOTE Since the feature requires GHC 8 anyway, we follow the diff --git a/Text/Mustache/Parser.hs b/Text/Mustache/Parser.hs --- a/Text/Mustache/Parser.hs +++ b/Text/Mustache/Parser.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Mustache.Parser --- Copyright : © 2016–2017 Stack Builders +-- Copyright : © 2016–2018 Stack Builders -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -17,7 +17,6 @@ ( parseMustache ) where -import Control.Applicative import Control.Monad import Control.Monad.State.Strict import Data.Char (isSpace, isAlphaNum) @@ -41,10 +40,10 @@ -- ^ Location of the file to parse -> Text -- ^ File contents (Mustache template) - -> Either (ParseError Char Void) [Node] + -> Either (ParseErrorBundle Text Void) [Node] -- ^ Parsed nodes or parse error parseMustache = parse $ - evalStateT (pMustache eof) (Delimiters "{{" "}}") + evalStateT (pMustache eof) (St "{{" "}}" 0) pMustache :: Parser () -> Parser [Node] pMustache = fmap catMaybes . manyTill (choice alts) @@ -65,12 +64,14 @@ pTextBlock :: Parser Node pTextBlock = do start <- gets openingDel - (void . notFollowedBy . string) start - let terminator = choice - [ (void . lookAhead . string) start - , pBol - , eof ] - TextBlock . T.pack <$> someTill anyChar terminator + txt <- fmap T.concat . many $ do + (void . notFollowedBy . string) start + let textChar x = x /= T.head start && x /= '\n' + string (T.take 1 start) <|> takeWhile1P (Just "text char") textChar + meol <- optional eol' + return $ case meol of + Nothing -> TextBlock txt + Just txt' -> TextBlock (txt <> txt') {-# INLINE pTextBlock #-} pUnescapedVariable :: Parser Node @@ -105,7 +106,7 @@ start <- gets openingDel end <- gets closingDel (void . symbol) (start <> "!") - manyTill anyChar (string end) + manyTill (anySingle "character") (string end) {-# INLINE pComment #-} pSetDelimiters :: Parser () @@ -116,7 +117,9 @@ start' <- pDelimiter <* scn end' <- pDelimiter <* scn (void . string) ("=" <> end) - put (Delimiters start' end') + modify' $ \st -> st { openingDel = start' + , closingDel = end' + } {-# INLINE pSetDelimiters #-} pEscapedVariable :: Parser Node @@ -128,7 +131,7 @@ {-# INLINE withStandalone #-} pStandalone :: Parser a -> Parser a -pStandalone p = pBol *> try (between sc (sc <* (void eol <|> eof)) p) +pStandalone p = pBol *> try (between sc (sc <* (void eol' <|> eof)) p) {-# INLINE pStandalone #-} pTag :: Text -> Parser Key @@ -162,8 +165,9 @@ pBol :: Parser () pBol = do - level <- L.indentLevel - unless (level == pos1) empty + o <- getOffset + o' <- gets newlineOffset + unless (o == o') empty {-# INLINE pBol #-} ---------------------------------------------------------------------------- @@ -171,14 +175,18 @@ -- | Type of Mustache parser monad stack. -type Parser = StateT Delimiters (Parsec Void Text) +type Parser = StateT St (Parsec Void Text) --- | State used in Mustache parser. It includes currently set opening and --- closing delimiters. +-- | State used in the parser. -data Delimiters = Delimiters +data St = St { openingDel :: Text - , closingDel :: Text } + -- ^ Opening delimiter + , closingDel :: Text + -- ^ Closing delimiter + , newlineOffset :: !Int + -- ^ The offset at which last newline character was parsed + } ---------------------------------------------------------------------------- -- Lexer helpers and other @@ -205,3 +213,11 @@ keyToText (Key []) = "." keyToText (Key ks) = T.intercalate "." ks {-# INLINE keyToText #-} + +eol' :: Parser Text +eol' = do + x <- eol + o <- getOffset + modify' (\st -> st { newlineOffset = o } ) + return x +{-# INLINE eol' #-} diff --git a/Text/Mustache/Render.hs b/Text/Mustache/Render.hs --- a/Text/Mustache/Render.hs +++ b/Text/Mustache/Render.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Mustache.Render --- Copyright : © 2016–2017 Stack Builders +-- Copyright : © 2016–2018 Stack Builders -- License : BSD 3 clause -- -- Maintainer : Mark Karpov diff --git a/Text/Mustache/Type.hs b/Text/Mustache/Type.hs --- a/Text/Mustache/Type.hs +++ b/Text/Mustache/Type.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Mustache.Type --- Copyright : © 2016–2017 Stack Buliders +-- Copyright : © 2016–2018 Stack Buliders -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -32,7 +32,6 @@ import Control.Exception (Exception(..)) import Data.Data (Data) import Data.Map (Map) -import Data.Semigroup import Data.String (IsString (..)) import Data.Text (Text) import Data.Typeable (Typeable) @@ -42,6 +41,10 @@ import qualified Data.Map as M import qualified Data.Text as T +#if !MIN_VERSION_base(4,11,0) +import Data.Semigroup +#endif + -- | Mustache template as name of “top-level” template and a collection of -- all available templates (partials). -- @@ -110,8 +113,8 @@ -- | Exception that is thrown when parsing of a template fails or referenced -- values are not provided. -data MustacheException - = MustacheParserException Text (ParseError Char Void) +newtype MustacheException + = MustacheParserException (ParseErrorBundle Text Void) -- ^ Template parser has failed. This contains the parse error. -- -- /Before version 0.2.0 it was called 'MustacheException'./ @@ -119,12 +122,8 @@ -- /The 'Text' field was added in version 1.0.0./ deriving (Eq, Show, Typeable, Generic) -#if MIN_VERSION_base(4,8,0) instance Exception MustacheException where - displayException (MustacheParserException s e) = parseErrorPretty' s e -#else -instance Exception MustacheException -#endif + displayException (MustacheParserException b) = errorBundlePretty b -- | Warning that may be generated during rendering of a 'Template'. -- diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -81,7 +81,7 @@ bparser :: String -> FilePath -> Benchmark bparser desc path = env (T.readFile path) - (bench desc . nf (either (error . parseErrorPretty) id . parseMustache path)) + (bench desc . nf (either (error . errorBundlePretty) id . parseMustache path)) brender :: String -> FilePath -> Value -> Benchmark brender desc path value = env (compileMustacheFile path) diff --git a/mustache-spec/Spec.hs b/mustache-spec/Spec.hs --- a/mustache-spec/Spec.hs +++ b/mustache-spec/Spec.hs @@ -67,7 +67,7 @@ specData :: String -> ByteString -> Spec specData aspect bytes = describe aspect $ do - let handleError = expectationFailure . parseErrorPretty + let handleError = expectationFailure . errorBundlePretty case decodeEither' bytes of Left err -> it "should load YAML specs first" $ diff --git a/stache.cabal b/stache.cabal --- a/stache.cabal +++ b/stache.cabal @@ -1,7 +1,7 @@ name: stache -version: 1.2.1 -cabal-version: >= 1.18 -tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 +version: 2.0.0 +cabal-version: 1.18 +tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3 license: BSD3 license-file: LICENSE.md author: Mark Karpov @@ -28,16 +28,16 @@ default: False library - build-depends: aeson >= 0.11 && < 1.3 + build-depends: aeson >= 0.11 && < 1.5 , base >= 4.8 && < 5.0 , bytestring >= 0.10 && < 0.11 , containers >= 0.5 && < 0.6 , deepseq >= 1.4 && < 1.5 , directory >= 1.2 && < 1.4 , filepath >= 1.2 && < 1.5 - , megaparsec >= 6.0 && < 7.0 + , megaparsec >= 7.0 && < 8.0 , mtl >= 2.1 && < 3.0 - , template-haskell >= 2.10 && < 2.13 + , template-haskell >= 2.10 && < 2.14 , text >= 1.2 && < 1.3 , unordered-containers >= 0.2.5 && < 0.3 , vector >= 0.11 && < 0.13 @@ -55,25 +55,32 @@ ghc-options: -O0 -Wall -Werror -fsimpl-tick-factor=150 else ghc-options: -O2 -Wall -fsimpl-tick-factor=150 + if flag(dev) && impl(ghc >= 8.0) + ghc-options: -Wcompat + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wnoncanonical-monad-instances + -Wnoncanonical-monadfail-instances default-language: Haskell2010 test-suite tests main-is: Spec.hs hs-source-dirs: tests type: exitcode-stdio-1.0 - build-depends: aeson >= 0.11 && < 1.3 + build-depends: aeson >= 0.11 && < 1.5 , base >= 4.8 && < 5.0 , containers >= 0.5 && < 0.6 , hspec >= 2.0 && < 3.0 - , hspec-megaparsec >= 1.0 && < 2.0 - , megaparsec >= 6.0 && < 7.0 + , hspec-megaparsec >= 2.0 && < 3.0 + , megaparsec >= 7.0 && < 8.0 , stache - , template-haskell >= 2.10 && < 2.13 + , template-haskell >= 2.10 && < 2.14 , text >= 1.2 && < 1.3 other-modules: Text.Mustache.Compile.THSpec , Text.Mustache.ParserSpec , Text.Mustache.RenderSpec , Text.Mustache.TypeSpec + build-tools: hspec-discover >= 2.0 && < 3.0 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.* if flag(dev) @@ -86,16 +93,16 @@ main-is: Spec.hs hs-source-dirs: mustache-spec type: exitcode-stdio-1.0 - build-depends: aeson >= 0.11 && < 1.3 + build-depends: aeson >= 0.11 && < 1.5 , base >= 4.8 && < 5.0 , bytestring >= 0.10 && < 0.11 , containers >= 0.5 && < 0.6 , file-embed , hspec >= 2.0 && < 3.0 - , megaparsec >= 6.0 && < 7.0 + , megaparsec >= 7.0 && < 8.0 , stache , text >= 1.2 && < 1.3 - , yaml >= 0.8 && < 0.9 + , yaml >= 0.8 && < 0.11 if flag(dev) ghc-options: -Wall -Werror else @@ -106,11 +113,11 @@ main-is: Main.hs hs-source-dirs: bench type: exitcode-stdio-1.0 - build-depends: aeson >= 0.11 && < 1.3 + build-depends: aeson >= 0.11 && < 1.5 , base >= 4.8 && < 5.0 - , criterion >= 0.6.2.1 && < 1.3 + , criterion >= 0.6.2.1 && < 1.6 , deepseq >= 1.4 && < 1.5 - , megaparsec >= 6.0 && < 7.0 + , megaparsec >= 7.0 && < 8.0 , stache , text >= 1.2 && < 1.3 if flag(dev) diff --git a/tests/Text/Mustache/ParserSpec.hs b/tests/Text/Mustache/ParserSpec.hs --- a/tests/Text/Mustache/ParserSpec.hs +++ b/tests/Text/Mustache/ParserSpec.hs @@ -86,7 +86,7 @@ context "when given malformed input" $ do it "rejects unclosed tags" $ do let s = "{{ name " - p s `shouldFailWith` err (posN 8 s) (ueof <> etoks "}}") + p s `shouldFailWith` err 8 (ueof <> etoks "}}") it "rejects unknown tags" $ do let s = "{{? boo }}" - p s `shouldFailWith` err (posN 2 s) (utoks "?" <> elabel "key") + p s `shouldFailWith` err 2 (utoks "?" <> elabel "key")