ptr 0.15.3 → 0.15.4
raw patch · 4 files changed
+207/−14 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- library/Ptr/Parse.hs +22/−10
- library/Ptr/ParseUnbound.hs +164/−0
- library/Ptr/Peek.hs +18/−2
- ptr.cabal +3/−2
library/Ptr/Parse.hs view
@@ -19,9 +19,9 @@ Parse (\ availableAmount ptr _ _ succeed -> succeed x availableAmount ptr) {-# INLINE (<*>) #-} (<*>) (Parse left) (Parse right) =- Parse $ \ availableAmount ptr failWithEOI failWithMessage succeed ->- left availableAmount ptr failWithEOI failWithMessage $ \ leftOutput leftAvailableAmount leftPtr ->- right leftAvailableAmount leftPtr failWithEOI failWithMessage $ \ rightOutput rightAvailableAmount rightPtr ->+ Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->+ left availableAmount ptr failWithEOI failWithMessage $ \ leftOutput !leftAvailableAmount !leftPtr ->+ right leftAvailableAmount leftPtr failWithEOI failWithMessage $ \ rightOutput !rightAvailableAmount !rightPtr -> succeed (leftOutput rightOutput) rightAvailableAmount rightPtr instance Alternative Parse where@@ -29,7 +29,7 @@ Parse (\ _ _ failWithEOI _ _ -> failWithEOI 0) {-# INLINE (<|>) #-} (<|>) (Parse left) (Parse right) =- Parse $ \ availableAmount ptr failWithEOI failWithMessage succeed ->+ Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed -> left availableAmount ptr (\ _ -> right availableAmount ptr failWithEOI failWithMessage succeed) failWithMessage succeed@@ -38,8 +38,8 @@ return = pure {-# INLINE (>>=) #-} (>>=) (Parse left) rightK =- Parse $ \ availableAmount ptr failWithEOI failWithMessage succeed ->- left availableAmount ptr failWithEOI failWithMessage $ \ leftOutput leftAvailableAmount leftPtr ->+ Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->+ left availableAmount ptr failWithEOI failWithMessage $ \ leftOutput !leftAvailableAmount !leftPtr -> case rightK leftOutput of Parse right -> right leftAvailableAmount leftPtr failWithEOI failWithMessage succeed@@ -48,6 +48,11 @@ mzero = empty mplus = (<|>) +instance MonadIO Parse where+ {-# INLINE liftIO #-}+ liftIO io =+ Parse $ \ availableAmount ptr _ _ succeed -> io >>= \ output -> succeed output availableAmount ptr+ {-# INLINE fail #-} fail :: Text -> Parse output fail message =@@ -64,6 +69,13 @@ succeed result (availableAmount - requiredAmount) (plusPtr ptr requiredAmount) else failWithEOI (requiredAmount - availableAmount) +{-# INLINE mapInIO #-}+mapInIO :: (output -> IO newOutput) -> Parse output -> Parse newOutput+mapInIO io (Parse parseIO) =+ Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->+ parseIO availableAmount ptr failWithEOI failWithMessage+ (\ output newAvailableAmount newPtr -> io output >>= \ newOutput -> succeed newOutput newAvailableAmount newPtr)+ {-# INLINE pokeAndPeek #-} pokeAndPeek :: A.PokeAndPeek input output -> Parse output pokeAndPeek (A.PokeAndPeek requiredAmount _ ptrIO) =@@ -91,7 +103,7 @@ peekRemainders = {-# SCC "peekRemainders" #-} Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed -> do- bytes <- D.peekBytes ptr availableAmount+ !bytes <- D.peekBytes ptr availableAmount succeed bytes availableAmount ptr {-# INLINE word8 #-}@@ -129,7 +141,7 @@ allBytes = {-# SCC "allBytes" #-} Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed -> do- bytes <- D.peekBytes ptr availableAmount+ !bytes <- D.peekBytes ptr availableAmount succeed bytes 0 (plusPtr ptr availableAmount) {-# INLINE nullTerminatedBytes #-}@@ -137,7 +149,7 @@ nullTerminatedBytes = {-# SCC "nullTerminatedBytes" #-} Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed -> do- bytes <- B.packCString (castPtr ptr)+ !bytes <- B.packCString (castPtr ptr) case succ (B.length bytes) of consumedAmount -> if consumedAmount <= availableAmount then succeed bytes (availableAmount - consumedAmount) (plusPtr ptr consumedAmount)@@ -151,7 +163,7 @@ D.peekNullTerminatedShortByteString ptr $ \ length create -> if length <= availableAmount then do- result <- create+ !result <- create succeed result (availableAmount - length) (plusPtr ptr length) else failWithEOI (length - availableAmount)
+ library/Ptr/ParseUnbound.hs view
@@ -0,0 +1,164 @@+module Ptr.ParseUnbound+where++import Ptr.Prelude hiding (peek, take)+import qualified Ptr.PokeAndPeek as A+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Short.Internal as E+import qualified Ptr.Prelude as C+import qualified Ptr.IO as D+++{-|+Unbound parser, whose peeking action decides how much input to consume,+and merely informs the executor about how many bytes it consumed.+-}+newtype ParseUnbound output =+ ParseUnbound (Ptr Word8 -> forall result. (Text -> IO result) -> (output -> Int -> IO result) -> IO result)++deriving instance Functor ParseUnbound++instance Applicative ParseUnbound where+ pure x =+ ParseUnbound (\ ptr _ succeed -> succeed x 0)+ {-# INLINE (<*>) #-}+ (<*>) (ParseUnbound left) (ParseUnbound right) =+ ParseUnbound $ \ ptr fail succeed ->+ left ptr fail $ \ leftOutput leftSize ->+ right (plusPtr ptr leftSize) fail $ \ rightOutput rightSize ->+ succeed (leftOutput rightOutput) (leftSize + rightSize)++instance Monad ParseUnbound where+ return = pure+ {-# INLINE (>>=) #-}+ (>>=) (ParseUnbound left) rightK =+ ParseUnbound $ \ ptr fail succeed ->+ left ptr fail $ \ leftOutput leftSize ->+ case rightK leftOutput of+ ParseUnbound right ->+ right (plusPtr ptr leftSize) fail succeed++{-# INLINE fail #-}+fail :: Text -> ParseUnbound output+fail message =+ ParseUnbound $ \ _ fail _ -> fail message++{-# INLINE io #-}+io :: Int -> (Ptr Word8 -> IO output) -> ParseUnbound output+io !size ptrIO =+ {-# SCC "io" #-} + ParseUnbound $ \ ptr fail succeed -> do+ !result <- ptrIO ptr+ succeed result size++{-# INLINE pokeAndPeek #-}+pokeAndPeek :: A.PokeAndPeek input output -> ParseUnbound output+pokeAndPeek (A.PokeAndPeek size _ ptrIO) =+ ParseUnbound $ \ ptr fail succeed -> do+ !result <- ptrIO ptr+ succeed result size++{-# INLINE word8 #-}+word8 :: ParseUnbound Word8+word8 =+ {-# SCC "word8" #-} + io 1 D.peekWord8++{-# INLINE beWord16 #-}+beWord16 :: ParseUnbound Word16+beWord16 =+ {-# SCC "beWord16" #-} + io 2 D.peekBEWord16++{-# INLINE beWord32 #-}+beWord32 :: ParseUnbound Word32+beWord32 =+ {-# SCC "beWord32" #-} + io 4 D.peekBEWord32++{-# INLINE beWord64 #-}+beWord64 :: ParseUnbound Word64+beWord64 =+ {-# SCC "beWord64" #-} + io 8 D.peekBEWord64++{-# INLINE bytes #-}+bytes :: Int -> ParseUnbound ByteString+bytes amount =+ {-# SCC "bytes" #-} + io amount (\ ptr -> D.peekBytes ptr amount)++{-# INLINE nullTerminatedBytes #-}+nullTerminatedBytes :: ParseUnbound ByteString+nullTerminatedBytes =+ {-# SCC "nullTerminatedBytes" #-}+ ParseUnbound $ \ !ptr fail succeed -> do+ !bytes <- B.packCString (castPtr ptr)+ succeed bytes $! succ (B.length bytes)++{-# INLINE nullTerminatedShortByteString #-}+nullTerminatedShortByteString :: ParseUnbound ShortByteString+nullTerminatedShortByteString =+ {-# SCC "nullTerminatedShortByteString" #-}+ ParseUnbound $ \ !ptr fail succeed ->+ D.peekNullTerminatedShortByteString ptr $ \ !length create ->+ do+ !bytes <- create+ succeed bytes length++{-# INLINE bytesWhile #-}+bytesWhile :: (Word8 -> Bool) -> ParseUnbound ByteString+bytesWhile predicate =+ {-# SCC "bytesWhile" #-}+ ParseUnbound $ \ ptr fail succeed ->+ let+ iterate !i =+ do+ byte <- C.peek (plusPtr ptr i)+ if predicate byte+ then iterate (succ i)+ else do+ bytes <- B.packCStringLen (castPtr ptr, i)+ succeed bytes i+ in iterate 0++{-# INLINE skipWhile #-}+skipWhile :: (Word8 -> Bool) -> ParseUnbound ()+skipWhile predicate =+ {-# SCC "skipWhile" #-} + ParseUnbound $ \ ptr fail succeed ->+ let+ iterate !i =+ do+ byte <- C.peek (plusPtr ptr i)+ if predicate byte+ then iterate (succ i)+ else succeed () i+ in iterate 0++{-# INLINE foldWhile #-}+foldWhile :: (Word8 -> Bool) -> (state -> Word8 -> state) -> state -> ParseUnbound state+foldWhile predicate step start =+ {-# SCC "foldWhile" #-} + ParseUnbound $ \ ptr fail succeed ->+ let+ iterate !state !i =+ do+ byte <- C.peek (plusPtr ptr i)+ if predicate byte+ then iterate (step state byte) (succ i)+ else succeed state i+ in iterate start 0++-- |+-- Unsigned integral number encoded in ASCII.+{-# INLINE unsignedASCIIIntegral #-}+unsignedASCIIIntegral :: Integral a => ParseUnbound a+unsignedASCIIIntegral =+ {-# SCC "unsignedASCIIIntegral" #-} + foldWhile byteIsDigit step 0+ where+ byteIsDigit byte =+ byte - 48 <= 9+ step !state !byte =+ state * 10 + fromIntegral byte - 48
library/Ptr/Peek.hs view
@@ -4,6 +4,7 @@ import Ptr.Prelude hiding (take) import qualified Ptr.PokeAndPeek as B import qualified Ptr.Parse as C+import qualified Ptr.ParseUnbound as D import qualified Ptr.IO as A @@ -66,14 +67,29 @@ {-| Given the length of the data and a specification of its sequential consumption, produces Peek, which results in Just the successfully taken value,-or Nothing, the specified length of data wasn't enough.+or Nothing, if the specified length of data wasn't enough. -} {-# INLINE parse #-} parse :: Int -> C.Parse a -> (Int -> a) -> (Text -> a) -> Peek a parse amount (C.Parse parseIO) eoi error = {-# SCC "parse" #-} - Peek amount $ \ptr ->+ Peek amount $ \ ptr -> parseIO amount ptr (return . eoi) (return . error) (\result _ _ -> return result)++{-|+Given the length of the data and a specification of its sequential consumption,+produces Peek, which results in Just the successfully taken value,+or Nothing, if the specified length of data wasn't enough.+-}+{-# INLINE parseUnbound #-}+parseUnbound :: Int -> D.ParseUnbound a -> (Int -> a) -> (Text -> a) -> Peek a+parseUnbound sizeBound (D.ParseUnbound parseIO) eoi error =+ {-# SCC "parse" #-} + Peek sizeBound $ \ ptr ->+ parseIO ptr (return . error)+ (\ result size -> if size <= sizeBound+ then return (eoi (size - sizeBound))+ else return result) {-| A standard idiom, where a header specifies the length of the body.
ptr.cabal view
@@ -1,7 +1,7 @@ name: ptr version:- 0.15.3+ 0.15.4 category: Ptr, Data synopsis:@@ -41,6 +41,7 @@ exposed-modules: Ptr.Peek Ptr.Parse+ Ptr.ParseUnbound Ptr.Poke Ptr.PokeAndPeek Ptr.Receive@@ -65,7 +66,7 @@ bug == 1.*, -- general: base-prelude >= 1 && < 2,- base >= 4.7 && < 5+ base >= 4.8 && < 5 test-suite tests type: