bytearray-parsing (empty) → 0.1
raw patch · 7 files changed
+434/−0 lines, 7 filesdep +basedep +bytestringdep +primitivesetup-changed
Dependencies added: base, bytestring, primitive, text
Files
- LICENSE +22/−0
- Setup.hs +2/−0
- bytearray-parsing.cabal +53/−0
- library/ByteArray/Parsing/Parse.hs +227/−0
- library/ByteArray/Parsing/Prelude.hs +82/−0
- library/ByteArray/Parsing/Prim.hs +36/−0
- library/ByteArray/Parsing/ShortByteString.hs +12/−0
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2017, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bytearray-parsing.cabal view
@@ -0,0 +1,53 @@+name:+ bytearray-parsing+version:+ 0.1+synopsis:+ Parsing of bytearray-based data+category:+ Parsing+homepage:+ https://github.com/nikita-volkov/bytearray-parsing +bug-reports:+ https://github.com/nikita-volkov/bytearray-parsing/issues +author:+ Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+ Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+ (c) 2017, Nikita Volkov+license:+ MIT+license-file:+ LICENSE+build-type:+ Simple+cabal-version:+ >=1.10++source-repository head+ type:+ git+ location:+ git://github.com/nikita-volkov/bytearray-parsing.git++library+ hs-source-dirs:+ library+ 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+ exposed-modules:+ ByteArray.Parsing.Parse+ ByteArray.Parsing.ShortByteString+ other-modules:+ ByteArray.Parsing.Prelude+ ByteArray.Parsing.Prim+ build-depends:+ --+ text >=1 && <2,+ bytestring ==0.10.*,+ primitive >=0.6.2 && <0.7,+ --+ base >=4.7 && <5
+ library/ByteArray/Parsing/Parse.hs view
@@ -0,0 +1,227 @@+module ByteArray.Parsing.Parse+where++import ByteArray.Parsing.Prelude hiding (take, takeWhile)+import qualified Data.ByteString.Internal as A+import qualified GHC.ForeignPtr as B+import qualified Data.Primitive.ByteArray as C+import qualified Data.Primitive.Addr as D+import qualified ByteArray.Parsing.Prim as E+++newtype Parse a =+ Parse (forall x. C.ByteArray -> Int -> (Int -> x) -> (Text -> x) -> (Int -> a -> x) -> x)++instance Functor Parse where+ {-# INLINE fmap #-}+ fmap mapping (Parse parse) =+ Parse $ \ array index needMoreResult errorResult successResult ->+ {-# SCC "fmap" #-} + parse array index needMoreResult errorResult $ \ newIndex parsed ->+ successResult newIndex (mapping parsed)++instance Applicative Parse where+ {-# INLINE pure #-}+ pure x =+ Parse $ \ _ index _ _ successResult -> successResult index x+ {-# INLINE (<*>) #-}+ (<*>) (Parse parseLeft) (Parse parseRight) =+ Parse $ \ array index needMoreResult errorResult successResult ->+ {-# SCC "<*>" #-} + parseLeft array index needMoreResult errorResult $ \ leftConsumed leftParsed ->+ parseRight array leftConsumed needMoreResult errorResult $ \ rightConsumed rightParsed ->+ successResult rightConsumed (leftParsed rightParsed)++instance Alternative Parse where+ {-# INLINE empty #-}+ empty =+ Parse $ \ _ _ needMoreResult _ _ -> needMoreResult 0+ {-# INLINE (<|>) #-}+ (<|>) (Parse parseLeft) (Parse parseRight) =+ Parse $ \ array index needMoreResult errorResult successResult ->+ {-# SCC "<|>" #-} + parseLeft array index+ (\ _ -> parseRight array index needMoreResult errorResult successResult)+ errorResult+ successResult++instance Monad Parse where+ {-# INLINE return #-}+ return =+ pure+ {-# INLINE (>>=) #-}+ (>>=) (Parse parseLeft) rightK =+ Parse $ \ array index needMoreResult errorResult successResult ->+ {-# SCC ">>=" #-} + parseLeft array index needMoreResult errorResult $ \ leftConsumed leftParsed ->+ case rightK leftParsed of+ Parse parseRight ->+ parseRight array leftConsumed needMoreResult errorResult successResult++instance MonadPlus Parse where+ mzero = empty+ mplus = (<|>)++{-# INLINE fail #-}+fail :: Text -> Parse a+fail message =+ Parse $ \ _ _ _ errorResult _ ->+ errorResult message++{-# INLINE word8 #-}+word8 :: Parse Word8+word8 =+ Parse $ \ array index needMoreResult errorResult successResult ->+ {-# SCC "word8" #-} + if C.sizeofByteArray array >= index+ then successResult (succ index) (C.indexByteArray array index)+ else needMoreResult 1++{-# INLINE beNum #-}+beNum :: (Bits a, Num a) => Int -> Parse a+beNum size =+ Parse $ \ array index needMoreResult errorResult successResult ->+ {-# SCC "beNum" #-} + let+ arrayLength = C.sizeofByteArray array+ nextIndex = index + size+ in if arrayLength >= size+ then let+ fold !index !state =+ if index < nextIndex+ then fold (succ index) (shiftL state 8 .|. fromIntegral (C.indexByteArray array index :: Word8))+ else state+ in successResult (nextIndex) (fold index 0)+ else needMoreResult (nextIndex - arrayLength)++{-# INLINE beWord16 #-}+beWord16 :: Parse Word16+beWord16 =+ {-# SCC "beWord16" #-} + beNum 2++{-# INLINE beWord32 #-}+beWord32 :: Parse Word32+beWord32 =+ {-# SCC "beWord32" #-} + beNum 4++{-# INLINE beWord64 #-}+beWord64 :: Parse Word64+beWord64 =+ {-# SCC "beWord64" #-} + beNum 8++{-# INLINE shortByteString #-}+shortByteString :: Int -> Parse ShortByteString+shortByteString size =+ Parse $ \ array index needMoreResult errorResult successResult ->+ {-# SCC "shortByteString" #-} + let+ arrayLength = C.sizeofByteArray array+ nextIndex = index + size+ in if arrayLength >= nextIndex+ then successResult nextIndex (E.byteArraySliceToShortByteString index size array)+ else needMoreResult (nextIndex - arrayLength)++{-# INLINE byteString #-}+byteString :: Int -> Parse ByteString+byteString size =+ Parse $ \ array index needMoreResult errorResult successResult ->+ {-# SCC "byteString" #-} + let+ arrayLength = C.sizeofByteArray array+ nextIndex = index + size+ in if arrayLength >= nextIndex+ then successResult nextIndex (E.byteArraySliceToByteString index size array)+ else needMoreResult (nextIndex - arrayLength)++{-# INLINE remainingByteString #-}+remainingByteString :: Parse ByteString+remainingByteString =+ Parse $ \ array index needMoreResult errorResult successResult ->+ {-# SCC "remainingByteString" #-} + let+ arrayLength =+ C.sizeofByteArray array+ size =+ arrayLength - index+ in successResult arrayLength (E.byteArraySliceToByteString index (arrayLength - index) array)++{-# INLINE nullTerminatedByteString #-}+nullTerminatedByteString :: Parse ByteString+nullTerminatedByteString =+ Parse $ \ array index needMoreResult errorResult successResult ->+ {-# SCC "nullTerminatedBytes" #-}+ let+ findNullIndex !index =+ if (C.indexByteArray array index :: Word8) == 0+ then index+ else findNullIndex (succ index)+ nullIndex =+ findNullIndex index+ nextIndex =+ succ nullIndex+ size =+ nullIndex - index+ in successResult nextIndex (E.byteArraySliceToByteString index size array)++{-# INLINE byteStringWhile #-}+byteStringWhile :: (Word8 -> Bool) -> Parse ByteString+byteStringWhile predicate =+ Parse $ \ array index needMoreResult errorResult successResult ->+ {-# SCC "byteStringWhile" #-} + let+ iterate !index =+ if predicate (C.indexByteArray array index)+ then iterate (succ index)+ else index+ nextIndex =+ iterate index+ size =+ nextIndex - index+ in successResult nextIndex (E.byteArraySliceToByteString index size array)++{-# INLINE skipWhile #-}+skipWhile :: (Word8 -> Bool) -> Parse ()+skipWhile predicate =+ Parse $ \ array index needMoreResult errorResult successResult ->+ {-# SCC "skipWhile" #-} + let+ iterate !index =+ if predicate (C.indexByteArray array index)+ then iterate (succ index)+ else index+ nextIndex =+ iterate index+ size =+ nextIndex - index+ in successResult nextIndex ()++{-# INLINE foldWhile #-}+foldWhile :: (Word8 -> Bool) -> (state -> Word8 -> state) -> state -> Parse state+foldWhile predicate step start =+ Parse $ \ array index needMoreResult errorResult successResult ->+ {-# SCC "foldWhile" #-} + let+ iterate !index !state =+ let+ byte =+ C.indexByteArray array index+ in if predicate byte+ then iterate (succ index) (step state byte)+ else successResult index state+ in iterate index start++-- |+-- Unsigned integral number encoded in ASCII.+{-# INLINE unsignedASCIIIntegral #-}+unsignedASCIIIntegral :: Integral a => Parse a+unsignedASCIIIntegral =+ {-# SCC "unsignedASCIIIntegral" #-} + foldWhile byteIsDigit step 0+ where+ byteIsDigit byte =+ byte - 48 <= 9+ step !state !byte =+ state * 10 + fromIntegral byte - 48
+ library/ByteArray/Parsing/Prelude.hs view
@@ -0,0 +1,82 @@+-- |+-- This module reexports most of the definitions from the \"base\" package,+-- which are meant to be imported unqualified.+--+-- For details check out the source.+module ByteArray.Parsing.Prelude+(+ module Exports,+)+where++-- base+-------------------------+import Control.Applicative as Exports+import Control.Arrow as Exports hiding (first, second)+import Control.Category as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.ST as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+import Data.Fixed as Exports+import Data.Foldable as Exports+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports+import Data.Int as Exports+import Data.IORef as Exports+import Data.Ix as Exports+import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.Maybe as Exports+import Data.Monoid as Exports+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.STRef as Exports+import Data.String as Exports+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Word as Exports+import Debug.Trace as Exports hiding (traceShowId, traceM, traceShowM)+import Foreign.ForeignPtr as Exports+import Foreign.Ptr as Exports+import Foreign.StablePtr as Exports+import Foreign.Storable as Exports+import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)+import GHC.Exts as Exports (lazy, inline, sortWith, groupWith)+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import Numeric as Exports+import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports (Handle, hClose)+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (printf, hPrintf)+import Text.Read as Exports (Read(..), readMaybe, readEither)+import Unsafe.Coerce as Exports++-- text+-------------------------+import Data.Text as Exports (Text)++-- bytestring+-------------------------+import Data.ByteString as Exports (ByteString)+import Data.ByteString.Short as Exports (ShortByteString)
+ library/ByteArray/Parsing/Prim.hs view
@@ -0,0 +1,36 @@+module ByteArray.Parsing.Prim+where++import ByteArray.Parsing.Prelude hiding (take, takeWhile)+import qualified Data.ByteString.Internal as A+import qualified Data.ByteString.Short.Internal as E+import qualified GHC.ForeignPtr as B+import qualified Data.Primitive.ByteArray as C+import qualified Data.Primitive.Addr as D+++{-# INLINE byteArraySliceToByteString #-}+byteArraySliceToByteString :: Int -> Int -> C.ByteArray -> ByteString+byteArraySliceToByteString offset size byteArray =+ unsafeDupablePerformIO $ do+ pinnedSlice <- C.newPinnedByteArray size+ C.copyByteArray pinnedSlice 0 byteArray offset size+ let+ D.Addr addr# = C.mutableByteArrayContents pinnedSlice+ C.MutableByteArray mba# = pinnedSlice+ fp = B.ForeignPtr addr# (B.PlainPtr mba#)+ in return (A.PS fp 0 size)++{-# INLINE byteArraySlice #-}+byteArraySlice :: Int -> Int -> C.ByteArray -> C.ByteArray+byteArraySlice offset size byteArray =+ unsafeDupablePerformIO $ do+ slice <- C.newByteArray size+ C.copyByteArray slice 0 byteArray offset size+ C.unsafeFreezeByteArray slice++{-# INLINE byteArraySliceToShortByteString #-}+byteArraySliceToShortByteString :: Int -> Int -> C.ByteArray -> ShortByteString+byteArraySliceToShortByteString offset size byteArray =+ case byteArraySlice offset size byteArray of+ C.ByteArray byteArray# -> E.SBS byteArray#
+ library/ByteArray/Parsing/ShortByteString.hs view
@@ -0,0 +1,12 @@+module ByteArray.Parsing.ShortByteString+where++import ByteArray.Parsing.Prelude+import qualified Data.ByteString.Short.Internal as A+import qualified ByteArray.Parsing.Parse as B+import qualified Data.Primitive.ByteArray as C+++parse :: ShortByteString -> B.Parse parsed -> (Int -> result) -> (Text -> result) -> (Int -> parsed -> result) -> result+parse (A.SBS unboxedArray) (B.Parse parse) needMoreResult errorResult successResult =+ parse (C.ByteArray unboxedArray) 0 needMoreResult errorResult successResult