snack 0.3.0.0 → 0.4.0.0
raw patch · 8 files changed
+149/−122 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Data.ByteString.Parser: commit :: Parser a -> Parser a
- Data.ByteString.Parser.Char8: commit :: Parser a -> Parser a
- Data.Text.Parser: commit :: Parser a -> Parser a
+ Data.ByteString.Parser: branch :: [(Parser a, a -> Parser b)] -> Parser b
+ Data.ByteString.Parser.Char8: branch :: [(Parser a, a -> Parser b)] -> Parser b
+ Data.Text.Parser: branch :: [(Parser a, a -> Parser b)] -> Parser b
- Data.ByteString.Parser: parseOnly :: Parser a -> ByteString -> Maybe a
+ Data.ByteString.Parser: parseOnly :: Parser a -> ByteString -> Either String a
- Data.ByteString.Parser.Char8: parseOnly :: Parser a -> ByteString -> Maybe a
+ Data.ByteString.Parser.Char8: parseOnly :: Parser a -> ByteString -> Either String a
- Data.Text.Parser: parseOnly :: Parser a -> Text -> Maybe a
+ Data.Text.Parser: parseOnly :: Parser a -> Text -> Either String a
Files
- Changelog.md +5/−0
- bench/Bench.hs +62/−72
- lib/Data/ByteString/Parser.hs +37/−23
- lib/Data/ByteString/Parser.hs-boot +2/−0
- lib/Data/ByteString/Parser/Char8.hs +3/−3
- lib/Data/Text/Parser.hs +36/−22
- lib/Data/Text/Parser.hs-boot +2/−0
- snack.cabal +2/−2
Changelog.md view
@@ -15,3 +15,8 @@ [0.3.0.0]: https://github.com/mordae/snack/compare/0.2.0.0...0.3.0.0 * Implemented functions to aid with error reporting.++[0.4.0.0] -- July 2022+[0.4.0.0]: https://github.com/mordae/snack/compare/0.3.0.0...0.4.0.0++* Replaced `commit` with `branch` to deal with unwanted backtracking.
bench/Bench.hs view
@@ -58,10 +58,12 @@ {-# NOINLINE scMedia #-} scMedia :: ByteString -> Maybe [Media ByteString]- scMedia = SC.parseOnly (pMediaList <* SC.endOfInput)+ scMedia = SC.parseOnly (SC.skipSpace *> pMediaList <* SC.endOfInput) where- pMedia :: SC.Parser (Media ByteString)+ pMediaList :: SC.Parser [Media ByteString] pMediaList = pMedia `SC.sepBy` pSeparator++ pMedia :: SC.Parser (Media ByteString) pMedia = do mainType <- pToken subType <- (SC.char '/' *> pToken) <|> pure ""@@ -74,38 +76,35 @@ pParameter :: SC.Parser (ByteString, ByteString) pParameter = do- _ <- SC.takeWhile SC.isSpace- _ <- SC.char ';'+ _ <- SC.char ';' <* SC.skipSpace name <- pToken- _ <- SC.char '='+ _ <- SC.char '=' <* SC.skipSpace value <- pValue return (name, value) pQuality :: SC.Parser Float pQuality = do- _ <- SC.takeWhile SC.isSpace- _ <- SC.char ';'- _ <- pSpaced $ SC.char 'q'- _ <- SC.char '='+ _ <- SC.char ';' <* SC.skipSpace+ _ <- SC.char 'q' <* SC.skipSpace+ _ <- SC.char '=' <* SC.skipSpace SC.fractional pToken :: SC.Parser ByteString- pToken = pSpaced $ SC.label "token" $ SC.takeTill1 isSpecial+ pToken = SC.label "token" $ SC.takeTill1 isSpecial <* SC.skipSpace pSeparator :: SC.Parser Char- pSeparator = pSpaced $ SC.char ','+ pSeparator = SC.char ',' <* SC.skipSpace pValue :: SC.Parser ByteString- pValue = pToken <|> pQuotedStr+ pValue = SC.branch [ (SC.char '"', \_ -> pQuotedStr)+ , ( pure ' ', \_ -> pToken)+ ] pQuotedStr :: SC.Parser ByteString- pQuotedStr = pSpaced $ SC.label "quoted string" $ pQuoted $ SC.takeWhile isStrChar-- pSpaced :: SC.Parser a -> SC.Parser a- pSpaced p = p `SC.wrap` SC.takeWhile SC.isSpace+ pQuotedStr = pString <* SC.char '"' <* SC.skipSpace - pQuoted :: SC.Parser a -> SC.Parser a- pQuoted p = SC.char '"' *> p <* SC.char '"'+ pString :: SC.Parser ByteString+ pString = SC.label "string" $ SC.takeWhile isStrChar isStrChar :: (Char -> Bool) isStrChar c = c /= '\\' && c /= '"'@@ -124,10 +123,12 @@ {-# NOINLINE acMedia #-} acMedia :: ByteString -> Either String [Media ByteString]- acMedia = AC.parseOnly (pMediaList <* AC.endOfInput)+ acMedia = AC.parseOnly (AC.skipSpace *> pMediaList <* AC.endOfInput) where- pMedia :: AC.Parser (Media ByteString)+ pMediaList :: AC.Parser [Media ByteString] pMediaList = pMedia `AC.sepBy` pSeparator++ pMedia :: AC.Parser (Media ByteString) pMedia = do mainType <- pToken subType <- (AC.char '/' *> pToken) <|> pure ""@@ -140,38 +141,33 @@ pParameter :: AC.Parser (ByteString, ByteString) pParameter = do- _ <- AC.skipSpace- _ <- AC.char ';'+ _ <- AC.char ';' <* AC.skipSpace name <- pToken- _ <- AC.char '='+ _ <- AC.char '=' <* AC.skipSpace value <- pValue return (name, value) pQuality :: AC.Parser Float pQuality = do- _ <- AC.skipSpace- _ <- AC.char ';'- _ <- pSpaced $ AC.char 'q'- _ <- AC.char '='+ _ <- AC.char ';' <* AC.skipSpace+ _ <- AC.char 'q' <* AC.skipSpace+ _ <- AC.char '=' <* AC.skipSpace AC.rational pToken :: AC.Parser ByteString- pToken = pSpaced $ AC.takeTill isSpecial+ pToken = AC.takeTill isSpecial <* AC.skipSpace pSeparator :: AC.Parser Char- pSeparator = pSpaced $ AC.char ','+ pSeparator = AC.char ',' <* AC.skipSpace pValue :: AC.Parser ByteString- pValue = pToken <|> pQuotedStr+ pValue = pQuotedStr <|> pToken pQuotedStr :: AC.Parser ByteString- pQuotedStr = pSpaced $ pQuoted $ AC.takeWhile isStrChar-- pSpaced :: AC.Parser a -> AC.Parser a- pSpaced p = AC.skipSpace *> p <* AC.skipSpace+ pQuotedStr = pQuoted $ AC.takeWhile isStrChar pQuoted :: AC.Parser a -> AC.Parser a- pQuoted p = AC.char '"' *> p <* AC.char '"'+ pQuoted p = AC.char '"' *> p <* AC.char '"' <* AC.skipSpace isStrChar :: (Char -> Bool) isStrChar c = c /= '\\' && c /= '"'@@ -189,10 +185,12 @@ {-# NOINLINE stMedia #-} stMedia :: Text -> Maybe [Media Text]- stMedia = ST.parseOnly (pMediaList <* ST.endOfInput)+ stMedia = ST.parseOnly (ST.skipSpace *> pMediaList <* ST.endOfInput) where- pMedia :: ST.Parser (Media Text)+ pMediaList :: ST.Parser [Media Text] pMediaList = pMedia `ST.sepBy` pSeparator++ pMedia :: ST.Parser (Media Text) pMedia = do mainType <- pToken subType <- (ST.char '/' *> pToken) <|> pure ""@@ -205,38 +203,35 @@ pParameter :: ST.Parser (Text, Text) pParameter = do- _ <- ST.takeWhile ST.isSpace- _ <- ST.char ';'+ _ <- ST.char ';' <* ST.skipSpace name <- pToken- _ <- ST.char '='+ _ <- ST.char '=' <* ST.skipSpace value <- pValue return (name, value) pQuality :: ST.Parser Float pQuality = do- _ <- ST.takeWhile ST.isSpace- _ <- ST.char ';'- _ <- pSpaced $ ST.char 'q'- _ <- ST.char '='+ _ <- ST.char ';' <* ST.skipSpace+ _ <- ST.char 'q' <* ST.skipSpace+ _ <- ST.char '=' <* ST.skipSpace ST.fractional pToken :: ST.Parser Text- pToken = pSpaced $ ST.takeTill1 isSpecial+ pToken = ST.takeTill1 isSpecial <* ST.skipSpace pSeparator :: ST.Parser Char- pSeparator = pSpaced $ ST.char ','+ pSeparator = ST.char ',' <* ST.skipSpace pValue :: ST.Parser Text- pValue = pToken <|> pQuotedStr+ pValue = ST.branch [ (ST.char '"', \_ -> pQuotedStr)+ , ( pure ' ', \_ -> pToken)+ ] pQuotedStr :: ST.Parser Text- pQuotedStr = pSpaced $ pQuoted $ ST.takeWhile isStrChar-- pSpaced :: ST.Parser a -> ST.Parser a- pSpaced p = p `ST.wrap` ST.takeWhile ST.isSpace+ pQuotedStr = pString <* ST.char '"' <* ST.skipSpace - pQuoted :: ST.Parser a -> ST.Parser a- pQuoted p = ST.char '"' *> p <* ST.char '"'+ pString :: ST.Parser Text+ pString = ST.label "string" $ ST.takeWhile isStrChar isStrChar :: (Char -> Bool) isStrChar c = c /= '\\' && c /= '"'@@ -255,10 +250,12 @@ {-# NOINLINE atMedia #-} atMedia :: Text -> Either String [Media Text]- atMedia = AT.parseOnly (pMediaList <* AT.endOfInput)+ atMedia = AT.parseOnly (AT.skipSpace *> pMediaList <* AT.endOfInput) where- pMedia :: AT.Parser (Media Text)+ pMediaList :: AT.Parser [Media Text] pMediaList = pMedia `AT.sepBy` pSeparator++ pMedia :: AT.Parser (Media Text) pMedia = do mainType <- pToken subType <- (AT.char '/' *> pToken) <|> pure ""@@ -271,38 +268,33 @@ pParameter :: AT.Parser (Text, Text) pParameter = do- _ <- AT.skipSpace- _ <- AT.char ';'+ _ <- AT.char ';' <* AT.skipSpace name <- pToken- _ <- AT.char '='+ _ <- AT.char '=' <* AT.skipSpace value <- pValue return (name, value) pQuality :: AT.Parser Float pQuality = do- _ <- AT.skipSpace- _ <- AT.char ';'- _ <- pSpaced $ AT.char 'q'- _ <- AT.char '='+ _ <- AT.char ';' <* AT.skipSpace+ _ <- AT.char 'q' <* AT.skipSpace+ _ <- AT.char '=' <* AT.skipSpace AT.rational pToken :: AT.Parser Text- pToken = pSpaced $ AT.takeTill isSpecial+ pToken = AT.takeTill isSpecial <* AT.skipSpace pSeparator :: AT.Parser Char- pSeparator = pSpaced $ AT.char ','+ pSeparator = AT.char ',' <* AT.skipSpace pValue :: AT.Parser Text- pValue = pToken <|> pQuotedStr+ pValue = pQuotedStr <|> pToken pQuotedStr :: AT.Parser Text- pQuotedStr = pSpaced $ pQuoted $ AT.takeWhile isStrChar-- pSpaced :: AT.Parser a -> AT.Parser a- pSpaced p = AT.skipSpace *> p <* AT.skipSpace+ pQuotedStr = pQuoted $ AT.takeWhile isStrChar pQuoted :: AT.Parser a -> AT.Parser a- pQuoted p = AT.char '"' *> p <* AT.char '"'+ pQuoted p = AT.char '"' *> p <* AT.char '"' <* AT.skipSpace isStrChar :: (Char -> Bool) isStrChar c = c /= '\\' && c /= '"'@@ -325,7 +317,6 @@ _ <- SC.skipSpace key <- SC.takeWhile1 isToken _ <- SC.skipSpace- _ <- SC.skipSpace _ <- SC.char '=' _ <- SC.skipSpace _ <- SC.char '"'@@ -355,7 +346,6 @@ pKeyValue = do _ <- ST.skipSpace key <- ST.takeWhile1 isToken- _ <- ST.skipSpace _ <- ST.skipSpace _ <- ST.char '=' _ <- ST.skipSpace
lib/Data/ByteString/Parser.hs view
@@ -42,6 +42,7 @@ -- * Combinators , provided , choice+ , branch , Snack.Combinators.count , optional , eitherP@@ -55,7 +56,6 @@ , match , label , unlabel- , commit , validate -- * End Of Input@@ -84,9 +84,9 @@ import Control.Applicative import Control.Monad + import Data.List qualified as List import Data.Maybe import Data.Word- import Data.List qualified as List import Data.ByteString as BS import Data.ByteString.Unsafe as BS@@ -225,11 +225,15 @@ -- @ -- {-# INLINE CONLIKE parseOnly #-}- parseOnly :: Parser a -> ByteString -> Maybe a+ parseOnly :: Parser a -> ByteString -> Either String a parseOnly par = \inp -> case runParser par inp of- Success res _ -> Just res- _otherwise -> Nothing+ Success res _ -> Right res+ Error reason _ _ -> Left reason+ Failure expected _ ->+ case expected of+ [] -> Left $ "Unexpected input."+ ex -> Left $ "Expected " <> List.intercalate ", " ex <> "." -- |@@ -420,24 +424,6 @@ -- |- -- Disable backtracking for the parser.- -- Failure is treated as an Error.- --- {-# INLINE CONLIKE commit #-}- commit :: Parser a -> Parser a- commit par = Parser \inp ->- case runParser par inp of- Success res more -> Success res more- Error reason more len -> Error reason more len- Failure expected more ->- Error- case expected of- [] -> "Unexpected input."- ex -> "Expected " <> List.intercalate ", " ex <> "."- more 0--- -- | -- Validate parser result and turn it into an Error upon failure. -- {-# INLINE CONLIKE validate #-}@@ -450,6 +436,34 @@ case test res of Right res' -> Success res' more Left reason -> Error reason inp (length inp - length more)+++ -- |+ -- Given list of matchers and parsers, runs the first parser whose matcher+ -- succeeds on the input. This pattern makes for a simpler alternative to+ -- @try@ used in other parser combinator libraries.+ --+ -- Example:+ --+ -- @+ -- pProperty = branch [ ( string "public" <* skipSpace+ -- , \_ -> Property Public <$> pToken+ -- )+ -- , ( string "private" <* skipSpace+ -- , \_ -> Property Private <$> pToken+ -- )+ -- ]+ -- @+ --+ {-# INLINE CONLIKE branch #-}+ branch :: [(Parser a, a -> Parser b)] -> Parser b+ branch [] = Parser \inp -> Failure [] inp+ branch ((Parser test, finish) : alts) =+ Parser \inp ->+ case test inp of+ Success res more -> runParser (finish res) more+ Error reason more len -> Error reason more len+ Failure _expected _more -> runParser (branch alts) inp -- |
lib/Data/ByteString/Parser.hs-boot view
@@ -1,6 +1,7 @@ module Data.ByteString.Parser where import Control.Applicative+ import Control.Monad import Data.ByteString (ByteString) data Result a@@ -19,3 +20,4 @@ instance Applicative Parser instance Alternative Parser instance Monad Parser+ instance MonadPlus Parser
lib/Data/ByteString/Parser/Char8.hs view
@@ -54,6 +54,7 @@ -- * Combinators , provided , choice+ , branch , Data.ByteString.Parser.count , optional , eitherP@@ -67,7 +68,6 @@ , match , label , unlabel- , commit , validate -- * End Of Input@@ -110,8 +110,8 @@ import Snack.Combinators import Data.ByteString.Parser ( Parser(..), Result(..), parseOnly- , string, count, match, label, unlabel, commit- , validate+ , string, count, match, label, unlabel+ , validate, branch , takeByteString, peekByteString , endOfInput, atEnd, offset )
lib/Data/Text/Parser.hs view
@@ -51,6 +51,7 @@ -- * Combinators , provided , choice+ , branch , Snack.Combinators.count , optional , eitherP@@ -64,7 +65,6 @@ , match , label , unlabel- , commit , validate -- * End Of Input@@ -225,11 +225,15 @@ -- @ -- {-# INLINE CONLIKE parseOnly #-}- parseOnly :: Parser a -> Text -> Maybe a+ parseOnly :: Parser a -> Text -> Either String a parseOnly par = \inp -> case runParser par inp of- Success res _ -> Just res- _otherwise -> Nothing+ Success res _ -> Right res+ Error reason _ _ -> Left reason+ Failure expected _ ->+ case expected of+ [] -> Left $ "Unexpected input."+ ex -> Left $ "Expected " <> List.intercalate ", " ex <> "." -- |@@ -450,24 +454,6 @@ -- |- -- Disable backtracking for the parser.- -- Failure is treated as an Error.- --- {-# INLINE CONLIKE commit #-}- commit :: Parser a -> Parser a- commit par = Parser \inp ->- case runParser par inp of- Success res more -> Success res more- Error reason more len -> Error reason more len- Failure expected more ->- Error- case expected of- [] -> "Unexpected input."- ex -> "Expected " <> List.intercalate ", " ex <> "."- more 0--- -- | -- Validate parser result and turn it into an Error upon failure. -- {-# INLINE CONLIKE validate #-}@@ -480,6 +466,34 @@ case test res of Right res' -> Success res' more Left reason -> Error reason inp (length inp - length more)+++ -- |+ -- Given list of matchers and parsers, runs the first parser whose matcher+ -- succeeds on the input. This pattern makes for a simpler alternative to+ -- @try@ used in other parser combinator libraries.+ --+ -- Example:+ --+ -- @+ -- pProperty = branch [ ( string "public" <* skipSpace+ -- , \_ -> Property Public <$> pToken+ -- )+ -- , ( string "private" <* skipSpace+ -- , \_ -> Property Private <$> pToken+ -- )+ -- ]+ -- @+ --+ {-# INLINE CONLIKE branch #-}+ branch :: [(Parser a, a -> Parser b)] -> Parser b+ branch [] = Parser \inp -> Failure [] inp+ branch ((Parser test, finish) : alts) =+ Parser \inp ->+ case test inp of+ Success res more -> runParser (finish res) more+ Error reason more len -> Error reason more len+ Failure _expected _more -> runParser (branch alts) inp -- |
lib/Data/Text/Parser.hs-boot view
@@ -1,6 +1,7 @@ module Data.Text.Parser where import Control.Applicative+ import Control.Monad import Data.Text (Text) data Result a@@ -19,3 +20,4 @@ instance Applicative Parser instance Alternative Parser instance Monad Parser+ instance MonadPlus Parser
snack.cabal view
@@ -1,12 +1,12 @@ cabal-version: 3.0 name: snack-version: 0.3.0.0+version: 0.4.0.0 license: CC0-1.0 license-file: LICENSE copyright: Jan Hamal Dvořák maintainer: mordae@anilinux.org author: Jan Hamal Dvořák-tested-with: ghc ==9.2.1 ghc ==9.0.2 ghc ==8.10.7+tested-with: ghc ==9.2.1 homepage: https://github.com/mordae/snack#readme bug-reports: https://github.com/mordae/snack/issues synopsis: Strict ByteString Parser Combinator