binary-parser 0.5.2 → 0.5.5

raw patch · 4 files changed

+278/−23 lines, 4 filesdep +basedep +binary-parserdep +mtldep −successdep ~base-preludedep ~transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: base, binary-parser, mtl, quickcheck-instances, rerebase, tasty, tasty-hunit, tasty-quickcheck

Dependencies removed: success

Dependency ranges changed: base-prelude, transformers

API changes (from Hackage documentation)

Files

• binary-parser.cabal +28/−9
• library/BinaryParser.hs +186/−12
• library/BinaryParser/Prelude.hs +15/−2
• tests/Main.hs +49/−0

@@ -1,15 +1,15 @@ name:   binary-parser version:-  0.5.2+  0.5.5 synopsis:   A highly-efficient but limited parser API specialised for bytestrings category:   Parser, Binary homepage:-  https://github.com/nikita-volkov/binary-parser +  https://github.com/nikita-volkov/binary-parser bug-reports:-  https://github.com/nikita-volkov/binary-parser/issues +  https://github.com/nikita-volkov/binary-parser/issues author:   Nikita Volkov <nikita.y.volkov@mail.ru> maintainer:@@ -25,19 +25,17 @@ cabal-version:   >=1.10 - source-repository head   type:     git   location:     git://github.com/nikita-volkov/binary-parser.git - library   hs-source-dirs:     library   default-extensions:-    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples   default-language:     Haskell2010   other-modules:@@ -46,10 +44,31 @@     BinaryParser   build-depends:     -- data:-    success >= 0.2 && < 0.3,     bytestring >= 0.10 && < 0.11,     text >= 1 && < 2,     -- general:-    transformers >= 0.3 && < 0.6,-    base-prelude < 2+    mtl == 2.*,+    transformers >= 0.4 && < 0.6,+    base-prelude < 2,+    base >= 4.7 && < 5 +test-suite tests+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    tests+  main-is:+    Main.hs+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  build-depends:+    binary-parser,+    -- testing:+    tasty == 0.11.*,+    tasty-quickcheck == 0.8.*,+    tasty-hunit == 0.9.*,+    quickcheck-instances >= 0.3.11 && < 0.4,+    -- general:+    rerebase == 1.*

@@ -1,22 +1,37 @@+{-# LANGUAGE CPP #-} module BinaryParser (   BinaryParser,   run,   failure,   byte,+  matchingByte,   bytesOfSize,+  bytesWhile,   unitOfSize,   unitOfBytes,+  unitWhile,   remainders,+  fold,   endOfInput,   sized,+  -- * Extras+  storableOfSize,+  beWord16,+  leWord16,+  beWord32,+  leWord32,+  beWord64,+  leWord64,+  asciiIntegral, ) where -import BinaryParser.Prelude+import BinaryParser.Prelude hiding (fold) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Unsafe as ByteString-import qualified Success.Pure as Success+import qualified Data.ByteString.Internal as A+import qualified BinaryParser.Prelude as B   -- |@@ -28,22 +43,22 @@ -- Does not generate fancy error-messages, -- which contributes to its efficiency. newtype BinaryParser a =-  BinaryParser ( StateT ByteString ( Success.Success Text ) a )-  deriving ( Functor , Applicative , Alternative , Monad , MonadPlus )+  BinaryParser ( StateT ByteString ( Except Text ) a )+  deriving ( Functor , Applicative , Alternative , Monad , MonadPlus , MonadError Text )  -- | -- Apply a parser to bytes. {-# INLINE run #-} run :: BinaryParser a -> ByteString -> Either Text a run (BinaryParser parser) input =-  mapLeft fold (Success.asEither (evalStateT parser input))+  runExcept (evalStateT parser input)  -- | -- Fail with a message. {-# INLINE failure #-} failure :: Text -> BinaryParser a failure text =-  BinaryParser (lift (Success.failure text))+  BinaryParser (lift (throwE text))  -- | -- Consume a single byte.@@ -52,10 +67,36 @@ byte =   BinaryParser $ StateT $ \remainders ->     if ByteString.null remainders-      then Success.failure "End of input"+      then throwE "End of input"       else pure (ByteString.unsafeHead remainders, ByteString.unsafeDrop 1 remainders)  -- |+-- Consume a single byte, which satisfies the predicate.+{-# INLINE satisfyingByte #-}+satisfyingByte :: (Word8 -> Bool) -> BinaryParser Word8+satisfyingByte predicate =+  BinaryParser $ StateT $ \remainders ->+    case ByteString.uncons remainders of+      Nothing -> throwE "End of input"+      Just (head, tail) ->+        if predicate head+          then pure (head, tail)+          else throwE "Byte doesn't satisfy a predicate"++-- |+-- Consume a single byte, which satisfies the predicate.+{-# INLINE matchingByte #-}+matchingByte :: (Word8 -> Either Text a) -> BinaryParser a+matchingByte matcher =+  BinaryParser $ StateT $ \remainders ->+    case ByteString.uncons remainders of+      Nothing -> throwE "End of input"+      Just (head, tail) ->+        case matcher head of+          Right result -> pure (result, tail)+          Left error -> throwE error++-- | -- Consume an amount of bytes. {-# INLINE bytesOfSize #-} bytesOfSize :: Int -> BinaryParser ByteString@@ -63,9 +104,17 @@   BinaryParser $ StateT $ \remainders ->     if ByteString.length remainders >= size       then return (ByteString.unsafeTake size remainders, ByteString.unsafeDrop size remainders)-      else Success.failure "End of input"+      else throwE "End of input"  -- |+-- Consume multiple bytes, which satisfy the predicate.+{-# INLINE bytesWhile #-}+bytesWhile :: (Word8 -> Bool) -> BinaryParser ByteString+bytesWhile predicate =+  BinaryParser $ StateT $ \remainders ->+    pure (ByteString.span predicate remainders)++-- | -- Skip an amount of bytes. {-# INLINE unitOfSize #-} unitOfSize :: Int -> BinaryParser ()@@ -73,7 +122,7 @@   BinaryParser $ StateT $ \remainders ->     if ByteString.length remainders >= size       then return ((), ByteString.unsafeDrop size remainders)-      else Success.failure "End of input"+      else throwE "End of input"  -- | -- Skip specific bytes, while failing if they don't match.@@ -83,9 +132,17 @@   BinaryParser $ StateT $ \remainders ->     if ByteString.isPrefixOf bytes remainders       then return ((), ByteString.unsafeDrop (ByteString.length bytes) remainders)-      else Success.failure "Bytes don't match"+      else throwE "Bytes don't match"  -- |+-- Skip bytes, which satisfy the predicate.+{-# INLINE unitWhile #-}+unitWhile :: (Word8 -> Bool) -> BinaryParser ()+unitWhile predicate =+  BinaryParser $ StateT $ \remainders ->+    pure ((), ByteString.dropWhile predicate remainders)++-- | -- Consume all the remaining bytes. {-# INLINE remainders #-} remainders :: BinaryParser ByteString@@ -99,9 +156,26 @@ endOfInput =   BinaryParser $ StateT $ \case     "" -> return ((), ByteString.empty)-    _ -> Success.failure "Not the end of input"+    _ -> throwE "Not the end of input"  -- |+-- Left-fold the bytes, terminating before the byte,+-- on which the step function returns Nothing.+{-# INLINE fold #-}+fold :: (a -> Word8 -> Maybe a) -> a -> BinaryParser a+fold step init =+  BinaryParser $ StateT $ return . loop init+  where+    loop !accumulator remainders =+      case ByteString.uncons remainders of+        Nothing -> (accumulator, remainders)+        Just (head, tail) ->+          case step accumulator head of+            Just newAccumulator ->+              loop newAccumulator tail+            Nothing -> (accumulator, remainders)++-- | -- Run a subparser passing it a chunk of the current input of the specified size. {-# INLINE sized #-} sized :: Int -> BinaryParser a -> BinaryParser a@@ -111,4 +185,104 @@       then          evalStateT stateT (ByteString.unsafeTake size remainders) &         fmap (\result -> (result, ByteString.unsafeDrop size remainders))-      else Success.failure "End of input"+      else throwE "End of input"++-- |+-- Storable value of the given amount of bytes.+{-# INLINE storableOfSize #-}+storableOfSize :: Storable a => Int -> BinaryParser a+storableOfSize size =+  BinaryParser $ StateT $ \(A.PS payloadFP offset length) ->+    if length >= size+      then let result =+                 unsafeDupablePerformIO $ withForeignPtr payloadFP $ \ptr -> peekByteOff (castPtr ptr) offset+               newRemainder =+                 A.PS payloadFP (offset + size) (length - size)+               in return (result, newRemainder)+      else throwE "End of input" ++-- | Big-endian word of 2 bytes.+{-# INLINE beWord16 #-}+beWord16 :: BinaryParser Word16+#ifdef WORDS_BIGENDIAN+beWord16 =+  storableOfSize 2+#else+beWord16 =+  byteSwap16 <$> storableOfSize 2+#endif++-- | Little-endian word of 2 bytes.+{-# INLINE leWord16 #-}+leWord16 :: BinaryParser Word16+#ifdef WORDS_BIGENDIAN+leWord16 =+  byteSwap16 <$> storableOfSize 2+#else+leWord16 =+  storableOfSize 2+#endif++-- | Big-endian word of 4 bytes.+{-# INLINE beWord32 #-}+beWord32 :: BinaryParser Word32+#ifdef WORDS_BIGENDIAN+beWord32 =+  storableOfSize 4+#else+beWord32 =+  byteSwap32 <$> storableOfSize 4+#endif++-- | Little-endian word of 4 bytes.+{-# INLINE leWord32 #-}+leWord32 :: BinaryParser Word32+#ifdef WORDS_BIGENDIAN+leWord32 =+  byteSwap32 <$> storableOfSize 4+#else+leWord32 =+  storableOfSize 4+#endif++-- | Big-endian word of 8 bytes.+{-# INLINE beWord64 #-}+beWord64 :: BinaryParser Word64+#ifdef WORDS_BIGENDIAN+beWord64 =+  storableOfSize 8+#else+beWord64 =+  byteSwap64 <$> storableOfSize 8+#endif++-- | Little-endian word of 8 bytes.+{-# INLINE leWord64 #-}+leWord64 :: BinaryParser Word64+#ifdef WORDS_BIGENDIAN+leWord64 =+  byteSwap64 <$> storableOfSize 8+#else+leWord64 =+  storableOfSize 8+#endif++-- |+-- Integral number encoded in ASCII.+{-# INLINE asciiIntegral #-}+asciiIntegral :: Integral a => BinaryParser a+asciiIntegral = +  do+    firstDigit <- matchingByte byteDigit+    fold step firstDigit+  where+    byteDigit byte =+      case byte - 48 of+        subtracted ->+          if subtracted <= 9+            then Right (fromIntegral subtracted)+            else Left "Not an ASCII decimal byte"+    step state byte =+      case byteDigit byte of+        Right digit -> Just (state * 10 + digit)+        _ -> Nothing

@@ -13,9 +13,22 @@  -- transformers --------------------------import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch)-import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch)+import Control.Monad.IO.Class as Exports import Control.Monad.Trans.Class as Exports+import Control.Monad.Trans.Cont as Exports hiding (shift, callCC)+import Control.Monad.Trans.Except as Exports (ExceptT(ExceptT), Except, except, runExcept, runExceptT, mapExcept, mapExceptT, withExcept, withExceptT, throwE, catchE)+import Control.Monad.Trans.Maybe as Exports+import Control.Monad.Trans.Reader as Exports (Reader, runReader, mapReader, withReader, ReaderT(ReaderT), runReaderT, mapReaderT, withReaderT)+import Control.Monad.Trans.State.Strict as Exports (State, runState, evalState, execState, mapState, withState, StateT(StateT), runStateT, evalStateT, execStateT, mapStateT, withStateT)+import Control.Monad.Trans.Writer.Strict as Exports (Writer, runWriter, execWriter, mapWriter, WriterT(..), execWriterT, mapWriterT)++-- mtl+-------------------------+import Control.Monad.Cont.Class as Exports+import Control.Monad.Error.Class as Exports hiding (Error(..))+import Control.Monad.Reader.Class as Exports+import Control.Monad.State.Class as Exports+import Control.Monad.Writer.Class as Exports  -- bytestring -------------------------

@@ -0,0 +1,49 @@+module Main where++import Prelude+import Test.QuickCheck.Instances+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import qualified Data.ByteString as A+import qualified Data.ByteString.Builder as C+import qualified Data.ByteString.Lazy as D+import qualified BinaryParser as B+++main =+  defaultMain $+  testGroup "All tests" $+  [+    builderIsomporhismProperty "byte" B.byte C.word8+    ,+    builderIsomporhismProperty "beWord16" B.beWord16 C.word16BE+    ,+    builderIsomporhismProperty "beWord32" B.beWord32 C.word32BE+    ,+    expectedResultTest "byte consumes" ((,) <$> B.byte <*> B.beWord32) (49, 4) "1\NUL\NUL\NUL\EOT"+    ,+    expectedResultTest "Applicative composition" ((,) <$> B.beWord16 <*> B.beWord16) (1, 2) "\NUL\SOH\NUL\STX"+    ,+    let parser =+          do+            a <- B.beWord16+            b <- B.beWord16+            return (a, b)+        in expectedResultTest "Monadic composition" parser (1, 2) "\NUL\SOH\NUL\STX"+  ]++builderIsomporhismProperty details parser valueToBuilder =+  testProperty name $ \value ->+  B.run parser (D.toStrict (C.toLazyByteString (valueToBuilder value))) ===+  Right value+  where+    name =+      "builderIsomporhismProperty: " <> details++expectedResultTest details parser expectedValue input =+  testCase name $ do+    assertEqual "" (Right expectedValue) (B.run parser input)+  where+    name =+      "expectedResultTest: " <> details