fastparser (empty) → 0.3.0
raw patch · 4 files changed
+431/−0 lines, 4 filesdep +basedep +bytestringdep +bytestring-lexingsetup-changed
Dependencies added: base, bytestring, bytestring-lexing, containers, microlens, thyme, vector-space
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- fastparser.cabal +31/−0
- src/ByteString/Parser/Fast.hs +368/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Simon Marechal (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Simon Marechal nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT+OWNER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fastparser.cabal view
@@ -0,0 +1,31 @@+name: fastparser+version: 0.3.0+synopsis: A fast, but bare bones, bytestring parser combinators library.+description: Please see README.md+homepage: https://github.com/bartavelle/fastparser#readme+license: BSD3+license-file: LICENSE+author: Simon Marechal+maintainer: bartavelle@gmail.com+copyright: Simon Marechal+category: Parsing+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: ByteString.Parser.Fast+ build-depends: base >= 4.7 && < 5+ , bytestring == 0.10.*+ , thyme == 0.3.*+ , vector-space == 0.10.*+ , microlens == 0.4.*+ , bytestring-lexing == 0.5.*+ , containers == 0.5.*+ ghc-options: -O2 -Wall+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/bartavelle/fastparser
+ src/ByteString/Parser/Fast.hs view
@@ -0,0 +1,368 @@+-- | A fast parser combinators module.+-- +-- This module is extremely bare-bones, and provides only very limited+-- functionality.+--+-- Sample usage:+-- +-- > module Syslog where+-- > +-- > import ByteString.Parser.Fast+-- > import qualified Data.ByteString as BS+-- > import Data.Thyme.Clock+-- > import Control.Applicative+-- > +-- > data SyslogMsg+-- > = SyslogMsg+-- > { _syslogPrio :: {-# UNPACK #-} !Int+-- > , _syslogTS :: {-# UNPACK #-} !UTCTime+-- > , _syslogHost :: !BS.ByteString+-- > , _syslogProgram :: !BS.ByteString+-- > , _syslogPID :: !(Maybe Int)+-- > , _syslogData :: !BS.ByteString+-- > } deriving (Show, Eq)+-- > +-- > +-- > syslogMsg :: Parser SyslogMsg+-- > syslogMsg = do+-- > char '<'+-- > prio <- decimal+-- > char '>'+-- > ts <- rfc3339+-- > char ' '+-- > host <- charTakeWhile1 (/= ' ')+-- > char ' '+-- > program <- charTakeWhile1 (\x -> x /= ':' && x /= '[')+-- > pid' <- optional (char '[' *> decimal <* char ']')+-- > char ':'+-- > dt <- remaining+-- > return (SyslogMsg prio ts host program pid' dt)+-- > +-- > test :: BS.ByteString -> Either ParseError SyslogMsg+-- > test = parseOnly syslogMsg+--+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE OverloadedStrings #-}+module ByteString.Parser.Fast+ (+ Parser(..), parseOnly,+ -- * Error handling+ ParseError(..), ErrorItem(..), ueof, ufail, parseError,+ -- * Parsing numerical values+ decimal, num, hnum, onum, frac, scientific,+ -- * Parsing characters+ anyChar, char, string, quotedString,+ -- * Various combinators+ takeN, remaining, charTakeWhile, charTakeWhile1, ByteString.Parser.Fast.takeWhile, takeWhile1, skipWhile,+ -- * Parsing time-related values+ parseYMD, parseDTime, timestamp, rfc3339,+ -- * Interfacing with other libraries+ wlex, pFold,+ -- * Hacks and bits+ isLower, getOctal, getInt+ ) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Data.Set (Set)+import qualified Data.Set as S+import Data.AffineSpace ((.-^), (.+^))+import Control.Applicative+import Control.Monad+import Data.Word+import Data.Thyme+import Data.Thyme.Time.Core+import Lens.Micro++import qualified Data.ByteString.Lex.Fractional as L++-- | A parser, church encoded. The arguments to the wrapped function are:+--+-- * Input "ByteString".+-- * A function that handles parse errors.+-- * A function that handles success, taking as argument the remaining+-- input and the parser result.+newtype Parser a+ = Parser {+ runParser :: forall r. BS.ByteString+ -> (ParseError -> r)+ -> (BS.ByteString -> a -> r)+ -> r+ } deriving Functor++instance Applicative Parser where+ pure a = Parser $ \b _ s -> s b a+ {-# INLINE pure #-}+ Parser pf <*> Parser px = Parser $ \input failure success ->+ let succ' input' f = px input' failure (\i a -> success i (f a))+ in pf input failure succ'+ {-# INLINE (<*>) #-}++instance Alternative Parser where+ empty = Parser (\_ failure _ -> failure mempty)+ {-# INLINE empty #-}+ Parser a <|> Parser b = Parser $ \input failure success -> a input (\rr -> b input (failure . mappend rr) success) success+ {-# INLINE (<|>) #-}++instance Monad Parser where+ fail s = Parser $ \_ failure _ -> failure (ufail s)+ m >>= k = Parser $ \input failure success ->+ let succ' input' a = runParser (k a) input' failure success+ in runParser m input failure succ'+ {-# INLINE (>>=) #-}++instance MonadPlus Parser++data ErrorItem+ = Tokens BS.ByteString+ | Label String+ deriving (Show, Eq, Ord)++data ParseError+ = ParseError+ { errorUnexpected :: !(Set ErrorItem)+ , errorExpected :: !(Set ErrorItem)+ } deriving (Show, Eq)++instance Monoid ParseError where+ mempty = ParseError mempty mempty+ mappend (ParseError u1 e1) (ParseError u2 e2) = ParseError (mappend u1 u2) (mappend e1 e2)++-- | An error representing the unexpected end of input.+ueof :: ParseError+ueof = ParseError (S.singleton (Label "end of input")) mempty++-- | A generic error.+ufail :: String -- ^ The expected label.+ -> ParseError+ufail s = ParseError (S.singleton (Label s)) mempty++-- | Creates a generic parse error.+parseError :: BS8.ByteString -- ^ Unexpected content+ -> BS8.ByteString -- ^ Expected content+ -> ParseError+parseError un ex = ParseError (S.singleton (Tokens un)) (S.singleton (Tokens ex))++-- | Creates a parser from the supplied function.+-- The first argument to the supplied function is the remaining input, and+-- it should return `Nothing` when parsing failes, or `Just` the result+-- along with the non-consumed input.+--+-- It works well with the+-- [bytestring-lexing](https://hackage.haskell.org/package/bytestring-lexing) library.+wlex :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> Parser a+wlex p = Parser $ \i failure success -> case p i of+ Nothing -> failure mempty+ Just (a, i') -> success i' a+{-# INLINABLE wlex #-}++-- | Parses bytestrings as if they were representing a decimal number in ASCII.+getInt :: BS.ByteString -> Int+getInt = BS.foldl' (\acc n -> acc * 10 + fromIntegral (n - 0x30)) 0+{-# INLINE getInt #-}++-- | Parses bytestrings as if they were representing an octal number in+-- ASCII.+getOctal :: BS.ByteString -> Int+getOctal = BS.foldl' (\acc n -> acc * 8 + fromIntegral (n - 0x30)) 0+{-# INLINE getOctal #-}++isDigit :: Word8 -> Bool+isDigit !x = x >= 0x30 && x <= 0x39+{-# INLINE isDigit #-}++isHexa :: Word8 -> Bool+isHexa !x = (x >= 0x30 && x <= 0x39)+ || (x >= 0x41 && x <= 0x46)+ || (x >= 0x61 && x <= 0x66)+{-# INLINE isHexa #-}++hexToNum :: Num n => Word8 -> n+hexToNum x | x >= 0x30 && x <= 0x39 = fromIntegral x - 0x30+ | x >= 0x41 && x <= 0x46 = fromIntegral x - 0x37+ | x >= 0x61 && x <= 0x66 = fromIntegral x - 0x57+ | otherwise = 0+{-# INLINABLE hexToNum #-}++isUpper :: Word8 -> Bool+isUpper !x = x >= 0x41 && x <= 0x5a+{-# INLINE isUpper #-}++-- | Returns true when the character represents an ASCII lowercase letter.+isLower :: Word8 -> Bool+isLower !x = x >= 0x61 && x <= 0x7a+{-# INLINE isLower #-}++-- | parses a decimal integer.+decimal :: Parser Int+decimal = getInt <$> takeWhile1 isDigit+{-# INLINE decimal #-}++-- | Parses any positive decimal 'Num'.+num :: Num n => Parser n+num = BS.foldl' (\acc n -> acc * 10 + fromIntegral (n - 0x30)) 0 <$> takeWhile1 isDigit+{-# INLINABLE num #-}++-- | Parses any positive hexadecimal 'Num'.+hnum :: Num n => Parser n+hnum = BS.foldl' (\acc n -> acc * 16 + hexToNum n) 0 <$> takeWhile1 isHexa+{-# INLINABLE hnum #-}++-- | Parses any positives octal 'Num'.+onum :: Num n => Parser n+onum = BS.foldl' (\acc n -> acc * 8 + fromIntegral (n - 0x30)) 0 <$> takeWhile1 isHexa+{-# INLINABLE onum #-}++-- | Parses 'Fractional' numbers.+frac :: Fractional a => Parser a+frac = wlex (L.readSigned L.readDecimal)+{-# INLINABLE frac #-}++-- | Consumes n bytes of input+takeN :: Int -> Parser BS.ByteString+takeN n = Parser $ \input failure success -> if BS.length input < n+ then failure ueof+ else let (a,rest) = BS.splitAt n input+ in success rest a++-- | Parses any character.+anyChar :: Parser Char+anyChar = Parser $ \input failure success -> if BS.null input then failure ueof else success (BS8.tail input) (BS8.head input)++-- | Parses a specific character.+char :: Char -> Parser ()+char c = Parser $ \input failure success -> if BS.null input then failure ueof else if BS8.head input == c then success (BS.tail input) () else failure (parseError (BS8.take 1 input) (BS8.singleton c))+{-# INLINE char #-}++-- | Parses the supplied string.+string :: BS.ByteString -> Parser ()+string s = Parser $ \input failure success -> if s `BS.isPrefixOf` input+ then success (BS.drop (BS.length s) input) ()+ else failure (parseError (BS.take (BS.length s) input) s)++-- | Parses strings between double quotes. This functions handles the+-- following escape sequences: \\r, \\n, \\t, \\a, \\b, \\", \\\\.+quotedString :: Parser BS.ByteString+quotedString = char '"' *> go <* char '"'+ where+ go = BS.concat <$> many (normal <|> escaped)+ normal = charTakeWhile1 (\x -> x /= '"' && x /= '\\')+ escaped = do+ char '\\'+ c <- anyChar+ return $ case c of+ 'r' -> BS8.singleton '\r'+ 'n' -> BS8.singleton '\n'+ 't' -> BS8.singleton '\t'+ 'a' -> BS8.singleton '\a'+ 'b' -> BS8.singleton '\b'+ '"' -> BS8.singleton '"'+ _ -> BS8.pack ['\\',c]++-- | A fast parser for numbers of the form 5.123. Contrary to what its name+-- implies, it parses to 'Double'.+scientific :: Parser Double+scientific = finalize . BS.foldl' step (0,0) <$> takeWhile1 (\n -> isDigit n || n == 0x2e)+ where+ finalize :: (Int, Double) -> Double+ finalize (!n,!x) = if x == 0+ then fromIntegral n+ else fromIntegral n / x+ step (!n,!x) !v = if v == 0x2e+ then (n,1)+ else (n * 10 + fromIntegral (v - 0x30), x * 10)+{-# INLINE scientific #-}++charTakeWhile1 :: (Char -> Bool) -> Parser BS.ByteString+charTakeWhile1 prd = Parser $ \s failure success -> case BS8.span prd s of+ (a,b) -> if BS.null a then failure (ParseError (S.singleton (Tokens (BS.take 1 s))) mempty) else success b a+{-# INLINE charTakeWhile1 #-}++takeWhile1 :: (Word8 -> Bool) -> Parser BS.ByteString+takeWhile1 prd = Parser $ \s failure success -> case BS.span prd s of+ (a,b) -> if BS.null a then failure (ParseError (S.singleton (Tokens (BS.take 1 s))) mempty) else success b a+{-# INLINE takeWhile1 #-}++-- | Consumes the input as long as the predicate remains true.+charTakeWhile :: (Char -> Bool) -> Parser BS.ByteString+charTakeWhile prd = Parser $ \s _ success -> case BS8.span prd s of+ (a,b) -> success b a+{-# INLINE charTakeWhile #-}++-- | Consumes the input as long as the predicate remains true.+takeWhile :: (Word8 -> Bool) -> Parser BS.ByteString+takeWhile prd = Parser $ \s _ success -> case BS.span prd s of+ (a,b) -> success b a+{-# INLINE takeWhile #-}++-- | Discards the input as long as the predicate remains true.+skipWhile :: (Word8 -> Bool) -> Parser ()+skipWhile prd = Parser $ \s _ success -> success (BS.dropWhile prd s) ()+{-# INLINE skipWhile #-}++-- | Runs the parser. Will return a parse error if the parser fails+-- or if the input is not completely consumed.+parseOnly :: Parser a -> BS.ByteString -> Either ParseError a+parseOnly (Parser p) s = p s Left $ \b a -> if BS.null b+ then Right a+ else Left (ParseError (S.singleton (Tokens (BS.take 1 b))) mempty)++-- | Parses the remaining input.+remaining :: Parser BS.ByteString+remaining = Parser $ \input _ success -> success BS.empty input++-- | Parses days, with format YYYY-MM-DD+parseYMD :: Parser Day+parseYMD = do+ !y <- decimal <* char '-'+ !m <- decimal <* char '-'+ !d <- decimal+ return $! fromGregorian y m d++-- | Parses a difftime, with format HH:MM:SS+parseDTime :: Parser DiffTime+parseDTime = do+ !h <- decimal <* char ':'+ !mi <- decimal <* char ':'+ !s <- scientific+ return $! fromSeconds $ fromIntegral (h * 3600 + mi * 60 :: Int) + s++-- | Parses a whole timestamp, with format YYYY-MM-DD+HH:MM:SS+CEST.+-- This is very much *not* robust, as it only handles CET and CEST.+timestamp :: Parser UTCTime+timestamp = do+ !day <- parseYMD <* char '+'+ !difftime <- parseDTime <* char '+'+ let !tm = mkUTCTime day difftime+ !tz <- takeWhile1 isUpper+ return $! case tz of+ "CEST" -> tm .-^ fromSeconds (7200 :: Int)+ "CET" -> tm .-^ fromSeconds (3600 :: Int)+ _ -> tm++-- | Parses RFC3339 compatible timestamps to UTCTime.+rfc3339 :: Parser UTCTime+rfc3339 = do+ !day <- parseYMD <* char 'T'+ !difftime <- parseDTime+ !o <- anyChar+ let !tm = mkUTCTime day difftime+ suboffset = (tm .-^)+ addoffset = (tm .+^)+ getOffset = do+ h <- decimal+ char ':'+ m <- decimal+ return (fromSeconds (h*3600 + m*60))+ case o of+ 'Z' -> return tm+ '+' -> suboffset <$> getOffset+ '-' -> addoffset <$> getOffset+ _ -> empty++-- | Turns any parser into a 'SimpleFold'.+pFold :: Parser a -> SimpleFold BS.ByteString a+pFold p = to (parseOnly p) . _Right