Port the parser to Megaparsec 6

CHANGELOG.md

@@ -1,4 +1,4 @@
-## Stache 0.3.0
+## Stache 1.0.0
 
 * Improved metadata and documentation.
 
@@ -7,6 +7,13 @@
   we had before 0.2.0, and it played better with the rest of Mustache.
   Correspondingly, `MustacheRenderException` was removed.
 
+* Stache now uses Megaparsec 6 for parsing.
+
+* `MustacheException` now includes original input as `Text`.
+
+* `compileMustacheText` and `parseMustache` now accept strict `Text` instead
+  of lazy `Text`.
+
 ## Stache 0.2.2
 
 * Add the `getMustacheFilesInDir` function.

Text/Mustache/Compile.hs

@@ -22,15 +22,16 @@ where
 
 import Control.Monad.Catch (MonadThrow (..))
 import Control.Monad.Except
-import Data.Text.Lazy (Text)
+import Data.Text (Text)
+import Data.Void
 import System.Directory
 import Text.Megaparsec
 import Text.Mustache.Parser
 import Text.Mustache.Type
-import qualified Data.Map          as M
-import qualified Data.Text         as T
-import qualified Data.Text.Lazy.IO as TL
-import qualified System.FilePath   as F
+import qualified Data.Map        as M
+import qualified Data.Text       as T
+import qualified Data.Text.IO    as T
+import qualified System.FilePath as F
 
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative
@@ -76,8 +77,9 @@ getMustacheFilesInDir path =
 compileMustacheFile :: (MonadIO m, MonadThrow m)
   => FilePath          -- ^ Location of the file
   -> m Template
-compileMustacheFile path =
-  liftIO (TL.readFile path) >>= withException . compile
+compileMustacheFile path = do
+  input <- liftIO (T.readFile path)
+  withException input (compile input)
   where
     pname = pathToPName path
     compile = fmap (Template pname . M.singleton pname) . parseMustache path
@@ -88,7 +90,7 @@ compileMustacheFile path =
 compileMustacheText
   :: PName             -- ^ How to name the template?
   -> Text              -- ^ The template to compile
-  -> Either (ParseError Char Dec) Template -- ^ The result
+  -> Either (ParseError Char Void) Template -- ^ The result
 compileMustacheText pname txt =
   Template pname . M.singleton pname <$> parseMustache "" txt
 
@@ -112,6 +114,7 @@ pathToPName = PName . T.pack . F.takeBaseName
 -- inside 'Right'.
 
 withException :: MonadThrow m
-  => Either (ParseError Char Dec) Template -- ^ Value to process
+  => Text              -- ^ Original input
+  -> Either (ParseError Char Void) Template -- ^ Value to process
   -> m Template        -- ^ The result
-withException = either (throwM . MustacheParserException) return
+withException input = either (throwM . MustacheParserException input) return

Text/Mustache/Compile/TH.hs

@@ -28,15 +28,14 @@ where
 
 import Control.Exception (Exception(..))
 import Control.Monad.Catch (try)
-import Data.Text.Lazy (Text)
+import Data.Text (Text)
 import Data.Typeable (cast)
 import Language.Haskell.TH hiding (Dec)
 import Language.Haskell.TH.Quote (QuasiQuoter (..))
 import Language.Haskell.TH.Syntax (lift, addDependentFile)
 import System.Directory
 import Text.Mustache.Type
 import qualified Data.Text             as T
-import qualified Data.Text.Lazy        as TL
 import qualified Text.Mustache.Compile as C
 
 #if !MIN_VERSION_base(4,8,0)
@@ -86,7 +85,7 @@ compileMustacheText
   -> Text              -- ^ The template to compile
   -> Q Exp
 compileMustacheText pname text =
-  (handleEither . either (Left . MustacheParserException) Right)
+  (handleEither . either (Left . MustacheParserException text) Right)
   (C.compileMustacheText pname text)
 
 -- | Compile Mustache using QuasiQuoter. Usage:
@@ -105,7 +104,7 @@ compileMustacheText pname text =
 
 mustache :: QuasiQuoter
 mustache = QuasiQuoter
-  { quoteExp  = compileMustacheText "quasi-quoted" . TL.pack
+  { quoteExp  = compileMustacheText "quasi-quoted" . T.pack
   , quotePat  = undefined
   , quoteType = undefined
   , quoteDec  = undefined }

Text/Mustache/Parser.hs

@@ -11,21 +11,25 @@
 -- import the module, because "Text.Mustache" re-exports everything you may
 -- need, import that module instead.
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Text.Mustache.Parser
   ( parseMustache )
 where
 
 import Control.Applicative
 import Control.Monad
 import Control.Monad.State.Strict
-import Data.Char (isSpace)
-import Data.List (intercalate)
+import Data.Char (isSpace, isAlphaNum)
 import Data.Maybe (catMaybes)
-import Data.Text.Lazy (Text)
+import Data.Semigroup ((<>))
+import Data.Text (Text)
+import Data.Void
 import Text.Megaparsec
+import Text.Megaparsec.Char
 import Text.Mustache.Type
-import qualified Data.Text             as T
-import qualified Text.Megaparsec.Lexer as L
+import qualified Data.Text                  as T
+import qualified Text.Megaparsec.Char.Lexer as L
 
 ----------------------------------------------------------------------------
 -- Parser
@@ -37,7 +41,7 @@ parseMustache
      -- ^ Location of the file to parse
   -> Text
      -- ^ File contents (Mustache template)
-  -> Either (ParseError Char Dec) [Node]
+  -> Either (ParseError Char Void) [Node]
      -- ^ Parsed nodes or parse error
 parseMustache = parse $
   evalStateT (pMustache eof) (Delimiters "{{" "}}")
@@ -77,11 +81,11 @@ pUnescapedSpecial :: Parser Node
 pUnescapedSpecial = do
   start <- gets openingDel
   end   <- gets closingDel
-  between (symbol $ start ++ "{") (string $ "}" ++ end) $
+  between (symbol $ start <> "{") (string $ "}" <> end) $
     UnescapedVar <$> pKey
 {-# INLINE pUnescapedSpecial #-}
 
-pSection :: String -> (Key -> [Node] -> Node) -> Parser Node
+pSection :: Text -> (Key -> [Node] -> Node) -> Parser Node
 pSection suffix f = do
   key   <- withStandalone (pTag suffix)
   nodes <- (pMustache . withStandalone . pClosingTag) key
@@ -100,18 +104,18 @@ pComment :: Parser ()
 pComment = void $ do
   start <- gets openingDel
   end   <- gets closingDel
-  (void . symbol) (start ++ "!")
+  (void . symbol) (start <> "!")
   manyTill anyChar (string end)
 {-# INLINE pComment #-}
 
 pSetDelimiters :: Parser ()
 pSetDelimiters = void $ do
   start <- gets openingDel
   end   <- gets closingDel
-  (void . symbol) (start ++ "=")
+  (void . symbol) (start <> "=")
   start' <- pDelimiter <* scn
   end'   <- pDelimiter <* scn
-  (void . string) ("=" ++ end)
+  (void . string) ("=" <> end)
   put (Delimiters start' end')
 {-# INLINE pSetDelimiters #-}
 
@@ -127,74 +131,77 @@ pStandalone :: Parser a -> Parser a
 pStandalone p = pBol *> try (between sc (sc <* (void eol <|> eof)) p)
 {-# INLINE pStandalone #-}
 
-pTag :: String -> Parser Key
+pTag :: Text -> Parser Key
 pTag suffix = do
   start <- gets openingDel
   end   <- gets closingDel
-  between (symbol $ start ++ suffix) (string end) pKey
+  between (symbol $ start <> suffix) (string end) pKey
 {-# INLINE pTag #-}
 
 pClosingTag :: Key -> Parser ()
 pClosingTag key = do
   start <- gets openingDel
   end   <- gets closingDel
-  let str = keyToString key
-  void $ between (symbol $ start ++ "/") (string end) (symbol str)
+  let str = keyToText key
+  void $ between (symbol $ start <> "/") (string end) (symbol str)
 {-# INLINE pClosingTag #-}
 
 pKey :: Parser Key
 pKey = (fmap Key . lexeme . label "key") (implicit <|> other)
   where
     implicit = [] <$ char '.'
-    other    = sepBy1 (T.pack <$> some ch) (char '.')
-    ch       = alphaNumChar <|> oneOf "-_"
+    other    = sepBy1 (takeWhile1P (Just lbl) f) (char '.')
+    lbl      = "alphanumeric char or '-' or '_'"
+    f x      = isAlphaNum x || x == '-' || x == '_'
 {-# INLINE pKey #-}
 
-pDelimiter :: Parser String
-pDelimiter = some (satisfy delChar) <?> "delimiter"
+pDelimiter :: Parser Text
+pDelimiter = takeWhile1P (Just "delimiter char") delChar <?> "delimiter"
   where delChar x = not (isSpace x) && x /= '='
 {-# INLINE pDelimiter #-}
 
 pBol :: Parser ()
 pBol = do
   level <- L.indentLevel
-  unless (level == unsafePos 1) empty
+  unless (level == pos1) empty
 {-# INLINE pBol #-}
 
 ----------------------------------------------------------------------------
 -- Auxiliary types
 
 -- | Type of Mustache parser monad stack.
 
-type Parser = StateT Delimiters (Parsec Dec Text)
+type Parser = StateT Delimiters (Parsec Void Text)
 
 -- | State used in Mustache parser. It includes currently set opening and
 -- closing delimiters.
 
 data Delimiters = Delimiters
-  { openingDel :: String
-  , closingDel :: String }
+  { openingDel :: Text
+  , closingDel :: Text }
 
 ----------------------------------------------------------------------------
 -- Lexer helpers and other
 
 scn :: Parser ()
-scn = L.space (void spaceChar) empty empty
+scn = L.space space1 empty empty
 {-# INLINE scn #-}
 
 sc :: Parser ()
-sc = L.space (void $ oneOf " \t") empty empty
+sc = L.space (void $ takeWhile1P Nothing f) empty empty
+  where
+    f x = x == ' ' || x == '\t'
 {-# INLINE sc #-}
 
 lexeme :: Parser a -> Parser a
 lexeme = L.lexeme scn
 {-# INLINE lexeme #-}
 
-symbol :: String -> Parser String
+symbol :: Text -> Parser Text
 symbol = L.symbol scn
 {-# INLINE symbol #-}
 
-keyToString :: Key -> String
-keyToString (Key []) = "."
-keyToString (Key ks) = intercalate "." (T.unpack <$> ks)
-{-# INLINE keyToString #-}
+keyToText :: Key -> Text
+keyToText (Key []) = "."
+keyToText (Key ks) = T.intercalate "." ks
+{-# INLINE keyToText #-}

Text/Mustache/Type.hs

@@ -34,6 +34,7 @@ import Data.Semigroup
 import Data.String (IsString (..))
 import Data.Text (Text)
 import Data.Typeable (Typeable)
+import Data.Void
 import GHC.Generics
 import Text.Megaparsec
 import qualified Data.Map  as M
@@ -108,15 +109,15 @@ instance NFData PName
 -- values are not provided.
 
 data MustacheException
-  = MustacheParserException (ParseError Char Dec)
+  = MustacheParserException Text (ParseError Char Void)
     -- ^ Template parser has failed. This contains the parse error.
     --
     -- /Before version 0.2.0 it was called 'MustacheException'./
   deriving (Eq, Show, Typeable, Generic)
 
 #if MIN_VERSION_base(4,8,0)
 instance Exception MustacheException where
-  displayException (MustacheParserException e) = parseErrorPretty e
+  displayException (MustacheParserException s e) = parseErrorPretty' s e
 #else
 instance Exception MustacheException
 #endif

bench/Main.hs

@@ -13,7 +13,7 @@ import Text.Mustache.Compile
 import Text.Mustache.Parser
 import Text.Mustache.Render
 import Text.Mustache.Type
-import qualified Data.Text.Lazy.IO as T
+import qualified Data.Text.IO as T
 
 ----------------------------------------------------------------------------
 -- Benchmarks

mustache-spec/Spec.hs

@@ -38,9 +38,9 @@ data Test = Test
   { testName     :: String
   , testDesc     :: String
   , testData     :: Value
-  , testTemplate :: TL.Text
-  , testExpected :: TL.Text
-  , testPartials :: Map Text TL.Text
+  , testTemplate :: Text
+  , testExpected :: Text
+  , testPartials :: Map Text Text
   }
 
 instance FromJSON Test where
@@ -84,5 +84,5 @@ specData aspect bytes = describe aspect $ do
                   Left perr -> handleError perr >> undefined
                   Right ns  -> return (pname, ns)
               let ps2 = M.fromList ps1 `M.union` templateCache
-              renderMustache (Template templateActual ps2) testData
+              TL.toStrict (renderMustache (Template templateActual ps2) testData)
                 `shouldBe` testExpected

stache.cabal

@@ -36,7 +36,7 @@ library
                     , directory        >= 1.2  && < 1.4
                     , exceptions       >= 0.8  && < 0.9
                     , filepath         >= 1.2  && < 1.5
-                    , megaparsec       >= 5.0  && < 6.0
+                    , megaparsec       >= 6.0  && < 7.0
                     , mtl              >= 2.1  && < 3.0
                     , template-haskell >= 2.10 && < 2.13
                     , text             >= 1.2  && < 1.3
@@ -64,8 +64,8 @@ test-suite tests
                     , base             >= 4.7  && < 5.0
                     , containers       >= 0.5  && < 0.6
                     , hspec            >= 2.0  && < 3.0
-                    , hspec-megaparsec >= 0.2  && < 0.4
-                    , megaparsec       >= 5.0  && < 6.0
+                    , hspec-megaparsec >= 1.0  && < 2.0
+                    , megaparsec       >= 6.0  && < 7.0
                     , stache
                     , text             >= 1.2  && < 1.3
   other-modules:      Text.Mustache.Compile.THSpec
@@ -90,7 +90,7 @@ test-suite mustache-spec
                     , containers       >= 0.5  && < 0.6
                     , file-embed
                     , hspec            >= 2.0  && < 3.0
-                    , megaparsec       >= 5.0  && < 6.0
+                    , megaparsec       >= 6.0  && < 7.0
                     , stache
                     , text             >= 1.2  && < 1.3
                     , yaml             >= 0.8  && < 0.9
@@ -108,7 +108,7 @@ benchmark bench
                     , base             >= 4.7  && < 5.0
                     , criterion        >= 0.6.2.1 && < 1.3
                     , deepseq          >= 1.4  && < 1.5
-                    , megaparsec       >= 5.0  && < 6.0
+                    , megaparsec       >= 6.0  && < 7.0
                     , stache
                     , text             >= 1.2  && < 1.3
   if flag(dev)

stack.yaml

@@ -1,3 +1,6 @@
-resolver: lts-8.15
+resolver: lts-9.0
 packages:
 - '.'
+extra-deps:
+- hspec-megaparsec-1.0.0
+- megaparsec-6.0.0