snack 0.1.0.0 → 0.2.0.0
raw patch · 10 files changed
+589/−209 lines, 10 filesdep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: bytestring
API changes (from Hackage documentation)
- Data.Text.Parser: inRange :: Char -> Char -> Char -> Bool
- Data.Text.Parser: notInRange :: Char -> Char -> Char -> Bool
+ Data.ByteString.Parser: Error :: String -> {-# UNPACK #-} !ByteString -> {-# UNPACK #-} !Int -> Result a
+ Data.ByteString.Parser: Failure :: [String] -> {-# UNPACK #-} !ByteString -> Result a
+ Data.ByteString.Parser: Success :: a -> {-# UNPACK #-} !ByteString -> Result a
+ Data.ByteString.Parser: data Result a
+ Data.ByteString.Parser: extent :: Parser a -> Parser a
+ Data.ByteString.Parser: instance GHC.Base.Functor Data.ByteString.Parser.Result
+ Data.ByteString.Parser: instance GHC.Classes.Eq a => GHC.Classes.Eq (Data.ByteString.Parser.Result a)
+ Data.ByteString.Parser: instance GHC.Show.Show a => GHC.Show.Show (Data.ByteString.Parser.Result a)
+ Data.ByteString.Parser: label :: String -> Parser a -> Parser a
+ Data.ByteString.Parser.Char8: Error :: String -> {-# UNPACK #-} !ByteString -> {-# UNPACK #-} !Int -> Result a
+ Data.ByteString.Parser.Char8: Failure :: [String] -> {-# UNPACK #-} !ByteString -> Result a
+ Data.ByteString.Parser.Char8: Success :: a -> {-# UNPACK #-} !ByteString -> Result a
+ Data.ByteString.Parser.Char8: data Result a
+ Data.ByteString.Parser.Char8: extent :: Parser a -> Parser a
+ Data.ByteString.Parser.Char8: label :: String -> Parser a -> Parser a
+ Data.Text.Parser: Error :: String -> {-# UNPACK #-} !Text -> {-# UNPACK #-} !Int -> Result a
+ Data.Text.Parser: Failure :: [String] -> {-# UNPACK #-} !Text -> Result a
+ Data.Text.Parser: Success :: a -> {-# UNPACK #-} !Text -> Result a
+ Data.Text.Parser: data Result a
+ Data.Text.Parser: extent :: Parser a -> Parser a
+ Data.Text.Parser: instance GHC.Base.Functor Data.Text.Parser.Result
+ Data.Text.Parser: instance GHC.Classes.Eq a => GHC.Classes.Eq (Data.Text.Parser.Result a)
+ Data.Text.Parser: instance GHC.Show.Show a => GHC.Show.Show (Data.Text.Parser.Result a)
+ Data.Text.Parser: label :: String -> Parser a -> Parser a
- Data.ByteString.Parser: Parser :: (ByteString -> Maybe (a, ByteString)) -> Parser a
+ Data.ByteString.Parser: Parser :: (ByteString -> Result a) -> Parser a
- Data.ByteString.Parser: [runParser] :: Parser a -> ByteString -> Maybe (a, ByteString)
+ Data.ByteString.Parser: [runParser] :: Parser a -> ByteString -> Result a
- Data.ByteString.Parser: provided :: (Alternative m, Monad m) => (a -> Bool) -> m a -> m a
+ Data.ByteString.Parser: provided :: (Alternative m, Monad m) => m a -> (a -> Bool) -> m a
- Data.ByteString.Parser.Char8: Parser :: (ByteString -> Maybe (a, ByteString)) -> Parser a
+ Data.ByteString.Parser.Char8: Parser :: (ByteString -> Result a) -> Parser a
- Data.ByteString.Parser.Char8: [runParser] :: Parser a -> ByteString -> Maybe (a, ByteString)
+ Data.ByteString.Parser.Char8: [runParser] :: Parser a -> ByteString -> Result a
- Data.ByteString.Parser.Char8: provided :: (Alternative m, Monad m) => (a -> Bool) -> m a -> m a
+ Data.ByteString.Parser.Char8: provided :: (Alternative m, Monad m) => m a -> (a -> Bool) -> m a
- Data.Text.Parser: Parser :: (Text -> Maybe (a, Text)) -> Parser a
+ Data.Text.Parser: Parser :: (Text -> Result a) -> Parser a
- Data.Text.Parser: [runParser] :: Parser a -> Text -> Maybe (a, Text)
+ Data.Text.Parser: [runParser] :: Parser a -> Text -> Result a
- Data.Text.Parser: provided :: (Alternative m, Monad m) => (a -> Bool) -> m a -> m a
+ Data.Text.Parser: provided :: (Alternative m, Monad m) => m a -> (a -> Bool) -> m a
Files
- Changelog.md +8/−0
- README.md +3/−3
- bench/Bench.hs +6/−8
- lib/Data/ByteString/Parser.hs +161/−55
- lib/Data/ByteString/Parser.hs-boot +8/−1
- lib/Data/ByteString/Parser/Char8.hs +50/−30
- lib/Data/Text/Parser.hs +320/−96
- lib/Data/Text/Parser.hs-boot +8/−1
- lib/Snack/Combinators.hs +12/−8
- snack.cabal +13/−7
Changelog.md view
@@ -2,3 +2,11 @@ [0.1.0.0]: https://github.com/mordae/snack/compare/initial...0.1.0.0 * Initial release++[0.2.0.0] -- April 2022+[0.2.0.0]: https://github.com/mordae/snack/compare/0.1.0.0...0.2.0.0++* Fixed `provided` combinator argument order.+* Implemented basic error tracking.+* Expanded documentation to fully cover Text parser.+* Compatibility with GHC 8.10 and GHC 9.0 on top of GHC 9.2.
README.md view
@@ -28,7 +28,7 @@ putStrLn $ show $ BSP.runParser (parseList <* BSP.endOfInput) "^quux" -- Will output:--- Just (["monkey","wrench","bananas"],"")--- Just ([""],"^quux")--- Nothing+-- Success ["monkey","wrench","bananas"] ""+-- Success [""] "^quux"+-- Failure ["end of input"] "^quux" ```
bench/Bench.hs view
@@ -7,8 +7,6 @@ -- Portability : non-portable (ghc) -- -{-# OPTIONS_GHC -ddump-to-file -ddump-stg-from-core -ddump-cmm-opt -dsuppress-all -dppr-cols=200 #-}- module Main ( main )@@ -24,10 +22,10 @@ import Criterion.Main - import qualified Data.ByteString.Parser.Char8 as SC- import qualified Data.Attoparsec.ByteString.Char8 as AC- import qualified Data.Text.Parser as ST- import qualified Data.Attoparsec.Text as AT+ import Data.ByteString.Parser.Char8 qualified as SC+ import Data.Attoparsec.ByteString.Char8 qualified as AC+ import Data.Text.Parser qualified as ST+ import Data.Attoparsec.Text qualified as AT main :: IO ()@@ -92,7 +90,7 @@ SC.fractional pToken :: SC.Parser ByteString- pToken = pSpaced $ SC.takeTill1 isSpecial+ pToken = pSpaced $ SC.label "token" $ SC.takeTill1 isSpecial pSeparator :: SC.Parser Char pSeparator = pSpaced $ SC.char ','@@ -101,7 +99,7 @@ pValue = pToken <|> pQuotedStr pQuotedStr :: SC.Parser ByteString- pQuotedStr = pSpaced $ pQuoted $ SC.takeWhile isStrChar+ 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
lib/Data/ByteString/Parser.hs view
@@ -19,6 +19,7 @@ module Data.ByteString.Parser ( Parser(..)+ , Result(..) , parseOnly -- * Bytes@@ -52,6 +53,8 @@ , sepBy1 , wrap , match+ , label+ , extent -- * End Of Input , takeByteString@@ -84,68 +87,110 @@ import Snack.Combinators + -- |+ -- Result represents either success or some kind of failure.+ --+ -- You can find the problematic offset by subtracting length of the+ -- remainder from length of the original input.+ --+ data Result a+ = Success a {-# UNPACK #-} !ByteString+ -- ^ Parser successfully match the input.+ -- Produces the parsing result and the remainder of the input.++ | Failure [String] {-# UNPACK #-} !ByteString+ -- ^ Parser failed to match the input.+ -- Produces list of expected inputs and the corresponding remainder.++ | Error String {-# UNPACK #-} !ByteString {-# UNPACK #-} !Int+ -- ^ 'fail' was called somewhere during the parsing.+ -- Produces the reason and the remainder at the corresponding point+ -- with length of the problematic extent.++ deriving (Eq, Show)++ instance Functor Result where+ {-# INLINE fmap #-}+ fmap fn (Success res more) = Success (fn res) more+ fmap _ (Failure expected more) = Failure expected more+ fmap _ (Error reason more len) = Error reason more len+++ -- |+ -- Parser for 'ByteString' inputs.+ -- newtype Parser a = Parser- { runParser :: ByteString -> Maybe (a, ByteString)+ { runParser :: ByteString -> Result a+ -- ^ Run the parser on specified input. } instance Functor Parser where {-# INLINE fmap #-} fmap fn Parser{runParser} = Parser \inp ->- case runParser inp of- Just (res, rest) -> Just (fn res, rest)- Nothing -> Nothing+ fmap fn (runParser inp) instance Applicative Parser where {-# INLINE pure #-}- pure x = Parser \inp -> Just (x, inp)+ pure x = Parser \inp -> Success x inp {-# INLINE (<*>) #-} (Parser runFn) <*> (Parser runArg) = Parser \inp -> case runFn inp of- Nothing -> Nothing- Just (fn, rest) ->- case runArg rest of- Nothing -> Nothing- Just (x, rest') -> Just (fn x, rest')+ Error reason more len -> Error reason more len+ Failure expected more -> Failure expected more+ Success fn rest -> fmap fn (runArg rest) instance Alternative Parser where {-# INLINE empty #-}- empty = Parser \_ -> Nothing+ empty = Parser \inp -> Failure [] inp + -- |+ -- Tries the right branch only if the left brach produces Failure.+ -- Does not mask Error.+ -- {-# INLINE (<|>) #-} (Parser runLeft) <|> (Parser runRight) = Parser \inp -> case runLeft inp of- Just r -> Just r- Nothing -> runRight inp+ Success res more -> Success res more+ Error reason more len -> Error reason more len+ Failure expected more ->+ case runRight inp of+ Success res' more' -> Success res' more'+ Error reason' more' len' -> Error reason' more' len'+ Failure expected' more' ->+ -- Longer match (shorter remainder) wins.+ case length more `compare` length more' of+ LT -> Failure expected more+ EQ -> Failure (expected <> expected') more+ GT -> Failure expected' more' instance Monad Parser where {-# INLINE (>>=) #-} (Parser runLeft) >>= right = Parser \inp -> case runLeft inp of- Nothing -> Nothing- Just (x, more) -> runParser (right x) more+ Error reason more len -> Error reason more len+ Failure expected more -> Failure expected more+ Success res more -> runParser (right res) more instance MonadPlus Parser instance MonadFail Parser where+ -- |+ -- Fail the whole parser with given reason.+ --+ -- If you want the best error report possible, fail at the end of a+ -- relevant 'extent'.+ --+ -- For example, if you are parsing a mapping that is syntactically valid,+ -- but does not contain some mandatory keys, fail after parsing the whole+ -- mapping and make sure that the maaping parser and the 'fail' call are+ -- enclosed in an 'extent'.+ --+ -- That way, the error will indicate the extent remainder and length.+ -- {-# INLINE CONLIKE fail #-}- fail _ = mzero--- -- |- -- Discards the remaining input and returns just the parse result.- -- You might want to combine it with 'endOfInput' for the best effect.- --- -- Example:- --- -- @- -- parseOnly (pContacts \<* endOfInput) bstr- -- @- --- {-# INLINE CONLIKE parseOnly #-}- parseOnly :: Parser a -> ByteString -> Maybe a- parseOnly par = \inp -> fst <$> runParser par inp+ fail reason = Parser \inp -> Error reason inp 0 -- |@@ -165,14 +210,32 @@ -- |+ -- Discards the remaining input and returns just the parse result.+ -- You might want to combine it with 'endOfInput' for the best effect.+ --+ -- Example:+ --+ -- @+ -- parseOnly (pContacts \<* endOfInput) bstr+ -- @+ --+ {-# INLINE CONLIKE parseOnly #-}+ parseOnly :: Parser a -> ByteString -> Maybe a+ parseOnly par = \inp ->+ case runParser par inp of+ Success res _ -> Just res+ _otherwise -> Nothing+++ -- | -- Accepts a single byte. -- {-# INLINE anyByte #-} anyByte :: Parser Word8 anyByte = Parser \inp -> if null inp- then Nothing- else Just (unsafeHead inp, unsafeTail inp)+ then Failure ["any byte"] inp+ else Success (unsafeHead inp) (unsafeTail inp) -- |@@ -182,11 +245,11 @@ satisfy :: (Word8 -> Bool) -> Parser Word8 satisfy isOk = Parser \inp -> if null inp- then Nothing+ then Failure ["more input"] inp else let c = unsafeHead inp in if isOk c- then Just (c, unsafeTail inp)- else Nothing+ then Success c (unsafeTail inp)+ else Failure [] inp -- |@@ -199,8 +262,8 @@ peekByte :: Parser Word8 peekByte = Parser \inp -> if null inp- then Nothing- else Just (unsafeHead inp, inp)+ then Failure ["more input"] inp+ else Success (unsafeHead inp) inp -- |@@ -211,8 +274,8 @@ string str = Parser \inp -> let (pfx, sfx) = splitAt (length str) inp in case pfx == str of- True -> Just (pfx, sfx)- False -> Nothing+ True -> Success pfx sfx+ False -> Failure [(show pfx)] inp -- |@@ -223,8 +286,8 @@ take :: Int -> Parser ByteString take n = Parser \inp -> if n > length inp- then Nothing- else Just (splitAt n inp)+ then Failure [show n <> " more bytes"] inp+ else Success (unsafeTake n inp) (unsafeDrop n inp) -- |@@ -244,7 +307,7 @@ runScanner state scanner = Parser \inp -> let (state', n) = scanBytes state scanner 0 (unpack inp) (res, more) = splitAt n inp- in Just ((res, state'), more)+ in Success (res, state') more {-# INLINE scanBytes #-}@@ -270,8 +333,7 @@ -- {-# INLINE CONLIKE takeWhile1 #-} takeWhile1 :: (Word8 -> Bool) -> Parser ByteString- takeWhile1 test = provided (not . null) $- Data.ByteString.Parser.takeWhile test+ takeWhile1 test = Data.ByteString.Parser.takeWhile test `provided` (not . null) -- |@@ -282,7 +344,7 @@ takeTill :: (Word8 -> Bool) -> Parser ByteString takeTill test = Parser \inp -> let n = fromMaybe (length inp) $ findIndex test inp- in Just (splitAt n inp)+ in Success (unsafeTake n inp) (unsafeDrop n inp) -- |@@ -290,8 +352,7 @@ -- {-# INLINE CONLIKE takeTill1 #-} takeTill1 :: (Word8 -> Bool) -> Parser ByteString- takeTill1 test = provided (not . null) $- Data.ByteString.Parser.takeTill test+ takeTill1 test = Data.ByteString.Parser.takeTill test `provided` (not . null) -- |@@ -302,18 +363,63 @@ match :: Parser a -> Parser (ByteString, a) match par = Parser \inp -> case runParser par inp of- Nothing -> Nothing- Just (x, more) ->+ Failure expected more -> Failure expected more+ Error reason more len -> Error reason more len+ Success res more -> let n = length more- in Just ((BS.take n inp, x), more)+ in Success (BS.take n inp, res) more -- |+ -- Names an extent of the parser.+ --+ -- When the extent returns a Failure, details are discarded and replaced+ -- with the extent as a whole.+ --+ -- When the extent returns an Error, it is adjusted to cover the whole+ -- extent, but the reason is left intact.+ --+ -- You should strive to make labeled extents as small as possible,+ -- approximately of a typical token size. For example:+ --+ -- @+ -- pString = label \"string\" $ pStringContents \`wrap\` char \'\"\'+ -- @+ --+ {-# INLINE CONLIKE label #-}+ label :: String -> Parser a -> Parser a+ label lbl par = Parser \inp ->+ case runParser par inp of+ Success res more -> Success res more+ Failure _expected _more -> Failure [lbl] inp+ Error reason more len ->+ let len' = len + (length inp - length more)+ in Error reason inp len'+++ -- |+ -- Marks an unlabelel extent of the parser.+ --+ -- When the extent returns an Error, it is adjusted to cover the whole+ -- extent, but the reason is left intact.+ --+ {-# INLINE CONLIKE extent #-}+ extent :: Parser a -> Parser a+ extent par = Parser \inp ->+ case runParser par inp of+ Success res more -> Success res more+ Failure expected more -> Failure expected more+ Error reason more len ->+ let len' = len + (length inp - length more)+ in Error reason inp len'+++ -- | -- Accept whatever input remains. -- {-# INLINE takeByteString #-} takeByteString :: Parser ByteString- takeByteString = Parser \inp -> Just (inp, mempty)+ takeByteString = Parser \inp -> Success inp mempty -- |@@ -322,8 +428,8 @@ {-# INLINE endOfInput #-} endOfInput :: Parser () endOfInput = Parser \case- inp | null inp -> Just ((), inp)- _otherwise -> Nothing+ inp | null inp -> Success () inp+ inp -> Failure ["end of input"] inp -- |@@ -331,7 +437,7 @@ -- {-# INLINE atEnd #-} atEnd :: Parser Bool- atEnd = Parser \inp -> Just (null inp, inp)+ atEnd = Parser \inp -> Success (null inp) inp -- vim:set ft=haskell sw=2 ts=2 et:
lib/Data/ByteString/Parser.hs-boot view
@@ -3,9 +3,16 @@ import Control.Applicative import Data.ByteString (ByteString) + data Result a+ = Success a {-# UNPACK #-} !ByteString+ | Failure [String] {-# UNPACK #-} !ByteString+ | Error String {-# UNPACK #-} !ByteString {-# UNPACK #-} !Int++ instance Functor Result where+ newtype Parser a = Parser- { runParser :: ByteString -> Maybe (a, ByteString)+ { runParser :: ByteString -> Result a } instance Functor Parser
lib/Data/ByteString/Parser/Char8.hs view
@@ -8,9 +8,17 @@ -- -- This module provides a parser for ASCII 'ByteString'. --+-- * If you\'d like to parse Unicode text, look instead at the+-- "Data.Text.Parser". Is is slower, but in a way more correct.+--+-- * If you\'d like to parse byte sequences, look instead at the+-- "Data.ByteString.Parser". It reuses the same 'Parser', but+-- provides functions working with 'Word8' instead of 'Char'.+-- module Data.ByteString.Parser.Char8 ( Parser(..)+ , Result(..) , parseOnly -- * Characters@@ -57,6 +65,8 @@ , sepBy1 , wrap , match+ , label+ , extent -- * End Of Input , takeByteString@@ -89,13 +99,13 @@ import Snack.Combinators - import Data.ByteString.Parser ( Parser(..), parseOnly- , string, count, match+ import Data.ByteString.Parser ( Parser(..), Result(..), parseOnly+ , string, count, match, label, extent , takeByteString, endOfInput, atEnd ) - import qualified Data.ByteString.Lex.Fractional as LF- import qualified Data.ByteString.Lex.Integral as LI+ import Data.ByteString.Lex.Fractional qualified as LF+ import Data.ByteString.Lex.Integral qualified as LI -- |@@ -103,7 +113,7 @@ -- {-# INLINE CONLIKE char #-} char :: Char -> Parser Char- char c = satisfy (c ==)+ char c = label (show c) $ satisfy (c ==) -- |@@ -121,8 +131,8 @@ anyChar :: Parser Char anyChar = Parser \inp -> if null inp- then Nothing- else Just (w2c (unsafeHead inp), unsafeTail inp)+ then Failure ["any character"] inp+ else Success (w2c (unsafeHead inp)) (unsafeTail inp) -- |@@ -132,11 +142,11 @@ satisfy :: (Char -> Bool) -> Parser Char satisfy isOk = Parser \inp -> if null inp- then Nothing+ then Failure ["more input"] inp else let c = w2c (unsafeHead inp) in if isOk c- then Just (c, unsafeTail inp)- else Nothing+ then Success c (unsafeTail inp)+ else Failure [] inp -- |@@ -145,7 +155,7 @@ -- {-# INLINE space #-} space :: Parser Char- space = satisfy isSpace+ space = label "space" $ satisfy isSpace -- |@@ -178,8 +188,8 @@ peekChar :: Parser Char peekChar = Parser \inp -> if null inp- then Nothing- else Just (w2c (unsafeHead inp), inp)+ then Failure ["more input"] inp+ else Success (w2c (unsafeHead inp)) inp -- |@@ -191,8 +201,8 @@ stringCI str = Parser \inp -> let (pfx, sfx) = splitAt (length str) inp in case toCaseFold pfx == toCaseFold str of- True -> Just (pfx, sfx)- False -> Nothing+ True -> Success pfx sfx+ False -> Failure [show pfx] inp -- |@@ -206,15 +216,15 @@ -- |- -- Accepts given number of characters.- -- Fails when not enough characters are available.+ -- Accepts given number of bytes.+ -- Fails when not enough bytes are available. -- {-# INLINE CONLIKE take #-} take :: Int -> Parser ByteString take n = Parser \inp -> if n > length inp- then Nothing- else Just (splitAt n inp)+ then Failure [show n <> " more bytes"] inp+ else Success (unsafeTake n inp) (unsafeDrop n inp) -- |@@ -235,12 +245,12 @@ where loop inp !st !n = case n >= length inp of- True -> Just ((inp, st), mempty)+ True -> Success (inp, st) mempty False -> case unsafeIndex inp n of w -> case scanner st (w2c w) of- Nothing -> Just ((unsafeTake n inp, st), unsafeDrop n inp)+ Nothing -> Success (unsafeTake n inp, st) (unsafeDrop n inp) Just st' -> loop inp st' (succ n) @@ -258,8 +268,7 @@ -- {-# INLINE CONLIKE takeWhile1 #-} takeWhile1 :: (Char -> Bool) -> Parser ByteString- takeWhile1 test = provided (not . null) $- Data.ByteString.Parser.Char8.takeWhile test+ takeWhile1 test = Data.ByteString.Parser.Char8.takeWhile test `provided` (not . null) -- |@@ -270,7 +279,7 @@ takeTill :: (Char -> Bool) -> Parser ByteString takeTill test = Parser \inp -> let n = fromMaybe (length inp) $ findIndex (test . w2c) inp- in Just (splitAt n inp)+ in Success (unsafeTake n inp) (unsafeDrop n inp) -- |@@ -278,8 +287,7 @@ -- {-# INLINE CONLIKE takeTill1 #-} takeTill1 :: (Char -> Bool) -> Parser ByteString- takeTill1 test = provided (not . null) $- Data.ByteString.Parser.Char8.takeTill test+ takeTill1 test = Data.ByteString.Parser.Char8.takeTill test `provided` (not . null) -- |@@ -298,7 +306,10 @@ -- {-# INLINE decimal #-} decimal :: (Integral a) => Parser a- decimal = Parser LI.readDecimal+ decimal = Parser \inp ->+ case LI.readDecimal inp of+ Just (res, more) -> Success res more+ Nothing -> Failure ["decimal"] inp -- |@@ -307,7 +318,10 @@ -- {-# INLINE hexadecimal #-} hexadecimal :: (Integral a) => Parser a- hexadecimal = Parser LI.readHexadecimal+ hexadecimal = Parser \inp ->+ case LI.readHexadecimal inp of+ Just (res, more) -> Success res more+ Nothing -> Failure ["hexadecimal"] inp -- |@@ -315,7 +329,10 @@ -- {-# INLINE octal #-} octal :: (Integral a) => Parser a- octal = Parser LI.readOctal+ octal = Parser \inp ->+ case LI.readOctal inp of+ Just (res, more) -> Success res more+ Nothing -> Failure ["octal"] inp -- |@@ -324,7 +341,10 @@ -- {-# INLINE fractional #-} fractional :: (Fractional a) => Parser a- fractional = Parser LF.readDecimal+ fractional = Parser \inp ->+ case LF.readDecimal inp of+ Just (res, more) -> Success res more+ Nothing -> Failure ["fractional"] inp {-# INLINE w2c #-}
lib/Data/Text/Parser.hs view
@@ -6,14 +6,21 @@ -- Stability : unstable -- Portability : non-portable (ghc) ----- This module provides a parser for Unicode 'Text'.+-- This module provides a parser for unicode 'Text'. --+-- * If you\'d like to parse ASCII text, you might want to take a look at+-- "Data.ByteString.Parser.Char8". It is much, much faster.+--+-- * If you\'d like to parse byte sequences, look instead at the+-- "Data.ByteString.Parser".+-- module Data.Text.Parser ( Parser(..)+ , Result(..) , parseOnly - -- * Characters+ -- * Chars , char , notChar , anyChar@@ -29,8 +36,6 @@ , Data.Text.Parser.take , scan , runScanner- , inRange- , notInRange , Data.Text.Parser.takeWhile , takeWhile1 , takeTill@@ -57,6 +62,8 @@ , sepBy1 , wrap , match+ , label+ , extent -- * End Of Input , takeText@@ -87,94 +94,251 @@ import Data.Text.Unsafe as T import Data.Text.Encoding as T - import qualified Data.ByteString as BS- import qualified Data.ByteString.Parser.Char8 as BSP+ import Data.ByteString qualified as BS+ import Data.ByteString.Lex.Fractional qualified as LF+ import Data.ByteString.Lex.Integral qualified as LI import Snack.Combinators + -- |+ -- Result represents either success or some kind of failure.+ --+ -- You can find the problematic offset by subtracting length of the+ -- remainder from length of the original input.+ --+ data Result a+ = Success a {-# UNPACK #-} !Text+ -- ^ Parser successfully match the input.+ -- Produces the parsing result and the remainder of the input.++ | Failure [String] {-# UNPACK #-} !Text+ -- ^ Parser failed to match the input.+ -- Produces list of expected inputs and the corresponding remainder.++ | Error String {-# UNPACK #-} !Text {-# UNPACK #-} !Int+ -- ^ 'fail' was called somewhere during the parsing.+ -- Produces the reason and the remainder at the corresponding point+ -- with length of the problematic extent.++ deriving (Eq, Show)++ instance Functor Result where+ {-# INLINE fmap #-}+ fmap fn (Success res more) = Success (fn res) more+ fmap _ (Failure expected more) = Failure expected more+ fmap _ (Error reason more len) = Error reason more len+++ -- |+ -- Parser for 'Text' inputs.+ -- newtype Parser a = Parser- { runParser :: Text -> Maybe (a, Text)+ { runParser :: Text -> Result a+ -- ^ Run the parser on specified input. } instance Functor Parser where {-# INLINE fmap #-} fmap fn Parser{runParser} = Parser \inp ->- case runParser inp of- Just (res, rest) -> Just (fn res, rest)- Nothing -> Nothing+ fmap fn (runParser inp) instance Applicative Parser where {-# INLINE pure #-}- pure x = Parser \inp -> Just (x, inp)+ pure x = Parser \inp -> Success x inp {-# INLINE (<*>) #-} (Parser runFn) <*> (Parser runArg) = Parser \inp -> case runFn inp of- Nothing -> Nothing- Just (fn, rest) ->- case runArg rest of- Nothing -> Nothing- Just (x, rest') -> Just (fn x, rest')+ Success fn rest -> fmap fn (runArg rest)+ Failure expected more -> Failure expected more+ Error reason more len -> Error reason more len instance Alternative Parser where {-# INLINE empty #-}- empty = Parser \_ -> Nothing+ empty = Parser \inp -> Failure [] inp + -- |+ -- Tries the right branch only if the left brach produces Failure.+ -- Does not mask Error.+ -- {-# INLINE (<|>) #-} (Parser runLeft) <|> (Parser runRight) = Parser \inp -> case runLeft inp of- Just r -> Just r- Nothing -> runRight inp+ Success res more -> Success res more+ Error reason more len -> Error reason more len+ Failure expected more ->+ case runRight inp of+ Success res' more' -> Success res' more'+ Error reason' more' len' -> Error reason' more' len'+ Failure expected' more' ->+ -- Longer match (shorter remainder) wins.+ case length more `compare` length more' of+ LT -> Failure expected more+ EQ -> Failure (expected <> expected') more+ GT -> Failure expected' more' instance Monad Parser where {-# INLINE (>>=) #-} (Parser runLeft) >>= right = Parser \inp -> case runLeft inp of- Nothing -> Nothing- Just (x, more) -> runParser (right x) more+ Success res more -> runParser (right res) more+ Failure expected more -> Failure expected more+ Error reason more len -> Error reason more len instance MonadPlus Parser instance MonadFail Parser where+ -- |+ -- Fail the whole parser with given reason.+ --+ -- If you want the best error report possible, fail at the end of a+ -- relevant 'extent'.+ --+ -- For example, if you are parsing a mapping that is syntactically valid,+ -- but does not contain some mandatory keys, fail after parsing the whole+ -- mapping and make sure that the maaping parser and the 'fail' call are+ -- enclosed in an 'extent'.+ --+ -- That way, the error will indicate the extent remainder and length.+ -- {-# INLINE CONLIKE fail #-}- fail _ = mzero+ fail reason = Parser \inp -> Error reason inp 0 + -- |+ -- Accepts a single, matching character.+ --+ {-# INLINE CONLIKE char #-}+ char :: Char -> Parser Char+ char c = label (show c) $ satisfy (c ==)+++ -- |+ -- Accepts a single, differing character.+ --+ {-# INLINE CONLIKE notChar #-}+ notChar :: Char -> Parser Char+ notChar c = satisfy (c /=)+++ -- |+ -- Discards the remaining input and returns just the parse result.+ -- You might want to combine it with 'endOfInput' for the best effect.+ --+ -- Example:+ --+ -- @+ -- parseOnly (pContacts \<* endOfInput) bstr+ -- @+ -- {-# INLINE CONLIKE parseOnly #-} parseOnly :: Parser a -> Text -> Maybe a- parseOnly par = \inp -> fst <$> runParser par inp+ parseOnly par = \inp ->+ case runParser par inp of+ Success res _ -> Just res+ _otherwise -> Nothing + -- |+ -- Accepts a single character.+ --+ {-# INLINE anyChar #-}+ anyChar :: Parser Char+ anyChar = Parser \inp ->+ if null inp+ then Failure ["any char"] inp+ else Success (unsafeHead inp) (unsafeTail inp)+++ -- |+ -- Accepts a single character matching the predicate.+ -- {-# INLINE CONLIKE satisfy #-} satisfy :: (Char -> Bool) -> Parser Char satisfy isOk = Parser \inp -> if null inp- then Nothing+ then Failure ["more input"] inp else let c = unsafeHead inp in if isOk c- then Just (c, unsafeTail inp)- else Nothing+ then Success c (unsafeTail inp)+ else Failure [] inp + -- |+ -- Accepts a single unicode white space character.+ -- See 'isSpace' for details.+ --+ {-# INLINE space #-}+ space :: Parser Char+ space = label "space" $ satisfy isSpace+++ -- |+ -- Accepts multiple unicode white space characters.+ -- See 'isSpace' for details.+ --+ {-# INLINE skipSpace #-}+ skipSpace :: Parser ()+ skipSpace = void $ Data.Text.Parser.takeWhile isSpace+++ -- |+ -- Peeks ahead, but does not consume.+ --+ -- Be careful, peeking behind end of the input fails.+ -- You might want to check using 'atEnd' beforehand.+ --+ {-# INLINE peekChar #-}+ peekChar :: Parser Char+ peekChar = Parser \inp ->+ if null inp+ then Failure ["more input"] inp+ else Success (unsafeHead inp) inp+++ -- |+ -- Accepts a matching string.+ -- {-# INLINE CONLIKE string #-} string :: Text -> Parser Text string str = Parser \inp -> let (pfx, sfx) = splitAt (length str) inp in case pfx == str of- True -> Just (pfx, sfx)- False -> Nothing+ True -> Success pfx sfx+ False -> Failure [show pfx] inp + -- |+ -- Same as 'string', but case insensitive.+ --+ {-# INLINE CONLIKE stringCI #-}+ stringCI :: Text -> Parser Text+ stringCI str = Parser \inp ->+ let (pfx, sfx) = splitAt (length str) inp+ in case toCaseFold pfx == toCaseFold str of+ True -> Success pfx sfx+ False -> Failure [show pfx] inp+++ -- |+ -- Accepts given number of characters.+ -- Fails when not enough characters are available.+ -- {-# INLINE CONLIKE take #-} take :: Int -> Parser Text take n = Parser \inp -> if n > length inp- then Nothing- else Just (splitAt n inp)+ then Failure [show n <> " more characters"] inp+ else let (pfx, more) = splitAt n inp+ in Success pfx more + -- |+ -- Scans ahead statefully and then accepts whatever characters the scanner liked.+ -- Scanner returns 'Nothing' to mark end of the acceptable extent.+ -- {-# INLINE CONLIKE scan #-} scan :: s -> (s -> Char -> Maybe s) -> Parser Text scan state scanner = fst <$> runScanner state scanner@@ -189,111 +353,141 @@ where loop inp !st !n = case n >= lengthWord8 inp of- True -> Just ((inp, st), mempty)+ True -> Success (inp, st) mempty False -> case iter inp n of Iter c n' -> case scanner st c of- Nothing -> Just ((takeWord8 n inp, st), dropWord8 n inp)+ Nothing -> Success (takeWord8 n inp, st) (dropWord8 n inp) Just st' -> loop inp st' (n + n') + -- |+ -- Efficiently consume as long as the input characters match the predicate.+ -- An inverse of 'takeTill'.+ -- {-# INLINE CONLIKE takeWhile #-} takeWhile :: (Char -> Bool) -> Parser Text takeWhile test = takeTill (not . test) + -- |+ -- Like 'Data.Text.Parser.takeWhile', but requires at least a single character.+ -- {-# INLINE CONLIKE takeWhile1 #-} takeWhile1 :: (Char -> Bool) -> Parser Text- takeWhile1 test = provided (not . null) $- Data.Text.Parser.takeWhile test+ takeWhile1 test = Data.Text.Parser.takeWhile test `provided` (not . null) + -- |+ -- Efficiently consume until a character matching the predicate is found.+ -- An inverse of 'Data.Text.Parser.takeWhile'.+ -- {-# INLINE CONLIKE takeTill #-} takeTill :: (Char -> Bool) -> Parser Text takeTill test = Parser \inp -> let n = fromMaybe (length inp) $ findIndex test inp- in Just (splitAt n inp)+ (pfx, more) = splitAt n inp+ in Success pfx more + -- |+ -- Same as 'takeTill', but requires at least a single character.+ -- {-# INLINE CONLIKE takeTill1 #-} takeTill1 :: (Char -> Bool) -> Parser Text- takeTill1 test = provided (not . null) $- Data.Text.Parser.takeTill test+ takeTill1 test = Data.Text.Parser.takeTill test `provided` (not . null) + -- |+ -- Makes the parser not only return the result, but also the original+ -- matched extent.+ -- {-# INLINE CONLIKE match #-} match :: Parser a -> Parser (Text, a) match par = Parser \inp -> case runParser par inp of- Nothing -> Nothing- Just (x, more) ->+ Failure expected more -> Failure expected more+ Error reason more len -> Error reason more len+ Success res more -> let n = length more- in Just ((T.take n inp, x), more)+ in Success (T.take n inp, res) more + -- |+ -- Names an extent of the parser.+ --+ -- When the extent returns a Failure, details are discarded and replaced+ -- with the extent as a whole.+ --+ -- When the extent returns an Error, it is adjusted to cover the whole+ -- extent, but the reason is left intact.+ --+ -- You should strive to make labeled extents as small as possible,+ -- approximately of a typical token size. For example:+ --+ -- @+ -- pString = label \"string\" $ pStringContents \`wrap\` char \'\"\'+ -- @+ --+ {-# INLINE CONLIKE label #-}+ label :: String -> Parser a -> Parser a+ label lbl par = Parser \inp ->+ case runParser par inp of+ Success res more -> Success res more+ Failure _expected _more -> Failure [lbl] inp+ Error reason more len ->+ let len' = len + (length inp - length more)+ in Error reason inp len'+++ -- |+ -- Marks an unlabelel extent of the parser.+ --+ -- When the extent returns an Error, it is adjusted to cover the whole+ -- extent, but the reason is left intact.+ --+ {-# INLINE CONLIKE extent #-}+ extent :: Parser a -> Parser a+ extent par = Parser \inp ->+ case runParser par inp of+ Success res more -> Success res more+ Failure expected more -> Failure expected more+ Error reason more len ->+ let len' = len + (length inp - length more)+ in Error reason inp len'+++ -- |+ -- Accept whatever input remains.+ -- {-# INLINE takeText #-} takeText :: Parser Text- takeText = Parser \inp -> Just (inp, mempty)+ takeText = Parser \inp -> Success inp mempty + -- |+ -- Accepts end of input and fails if we are not there yet.+ -- {-# INLINE endOfInput #-} endOfInput :: Parser () endOfInput = Parser \case- inp | null inp -> Just ((), inp)- _otherwise -> Nothing+ inp | null inp -> Success () inp+ inp -> Failure ["end of input"] inp + -- |+ -- Returns whether we are at the end of the input yet.+ -- {-# INLINE atEnd #-} atEnd :: Parser Bool- atEnd = Parser \inp -> Just (null inp, inp)--- {-# INLINE CONLIKE char #-}- char :: Char -> Parser Char- char c = satisfy (c ==)--- {-# INLINE space #-}- space :: Parser Char- space = satisfy isSpace--- {-# INLINE skipSpace #-}- skipSpace :: Parser ()- skipSpace = void $ Data.Text.Parser.takeWhile isSpace--- {-# INLINE CONLIKE notChar #-}- notChar :: Char -> Parser Char- notChar c = satisfy (c /=)--- {-# INLINE anyChar #-}- anyChar :: Parser Char- anyChar = Parser \inp ->- if null inp- then Nothing- else Just (unsafeHead inp, unsafeTail inp)--- {-# INLINE peekChar #-}- peekChar :: Parser Char- peekChar = Parser \inp ->- if null inp- then Nothing- else Just (unsafeHead inp, inp)--- {-# INLINE CONLIKE stringCI #-}- stringCI :: Text -> Parser Text- stringCI str = Parser \inp ->- let (pfx, sfx) = splitAt (length str) inp- in case toCaseFold pfx == toCaseFold str of- True -> Just (pfx, sfx)- False -> Nothing+ atEnd = Parser \inp -> Success (null inp) inp + -- |+ -- Accepts optional @\'+\'@ or @\'-\'@ character and then applies it to+ -- the following parser result.+ -- {-# INLINE signed #-} signed :: (Num a) => Parser a -> Parser a signed runNumber = (char '-' *> fmap negate runNumber)@@ -302,34 +496,64 @@ {-# INLINE CONLIKE unsafeWithUtf8 #-}- unsafeWithUtf8 :: BSP.Parser a -> Parser a- unsafeWithUtf8 bspar = Parser \inp ->+ unsafeWithUtf8 :: (BS.ByteString -> Maybe (a, BS.ByteString))+ -> Text -> Maybe (a, Text)+ unsafeWithUtf8 bspar = \inp -> let bstr = encodeUtf8 inp- in case BSP.runParser bspar bstr of+ in case bspar bstr of Nothing -> Nothing Just (x, more) ->+ -- This should be perfectly safe as long as the embedded+ -- parser returns the actual remaining input and not some+ -- random chunk of bytes. let n = lengthWord8 inp - BS.length more in Just (x, dropWord8 n inp) + -- |+ -- Accepts an integral number in the decimal format.+ -- {-# INLINE decimal #-} decimal :: (Integral a) => Parser a- decimal = unsafeWithUtf8 BSP.decimal+ decimal = Parser \inp ->+ case unsafeWithUtf8 LI.readDecimal inp of+ Just (res, more) -> Success res more+ Nothing -> Failure ["decimal"] inp + -- |+ -- Accepts an integral number in the hexadecimal format in either case.+ -- Does not look for @0x@ or similar prefixes.+ -- {-# INLINE hexadecimal #-} hexadecimal :: (Integral a) => Parser a- hexadecimal = unsafeWithUtf8 BSP.hexadecimal+ hexadecimal = Parser \inp ->+ case unsafeWithUtf8 LI.readHexadecimal inp of+ Just (res, more) -> Success res more+ Nothing -> Failure ["hexadecimal"] inp + -- |+ -- Accepts an integral number in the octal format.+ -- {-# INLINE octal #-} octal :: (Integral a) => Parser a- octal = unsafeWithUtf8 BSP.octal+ octal = Parser \inp ->+ case unsafeWithUtf8 LI.readOctal inp of+ Just (res, more) -> Success res more+ Nothing -> Failure ["octal"] inp + -- |+ -- Accepts a fractional number as a decimal optinally followed by a colon+ -- and the fractional part. Does not support exponentiation.+ -- {-# INLINE fractional #-} fractional :: (Fractional a) => Parser a- fractional = unsafeWithUtf8 BSP.fractional+ fractional = Parser \inp ->+ case unsafeWithUtf8 LF.readDecimal inp of+ Just (res, more) -> Success res more+ Nothing -> Failure ["fractional"] inp -- vim:set ft=haskell sw=2 ts=2 et:
lib/Data/Text/Parser.hs-boot view
@@ -3,9 +3,16 @@ import Control.Applicative import Data.Text (Text) + data Result a+ = Success a {-# UNPACK #-} !Text+ | Failure [String] {-# UNPACK #-} !Text+ | Error String {-# UNPACK #-} !Text {-# UNPACK #-} !Int++ instance Functor Result where+ newtype Parser a = Parser- { runParser :: Text -> Maybe (a, Text)+ { runParser :: Text -> Result a } instance Functor Parser
lib/Snack/Combinators.hs view
@@ -36,14 +36,14 @@ -- Example: -- -- @- -- pInput = takeWhile isLetter `provided` (odd . length)+ -- pInput = takeWhile isLetter \`provided\` (odd . length) -- @ -- {-# INLINE CONLIKE provided #-}- {-# SPECIALIZE provided :: (a -> Bool) -> BSP.Parser a -> BSP.Parser a #-}- {-# SPECIALIZE provided :: (a -> Bool) -> TP.Parser a -> TP.Parser a #-}- provided :: (Alternative m, Monad m) => (a -> Bool) -> m a -> m a- provided test par = do+ {-# SPECIALIZE provided :: BSP.Parser a -> (a -> Bool) -> BSP.Parser a #-}+ {-# SPECIALIZE provided :: TP.Parser a -> (a -> Bool) -> TP.Parser a #-}+ provided :: (Alternative m, Monad m) => m a -> (a -> Bool) -> m a+ provided par test = do x <- par if test x then pure x@@ -51,7 +51,7 @@ -- |- -- Tries various parsers, one by one. Alias for 'asum'.+ -- Tries various parsers, one by one. -- -- Example: --@@ -67,7 +67,11 @@ {-# SPECIALIZE choice :: [BSP.Parser a] -> BSP.Parser a #-} {-# SPECIALIZE choice :: [TP.Parser a] -> TP.Parser a #-} choice :: (Alternative f) => [f a] -> f a+#if MIN_VERSION_base(4, 16, 0) choice = asum+#else+ choice = foldr (<|>) empty+#endif -- |@@ -137,7 +141,7 @@ -- Example: -- -- @- -- pBodyLines = pLine `manyTill` pEnd+ -- pBodyLines = pLine \`manyTill\` pEnd -- where pLine = takeTill (== '\n') -- pEnd = string "\n.\n" -- @@@ -183,7 +187,7 @@ -- Example: -- -- @- -- pToken = takeWhile1 (inClass "A-Za-z0-9_") `wrap` takeWhile isSpace+ -- pToken = takeWhile1 (inClass "A-Za-z0-9_") \`wrap\` takeWhile isSpace -- @ -- {-# INLINE CONLIKE wrap #-}
snack.cabal view
@@ -1,11 +1,12 @@ cabal-version: 3.0 name: snack-version: 0.1.0.0-license: MIT+version: 0.2.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 homepage: https://github.com/mordae/snack#readme bug-reports: https://github.com/mordae/snack/issues synopsis: Strict ByteString Parser Combinator@@ -28,15 +29,18 @@ hs-source-dirs: lib other-modules: Snack.Combinators- default-language: GHC2021- default-extensions: BlockArguments LambdaCase+ default-language: Haskell2010+ default-extensions:+ BlockArguments LambdaCase ImportQualifiedPost BangPatterns+ NamedFieldPuns CPP+ ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wunused-packages -Wincomplete-record-updates -Widentities -Wredundant-constraints build-depends: base >=4.13 && <5,- bytestring >=0.11,+ bytestring >=0.10.12, bytestring-lexing >=0.5, text >=2.0 @@ -45,7 +49,9 @@ main-is: Bench.hs hs-source-dirs: bench default-language: Haskell2010- default-extensions: BlockArguments LambdaCase OverloadedStrings+ default-extensions:+ BlockArguments LambdaCase OverloadedStrings ImportQualifiedPost+ ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wunused-packages -Wincomplete-record-updates -Widentities -Wredundant-constraints@@ -53,7 +59,7 @@ build-depends: attoparsec >=0.13, base >=4 && <5,- bytestring >=0.11,+ bytestring >=0.10.12, criterion, snack, string-conversions,