diff --git a/Data/ByteString/Parse.hs b/Data/ByteString/Parse.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/Parse.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Data.ByteString.Parse +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : portable +-- +-- A very simple bytestring parser related to Parsec and Attoparsec +-- +-- Simple example: +-- +-- > > parse ((,) <$> take 2 <*> byte 0x20 <*> (bytes "abc" *> anyByte)) "xx abctest" +-- > ParseOK "est" ("xx", 116) +-- +module Data.ByteString.Parse + ( Parser + , Result(..) + -- * run the Parser + , parse + , parseFeed + -- * Parser methods + , byte + , anyByte + , bytes + , take + , takeWhile + , skip + , skipWhile + ) where + +import Control.Applicative +import Control.Monad +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as B +import Data.Word +import Prelude hiding (take, takeWhile) + +-- | Simple parsing result, that represent respectively: +-- +-- * failure: with the error message +-- +-- * continuation: that need for more input data +-- +-- * success: the remaining unparsed data and the parser value +data Result a = + ParseFail String + | ParseMore (ByteString -> Result a) + | ParseOK ByteString a + +instance Show a => Show (Result a) where + show (ParseFail err) = "ParseFailure: " ++ err + show (ParseMore _) = "ParseMore _" + show (ParseOK b a) = "ParseOK " ++ show a ++ " " ++ show b + +type Failure r = ByteString -> String -> Result r +type Success a r = ByteString -> a -> Result r + +-- | Simple ByteString parser structure +newtype Parser a = Parser + { runParser :: forall r . ByteString -> Failure r -> Success a r -> Result r } + +instance Monad Parser where + fail errorMsg = Parser $ \buf err _ -> err buf ("failed: " ++ errorMsg) + return v = Parser $ \buf _ ok -> ok buf v + m >>= k = Parser $ \buf err ok -> + runParser m buf err (\buf' a -> runParser (k a) buf' err ok) +instance MonadPlus Parser where + mzero = fail "Parser.MonadPlus.mzero" + mplus f g = Parser $ \buf err ok -> + -- rewrite the err callback of @f to call @g + runParser f buf (\buf' _ -> runParser g buf' err ok) ok +instance Functor Parser where + fmap f p = Parser $ \buf err ok -> + runParser p buf err (\b a -> ok b (f a)) +instance Applicative Parser where + pure = return + (<*>) d e = d >>= \b -> e >>= \a -> return (b a) +instance Alternative Parser where + empty = fail "Parser.Alternative.empty" + (<|>) = mplus + +-- | Run a parser on an @initial ByteString. +-- +-- If the Parser need more data than available, the @feeder function +-- is automatically called and fed to the More continuation. +parseFeed :: Monad m => m B.ByteString -> Parser a -> B.ByteString -> m (Result a) +parseFeed feeder p initial = loop $ parse p initial + where loop (ParseMore k) = feeder >>= (loop . k) + loop r = return r + +-- | Run a Parser on a ByteString and return a 'Result' +parse :: Parser a -> ByteString -> Result a +parse p s = runParser p s (\_ msg -> ParseFail msg) (\b a -> ParseOK b a) + +------------------------------------------------------------ +getMore = Parser $ \buf err ok -> ParseMore $ \nextChunk -> + if B.null nextChunk + then err buf "EOL: need more data" + else ok (B.append buf nextChunk) () + +------------------------------------------------------------ + +-- | Get the next byte from the parser +anyByte :: Parser Word8 +anyByte = Parser $ \buf err ok -> + case B.uncons buf of + Nothing -> runParser (getMore >> anyByte) buf err ok + Just (c1,b2) -> ok b2 c1 + +-- | Parse a specific byte at current position +-- +-- if the byte is different than the expected on, +-- this parser will raise a failure. +byte :: Word8 -> Parser () +byte w = Parser $ \buf err ok -> + case B.uncons buf of + Nothing -> runParser (getMore >> byte w) buf err ok + Just (c1,b2) | c1 == w -> ok b2 () + | otherwise -> err buf ("byte " ++ show w ++ " : failed") + +-- | Parse a sequence of bytes from current position +-- +-- if the following bytes don't match the expected +-- bytestring completely, the parser will raise a failure +bytes :: ByteString -> Parser () +bytes allExpected = consumeEq allExpected + where errMsg = "bytes " ++ show allExpected ++ " : failed" + + -- partially consume as much as possible or raise an error. + consumeEq expected = Parser $ \actual err ok -> + let eLen = B.length expected in + if B.length actual >= eLen + then -- enough data for doing a full match + let (aMatch,aRem) = B.splitAt eLen actual + in if aMatch == expected + then ok aRem () + else err actual errMsg + else -- not enough data, match as much as we have, and then recurse. + let (eMatch, eRem) = B.splitAt (B.length actual) expected + in if actual == eMatch + then runParser (getMore >> consumeEq eRem) B.empty err ok + else err actual errMsg + +------------------------------------------------------------ + +-- | Take @n bytes from the current position in the stream +take n = Parser $ \buf err ok -> + if B.length buf >= n + then let (b1,b2) = B.splitAt n buf in ok b2 b1 + else runParser (getMore >> take n) buf err ok + +-- | Take bytes while the @predicate hold from the current position in the stream +takeWhile predicate = Parser $ \buf err ok -> + case B.span predicate buf of + (_, "") -> runParser (getMore >> takeWhile predicate) buf err ok + (b1, b2) -> ok b2 b1 + +-- | Skip @n bytes from the current position in the stream +skip n = Parser $ \buf err ok -> + if B.length buf >= n + then ok (B.drop n buf) () + else runParser (getMore >> skip (n - B.length buf)) B.empty err ok + +-- | Skip bytes while the @predicate hold from the current position in the stream +skipWhile p = Parser $ \buf err ok -> + case B.span p buf of + (_, "") -> runParser (getMore >> skipWhile p) B.empty err ok + (_, b2) -> ok b2 () diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2014 Vincent Hanquez + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,9 @@ +bsparse +======= + +[![Build Status](https://travis-ci.org/vincenthz/hs-bsparse.png?branch=master)](https://travis-ci.org/vincenthz/hs-bsparse) +[![BSD](http://b.repl.ca/v1/license-BSD-blue.png)](http://en.wikipedia.org/wiki/BSD_licenses) +[![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org) + + +Documentation: [bsparse on hackage](http://hackage.haskell.org/package/bsparse) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bsparse.cabal b/bsparse.cabal new file mode 100644 --- /dev/null +++ b/bsparse.cabal @@ -0,0 +1,39 @@ +Name: bsparse +Version: 0.0.1 +Synopsis: A simple unassuming parser for bytestring +Description: Really trivial parser to get and drop bytes from a bytestring +License: BSD3 +License-file: LICENSE +Copyright: Vincent Hanquez +Author: Vincent Hanquez +Maintainer: vincent@snarc.org +Category: bsparse +Stability: experimental +Build-Type: Simple +Homepage: https://github.com/vincenthz/hs-bsparse +Bug-Reports: https://github.com/vincenthz/hs-bsparse/issues +Cabal-Version: >=1.10 +extra-source-files: README.md + +source-repository head + type: git + location: https://github.com/vincenthz/hs-bsparse + +Library + Exposed-modules: Data.ByteString.Parse + Build-depends: base >= 4 && < 5 + ghc-options: -Wall -fwarn-tabs + default-language: Haskell2010 + +--Test-Suite test-bsparse +-- type: exitcode-stdio-1.0 +-- hs-source-dirs: tests +-- Main-is: Tests.hs +-- Build-Depends: base >= 3 && < 5 +-- , mtl +-- , tasty +-- , tasty-quickcheck2 +-- , tasty-hunit +-- , bsparse +-- ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures +-- default-language: Haskell2010