megaparsec 9.1.0 → 9.2.0
raw patch · 7 files changed
+268/−12 lines, 7 filesdep ~text
Dependency ranges changed: text
Files
- CHANGELOG.md +5/−0
- Text/Megaparsec/Byte/Binary.hs +192/−0
- Text/Megaparsec/Class.hs +7/−7
- Text/Megaparsec/Error.hs-boot +1/−0
- bench/memory/Main.hs +28/−1
- bench/speed/Main.hs +29/−1
- megaparsec.cabal +6/−3
CHANGELOG.md view
@@ -1,3 +1,8 @@+## Megaparsec 9.2.0++* Added parsers for binary representations (little/big endian) of numbers in+ `Text.Megaparsec.Byte.Binary`.+ ## Megaparsec 9.1.0 * Added `dbg'` in `Text.Megaparsec.Debug` for debugging parsers that have
+ Text/Megaparsec/Byte/Binary.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module : Text.Megaparsec.Byte.Binary+-- Copyright : © 2021–present Megaparsec contributors+-- License : FreeBSD+--+-- Maintainer : Mark Karpov <markkarpov92@gmail.com>+-- Stability : experimental+-- Portability : portable+--+-- Binary-format number parsers.+--+-- @since 9.2.0+module Text.Megaparsec.Byte.Binary+ ( -- * Generic parsers+ BinaryChunk (..),+ anyLE,+ anyBE,++ -- * Parsing unsigned values+ word8,+ word16le,+ word16be,+ word32le,+ word32be,+ word64le,+ word64be,++ -- * Parsing signed values+ int8,+ int16le,+ int16be,+ int32le,+ int32be,+ int64le,+ int64be,+ )+where++import Data.Bits+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Int+import Data.Word+import Text.Megaparsec++-- | Data types that can be converted to little- or big- endian numbers.+class BinaryChunk chunk where+ convertChunkBE :: (Bits a, Num a) => chunk -> a+ convertChunkLE :: (Bits a, Num a) => chunk -> a++instance BinaryChunk B.ByteString where+ convertChunkBE = B.foldl' go 0+ where+ go acc byte = (acc `unsafeShiftL` 8) .|. fromIntegral byte+ convertChunkLE = B.foldl' go 0+ where+ go acc byte = (acc .|. fromIntegral byte) `rotateR` 8++instance BinaryChunk BL.ByteString where+ convertChunkBE = BL.foldl' go 0+ where+ go acc byte = (acc `unsafeShiftL` 8) .|. fromIntegral byte+ convertChunkLE = BL.foldl' go 0+ where+ go acc byte = (acc .|. fromIntegral byte) `rotateR` 8++----------------------------------------------------------------------------+-- Generic parsers++-- | Parse a little-endian number.+--+-- You may wish to call this with a visible type application:+--+-- > number <- anyLE (Just "little-endian 32 bit word") @Word32+anyLE ::+ forall a e s m.+ (MonadParsec e s m, FiniteBits a, Num a, BinaryChunk (Tokens s)) =>+ -- | Label, if any+ Maybe String ->+ m a+anyLE mlabel = convertChunkLE <$> takeP mlabel (finiteByteSize @a)+{-# INLINE anyLE #-}++-- | Parse a big-endian number.+--+-- You may wish to call this with a visible type application:+--+-- > number <- anyBE (Just "big-endian 32 bit word") @Word32+anyBE ::+ forall a e s m.+ (MonadParsec e s m, FiniteBits a, Num a, BinaryChunk (Tokens s)) =>+ -- | Label, if any+ Maybe String ->+ m a+anyBE mlabel = convertChunkBE <$> takeP mlabel (finiteByteSize @a)+{-# INLINE anyBE #-}++--------------------------------------------------------------------------------+-- Parsing unsigned values++-- | Parse a 'Word8'.+word8 :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Word8+word8 = anyBE (Just "8 bit word")+{-# INLINE word8 #-}++-- | Parse a little-endian 'Word16'.+word16le :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Word16+word16le = anyLE (Just "little-endian 16 bit word")+{-# INLINE word16le #-}++-- | Parse a big-endian 'Word16'.+word16be :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Word16+word16be = anyBE (Just "big-endian 16 bit word")+{-# INLINE word16be #-}++-- | Parse a little-endian 'Word32'.+word32le :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Word32+word32le = anyLE (Just "little-endian 32 bit word")+{-# INLINE word32le #-}++-- | Parse a big-endian 'Word32'.+word32be :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Word32+word32be = anyBE (Just "big-endian 32 bit word")+{-# INLINE word32be #-}++-- | Parse a little-endian 'Word64'.+word64le :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Word64+word64le = anyLE (Just "little-endian 64 word")+{-# INLINE word64le #-}++-- | Parse a big-endian 'Word64'.+word64be :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Word64+word64be = anyBE (Just "big-endian 64 word")+{-# INLINE word64be #-}++----------------------------------------------------------------------------+-- Parsing signed values++-- | Parse a 'Int8'.+int8 :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Int8+int8 = anyBE (Just "8 bit int")+{-# INLINE int8 #-}++-- | Parse a little-endian 'Int16'.+int16le :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Int16+int16le = anyLE (Just "little-endian 16 bit int")+{-# INLINE int16le #-}++-- | Parse a big-endian 'Int16'.+int16be :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Int16+int16be = anyBE (Just "big-endian 16 bit int")+{-# INLINE int16be #-}++-- | Parse a little-endian 'Int32'.+int32le :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Int32+int32le = anyLE (Just "little-endian 32 bit int")+{-# INLINE int32le #-}++-- | Parse a big-endian 'Int32'.+int32be :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Int32+int32be = anyBE (Just "big-endian 32 bit int")+{-# INLINE int32be #-}++-- | Parse a little-endian 'Int64'.+int64le :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Int64+int64le = anyLE (Just "little-endian 64 int")+{-# INLINE int64le #-}++-- | Parse a big-endian 'Int64'.+int64be :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Int64+int64be = anyBE (Just "big-endian 64 int")+{-# INLINE int64be #-}++--------------------------------------------------------------------------------+-- Helpers++-- | Return the number of bytes in the argument.+--+-- Performs ceiling division, so byte-unaligned types (bitsize not a+-- multiple of 8) should work, but further usage is not tested.+finiteByteSize :: forall a. FiniteBits a => Int+finiteByteSize = finiteBitSize @a undefined `ceilDiv` 8+ where+ ceilDiv x y = (x + y - 1) `div` y+{-# INLINE finiteByteSize #-}
Text/Megaparsec/Class.hs view
@@ -153,14 +153,14 @@ -- | This parser only succeeds at the end of input. eof :: m () - -- | The parser @'token' test expected@ accepts a token @t@ with result- -- @x@ when the function @test t@ returns @'Just' x@. @expected@ specifies- -- the collection of expected items to report in error messages.+ -- | The parser @'token' test expected@ accepts tokens for which the+ -- matching function @test@ returns 'Just' results. If 'Nothing' is+ -- returned the @expected@ set is used to report the items that were+ -- expected. --- -- This is the most primitive combinator for accepting tokens. For- -- example, the 'Text.Megaparsec.satisfy' parser is implemented as:+ -- For example, the 'Text.Megaparsec.satisfy' parser is implemented as: --- -- > satisfy f = token testToken E.empty+ -- > satisfy f = token testToken Set.empty -- > where -- > testToken x = if f x then Just x else Nothing --@@ -169,7 +169,7 @@ token :: -- | Matching function for the token to parse (Token s -> Maybe a) ->- -- | Expected items (in case of an error)+ -- | Used in the error message to mention the items that were expected Set (ErrorItem (Token s)) -> m a
Text/Megaparsec/Error.hs-boot view
@@ -1,4 +1,5 @@ {-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE Safe #-} module Text.Megaparsec.Error ( ParseError,
bench/memory/Main.hs view
@@ -5,6 +5,8 @@ import Control.DeepSeq import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString as B import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import qualified Data.Set as E@@ -12,13 +14,17 @@ import qualified Data.Text as T import Data.Void import Text.Megaparsec+import qualified Text.Megaparsec.Byte.Binary as Binary import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L import Weigh --- | The type of parser that consumes 'String's.+-- | The type of parser that consumes 'Text'. type Parser = Parsec Void Text +-- | The type of parser that consumes 'ByteString'.+type ParserBs = Parsec Void ByteString+ main :: IO () main = mainWith $ do setColumns [Case, Allocated, GCs, Max]@@ -48,6 +54,8 @@ bparser "octal" mkInt (const (L.octal :: Parser Integer)) bparser "hexadecimal" mkInt (const (L.hexadecimal :: Parser Integer)) bparser "scientific" mkInt (const L.scientific)+ bparserBs "word32be" many0x33 (const $ many Binary.word32be)+ bparserBs "word32le" many0x33 (const $ many Binary.word32le) forM_ stdSeries $ \n -> bbundle "single error" n [n]@@ -81,6 +89,21 @@ p' (s, n) = parse (p (s, n)) "" s func (name ++ "-" ++ show i) p' arg +-- | Perform a series of measurements with the same parser.+bparserBs ::+ NFData a =>+ -- | Name of the benchmark group+ String ->+ -- | How to construct input+ (Int -> ByteString) ->+ -- | The parser receiving its future input+ ((ByteString, Int) -> ParserBs a) ->+ Weigh ()+bparserBs name f p = forM_ stdSeries $ \i -> do+ let arg = (f i, i)+ p' (s, n) = parse (p (s, n)) "" s+ func (name ++ "-" ++ show i) p' arg+ -- | Benchmark the 'errorBundlePretty' function. bbundle :: -- | Name of the benchmark@@ -177,6 +200,10 @@ -- | Generate that many \'a\' characters. manyAs :: Int -> Text manyAs n = T.replicate n "a"++-- | Like 'manyAs' but the result is a 'ByteString'.+many0x33 :: Int -> ByteString+many0x33 n = B.replicate n 0x33 -- | Like 'manyAs', but interspersed with \'b\'s. manyAbs :: Int -> Text
bench/speed/Main.hs view
@@ -5,6 +5,8 @@ import Control.DeepSeq import Criterion.Main+import Data.ByteString (ByteString)+import qualified Data.ByteString as B import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import qualified Data.Set as E@@ -12,12 +14,16 @@ import qualified Data.Text as T import Data.Void import Text.Megaparsec+import qualified Text.Megaparsec.Byte.Binary as Binary import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L --- | The type of parser that consumes 'String's.+-- | The type of parser that consumes 'Text'. type Parser = Parsec Void Text +-- | The type of parser that consumes 'ByteString'.+type ParserBs = Parsec Void ByteString+ main :: IO () main = defaultMain@@ -47,6 +53,8 @@ bparser "octal" mkInt (const (L.octal :: Parser Integer)), bparser "hexadecimal" mkInt (const (L.hexadecimal :: Parser Integer)), bparser "scientific" mkInt (const L.scientific),+ bparserBs "word32be" many0x33 (const $ many Binary.word32be),+ bparserBs "word32le" many0x33 (const $ many Binary.word32le), bgroup "" [bbundle "single error" n [n] | n <- stdSeries], bbundle "2 errors" 1000 [1, 1000], bbundle "4 errors" 1000 [1, 500, 1000],@@ -77,6 +85,22 @@ bs n = env (return (f n, n)) (bench (show n) . nf p') p' (s, n) = parse (p (s, n)) "" s +-- | Perform a series to measurements with the same parser.+bparserBs ::+ NFData a =>+ -- | Name of the benchmark group+ String ->+ -- | How to construct input+ (Int -> ByteString) ->+ -- | The parser receiving its future input+ ((ByteString, Int) -> ParserBs a) ->+ -- | The benchmark+ Benchmark+bparserBs name f p = bgroup name (bs <$> stdSeries)+ where+ bs n = env (return (f n, n)) (bench (show n) . nf p')+ p' (s, n) = parse (p (s, n)) "" s+ -- | Benchmark the 'errorBundlePretty' function. bbundle :: -- | Name of the benchmark@@ -170,6 +194,10 @@ -- | Generate that many \'a\' characters. manyAs :: Int -> Text manyAs n = T.replicate n "a"++-- | Like 'manyAs' but the result is a 'ByteString'.+many0x33 :: Int -> ByteString+many0x33 n = B.replicate n 0x33 -- | Like 'manyAs', but interspersed with \'b\'s. manyAbs :: Int -> Text
megaparsec.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: megaparsec-version: 9.1.0+version: 9.2.0 license: BSD2 license-file: LICENSE.md maintainer: Mark Karpov <markkarpov92@gmail.com>@@ -37,6 +37,7 @@ exposed-modules: Text.Megaparsec Text.Megaparsec.Byte+ Text.Megaparsec.Byte.Binary Text.Megaparsec.Byte.Lexer Text.Megaparsec.Char Text.Megaparsec.Char.Lexer@@ -62,9 +63,9 @@ deepseq >=1.3 && <1.5, mtl >=2.2.2 && <3.0, parser-combinators >=1.0 && <2.0,- scientific >=0.3.1 && <0.4,+ scientific >=0.3.7 && <0.4, text >=0.2 && <1.3,- transformers >=0.4 && <0.6+ transformers >=0.4 && <0.7 if flag(dev) ghc-options: -O0 -Wall -Werror@@ -84,6 +85,7 @@ default-language: Haskell2010 build-depends: base >=4.13 && <5.0,+ bytestring >=0.2 && <0.12, containers >=0.5 && <0.7, criterion >=0.6.2.1 && <1.6, deepseq >=1.3 && <1.5,@@ -103,6 +105,7 @@ default-language: Haskell2010 build-depends: base >=4.13 && <5.0,+ bytestring >=0.2 && <0.12, containers >=0.5 && <0.7, deepseq >=1.3 && <1.5, megaparsec,