packages feed

bsparse (empty) → 0.0.1

raw patch · 5 files changed

+249/−0 lines, 5 filesdep +basesetup-changed

Dependencies added: base

Files

+ Data/ByteString/Parse.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Data.ByteString.Parse+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- 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 ()
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2014 Vincent Hanquez <vincent@snarc.org>++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.
+ README.md view
@@ -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)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bsparse.cabal view
@@ -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 <vincent@snarc.org>+Author:              Vincent Hanquez <vincent@snarc.org>+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