snack (empty) → 0.1.0.0
raw patch · 11 files changed
+1878/−0 lines, 11 filesdep +attoparsecdep +basedep +bytestring
Dependencies added: attoparsec, base, bytestring, bytestring-lexing, criterion, snack, string-conversions, text
Files
- Changelog.md +4/−0
- LICENSE +121/−0
- README.md +34/−0
- bench/Bench.hs +400/−0
- lib/Data/ByteString/Parser.hs +337/−0
- lib/Data/ByteString/Parser.hs-boot +14/−0
- lib/Data/ByteString/Parser/Char8.hs +335/−0
- lib/Data/Text/Parser.hs +335/−0
- lib/Data/Text/Parser.hs-boot +14/−0
- lib/Snack/Combinators.hs +224/−0
- snack.cabal +60/−0
+ Changelog.md view
@@ -0,0 +1,4 @@+[0.1.0.0] -- April 2022+[0.1.0.0]: https://github.com/mordae/snack/compare/initial...0.1.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,121 @@+Creative Commons Legal Code++CC0 1.0 Universal++ CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE+ LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN+ ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS+ INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES+ REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS+ PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM+ THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED+ HEREUNDER.++Statement of Purpose++The laws of most jurisdictions throughout the world automatically confer+exclusive Copyright and Related Rights (defined below) upon the creator+and subsequent owner(s) (each and all, an "owner") of an original work of+authorship and/or a database (each, a "Work").++Certain owners wish to permanently relinquish those rights to a Work for+the purpose of contributing to a commons of creative, cultural and+scientific works ("Commons") that the public can reliably and without fear+of later claims of infringement build upon, modify, incorporate in other+works, reuse and redistribute as freely as possible in any form whatsoever+and for any purposes, including without limitation commercial purposes.+These owners may contribute to the Commons to promote the ideal of a free+culture and the further production of creative, cultural and scientific+works, or to gain reputation or greater distribution for their Work in+part through the use and efforts of others.++For these and/or other purposes and motivations, and without any+expectation of additional consideration or compensation, the person+associating CC0 with a Work (the "Affirmer"), to the extent that he or she+is an owner of Copyright and Related Rights in the Work, voluntarily+elects to apply CC0 to the Work and publicly distribute the Work under its+terms, with knowledge of his or her Copyright and Related Rights in the+Work and the meaning and intended legal effect of CC0 on those rights.++1. Copyright and Related Rights. A Work made available under CC0 may be+protected by copyright and related or neighboring rights ("Copyright and+Related Rights"). Copyright and Related Rights include, but are not+limited to, the following:++ i. the right to reproduce, adapt, distribute, perform, display,+ communicate, and translate a Work;+ ii. moral rights retained by the original author(s) and/or performer(s);+iii. publicity and privacy rights pertaining to a person's image or+ likeness depicted in a Work;+ iv. rights protecting against unfair competition in regards to a Work,+ subject to the limitations in paragraph 4(a), below;+ v. rights protecting the extraction, dissemination, use and reuse of data+ in a Work;+ vi. database rights (such as those arising under Directive 96/9/EC of the+ European Parliament and of the Council of 11 March 1996 on the legal+ protection of databases, and under any national implementation+ thereof, including any amended or successor version of such+ directive); and+vii. other similar, equivalent or corresponding rights throughout the+ world based on applicable law or treaty, and any national+ implementations thereof.++2. Waiver. To the greatest extent permitted by, but not in contravention+of, applicable law, Affirmer hereby overtly, fully, permanently,+irrevocably and unconditionally waives, abandons, and surrenders all of+Affirmer's Copyright and Related Rights and associated claims and causes+of action, whether now known or unknown (including existing as well as+future claims and causes of action), in the Work (i) in all territories+worldwide, (ii) for the maximum duration provided by applicable law or+treaty (including future time extensions), (iii) in any current or future+medium and for any number of copies, and (iv) for any purpose whatsoever,+including without limitation commercial, advertising or promotional+purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each+member of the public at large and to the detriment of Affirmer's heirs and+successors, fully intending that such Waiver shall not be subject to+revocation, rescission, cancellation, termination, or any other legal or+equitable action to disrupt the quiet enjoyment of the Work by the public+as contemplated by Affirmer's express Statement of Purpose.++3. Public License Fallback. Should any part of the Waiver for any reason+be judged legally invalid or ineffective under applicable law, then the+Waiver shall be preserved to the maximum extent permitted taking into+account Affirmer's express Statement of Purpose. In addition, to the+extent the Waiver is so judged Affirmer hereby grants to each affected+person a royalty-free, non transferable, non sublicensable, non exclusive,+irrevocable and unconditional license to exercise Affirmer's Copyright and+Related Rights in the Work (i) in all territories worldwide, (ii) for the+maximum duration provided by applicable law or treaty (including future+time extensions), (iii) in any current or future medium and for any number+of copies, and (iv) for any purpose whatsoever, including without+limitation commercial, advertising or promotional purposes (the+"License"). The License shall be deemed effective as of the date CC0 was+applied by Affirmer to the Work. Should any part of the License for any+reason be judged legally invalid or ineffective under applicable law, such+partial invalidity or ineffectiveness shall not invalidate the remainder+of the License, and in such case Affirmer hereby affirms that he or she+will not (i) exercise any of his or her remaining Copyright and Related+Rights in the Work or (ii) assert any associated claims and causes of+action with respect to the Work, in either case contrary to Affirmer's+express Statement of Purpose.++4. Limitations and Disclaimers.++ a. No trademark or patent rights held by Affirmer are waived, abandoned,+ surrendered, licensed or otherwise affected by this document.+ b. Affirmer offers the Work as-is and makes no representations or+ warranties of any kind concerning the Work, express, implied,+ statutory or otherwise, including without limitation warranties of+ title, merchantability, fitness for a particular purpose, non+ infringement, or the absence of latent or other defects, accuracy, or+ the present or absence of errors, whether or not discoverable, all to+ the greatest extent permissible under applicable law.+ c. Affirmer disclaims responsibility for clearing rights of other persons+ that may apply to the Work or any use thereof, including without+ limitation any person's Copyright and Related Rights in the Work.+ Further, Affirmer disclaims responsibility for obtaining any necessary+ consents, permissions or other rights required for any use of the+ Work.+ d. Affirmer understands and acknowledges that Creative Commons is not a+ party to this document and has no duty or obligation with respect to+ this CC0 or use of the Work.
+ README.md view
@@ -0,0 +1,34 @@+# snack++**Strict ByteString Parser Combinator**++- Simple. Feel free to contribute.+- Fast. Sometimes faster then Attoparsec.+- ASCII. Good enough for IETF formats.+- Also Text. But quite slower.++Example:++```haskell+import Data.ByteString (ByteString)+import qualified Data.ByteString.Parser.Char8 as BSP++parseList :: BSP.Parser [ByteString]+parseList = (token `BSP.wrap` BSP.skipSpace) `BSP.sepBy` BSP.char ','+ where token = BSP.takeWhile isToken+ isToken c = inRange 'a' 'z' c ||+ inRange 'A' 'Z' c ||+ inRange '0' '9' c ||+ c == '_' || c == '-'++main :: IO ()+main = do+ putStrLn $ show $ BSP.runParser parseList "monkey, wrench, bananas"+ putStrLn $ show $ BSP.runParser parseList "^quux"+ putStrLn $ show $ BSP.runParser (parseList <* BSP.endOfInput) "^quux"++-- Will output:+-- Just (["monkey","wrench","bananas"],"")+-- Just ([""],"^quux")+-- Nothing+```
+ bench/Bench.hs view
@@ -0,0 +1,400 @@+-- |+-- Module : Bench+-- License : CC0-1.0+--+-- Maintainer : mordae@anilinux.org+-- Stability : unstable+-- Portability : non-portable (ghc)+--++{-# OPTIONS_GHC -ddump-to-file -ddump-stg-from-core -ddump-cmm-opt -dsuppress-all -dppr-cols=200 #-}++module Main+ ( main+ )+where+ import Data.String.Conversions++ import Control.Applicative+ import Data.Either+ import Data.Maybe++ import Data.Text (Text)+ import Data.ByteString (ByteString)++ import Criterion.Main++ import qualified Data.ByteString.Parser.Char8 as SC+ import qualified Data.Attoparsec.ByteString.Char8 as AC+ import qualified Data.Text.Parser as ST+ import qualified Data.Attoparsec.Text as AT+++ main :: IO ()+ main = defaultMain+ [ bgroup "media"+ [ bench "Data.ByteString.Parser.Char8" $ nf scMedia (cs $! sampleMedia)+ , bench "Data.Attoparsec.ByteString" $ nf acMedia (cs $! sampleMedia)+ , bench "Data.Text.Parser" $ nf stMedia (cs $! sampleMedia)+ , bench "Data.Attoparsec.Text" $ nf atMedia (cs $! sampleMedia)+ ]+ , bgroup "kv"+ [ bench "Data.ByteString.Parser.Char8" $ nf scKeyValue (cs $! sampleKeyValue)+ , bench "Data.Attoparsec.ByteString" $ nf acKeyValue (cs $! sampleKeyValue)+ , bench "Data.Text.Parser" $ nf stKeyValue (cs $! sampleKeyValue)+ , bench "Data.Attoparsec.Text" $ nf atKeyValue (cs $! sampleKeyValue)+ ]+ ]++++ type Media a = (a, a, [(a, a)], Float)++ sampleMedia :: String+ sampleMedia = "text/html, text/plain;q=0.7"+++ sampleKeyValue :: String+ sampleKeyValue = "lst = \"\\\"first\\\", \\\"second\\\", \\\"third\\\"\""+++ {-# NOINLINE scMedia #-}+ scMedia :: ByteString -> Maybe [Media ByteString]+ scMedia = SC.parseOnly (pMediaList <* SC.endOfInput)+ where+ pMedia :: SC.Parser (Media ByteString)+ pMediaList = pMedia `SC.sepBy` pSeparator+ pMedia = do+ mainType <- pToken+ subType <- (SC.char '/' *> pToken) <|> pure ""++ (qs, params) <- partitionEithers <$> SC.many (SC.eitherP pQuality pParameter)++ let quality = fromMaybe 1.0 . listToMaybe $ qs++ return (mainType, subType, params, quality)++ pParameter :: SC.Parser (ByteString, ByteString)+ pParameter = do+ _ <- SC.takeWhile SC.isSpace+ _ <- SC.char ';'+ name <- pToken+ _ <- SC.char '='+ value <- pValue+ return (name, value)++ pQuality :: SC.Parser Float+ pQuality = do+ _ <- SC.takeWhile SC.isSpace+ _ <- SC.char ';'+ _ <- pSpaced $ SC.char 'q'+ _ <- SC.char '='+ SC.fractional++ pToken :: SC.Parser ByteString+ pToken = pSpaced $ SC.takeTill1 isSpecial++ pSeparator :: SC.Parser Char+ pSeparator = pSpaced $ SC.char ','++ pValue :: SC.Parser ByteString+ pValue = pToken <|> pQuotedStr++ pQuotedStr :: SC.Parser ByteString+ pQuotedStr = pSpaced $ pQuoted $ SC.takeWhile isStrChar++ pSpaced :: SC.Parser a -> SC.Parser a+ pSpaced p = p `SC.wrap` SC.takeWhile SC.isSpace++ pQuoted :: SC.Parser a -> SC.Parser a+ pQuoted p = SC.char '"' *> p <* SC.char '"'++ isStrChar :: (Char -> Bool)+ isStrChar c = c /= '\\' && c /= '"'++ isSpecial :: (Char -> Bool)+ isSpecial c = c <= ' '+ || c == '(' || c == ')'+ || c == '<' || c == '>'+ || c == '@' || c == ',' || c == ';'+ || c == ':' || c == '\\'+ || c == '"' || c == '/'+ || c == '[' || c == ']'+ || c == '?' || c == '='++++ {-# NOINLINE acMedia #-}+ acMedia :: ByteString -> Either String [Media ByteString]+ acMedia = AC.parseOnly (pMediaList <* AC.endOfInput)+ where+ pMedia :: AC.Parser (Media ByteString)+ pMediaList = pMedia `AC.sepBy` pSeparator+ pMedia = do+ mainType <- pToken+ subType <- (AC.char '/' *> pToken) <|> pure ""++ (qs, params) <- partitionEithers <$> AC.many' (AC.eitherP pQuality pParameter)++ let quality = fromMaybe 1.0 . listToMaybe $ qs++ return (mainType, subType, params, quality)++ pParameter :: AC.Parser (ByteString, ByteString)+ pParameter = do+ _ <- AC.skipSpace+ _ <- AC.char ';'+ name <- pToken+ _ <- AC.char '='+ value <- pValue+ return (name, value)++ pQuality :: AC.Parser Float+ pQuality = do+ _ <- AC.skipSpace+ _ <- AC.char ';'+ _ <- pSpaced $ AC.char 'q'+ _ <- AC.char '='+ AC.rational++ pToken :: AC.Parser ByteString+ pToken = pSpaced $ AC.takeTill isSpecial++ pSeparator :: AC.Parser Char+ pSeparator = pSpaced $ AC.char ','++ pValue :: AC.Parser ByteString+ pValue = pToken <|> pQuotedStr++ pQuotedStr :: AC.Parser ByteString+ pQuotedStr = pSpaced $ pQuoted $ AC.takeWhile isStrChar++ pSpaced :: AC.Parser a -> AC.Parser a+ pSpaced p = AC.skipSpace *> p <* AC.skipSpace++ pQuoted :: AC.Parser a -> AC.Parser a+ pQuoted p = AC.char '"' *> p <* AC.char '"'++ isStrChar :: (Char -> Bool)+ isStrChar c = c /= '\\' && c /= '"'++ isSpecial :: (Char -> Bool)+ isSpecial c = c <= ' '+ || c == '(' || c == ')'+ || c == '<' || c == '>'+ || c == '@' || c == ',' || c == ';'+ || c == ':' || c == '\\'+ || c == '"' || c == '/'+ || c == '[' || c == ']'+ || c == '?' || c == '='+++ {-# NOINLINE stMedia #-}+ stMedia :: Text -> Maybe [Media Text]+ stMedia = ST.parseOnly (pMediaList <* ST.endOfInput)+ where+ pMedia :: ST.Parser (Media Text)+ pMediaList = pMedia `ST.sepBy` pSeparator+ pMedia = do+ mainType <- pToken+ subType <- (ST.char '/' *> pToken) <|> pure ""++ (qs, params) <- partitionEithers <$> ST.many (ST.eitherP pQuality pParameter)++ let quality = fromMaybe 1.0 . listToMaybe $ qs++ return (mainType, subType, params, quality)++ pParameter :: ST.Parser (Text, Text)+ pParameter = do+ _ <- ST.takeWhile ST.isSpace+ _ <- ST.char ';'+ name <- pToken+ _ <- ST.char '='+ value <- pValue+ return (name, value)++ pQuality :: ST.Parser Float+ pQuality = do+ _ <- ST.takeWhile ST.isSpace+ _ <- ST.char ';'+ _ <- pSpaced $ ST.char 'q'+ _ <- ST.char '='+ ST.fractional++ pToken :: ST.Parser Text+ pToken = pSpaced $ ST.takeTill1 isSpecial++ pSeparator :: ST.Parser Char+ pSeparator = pSpaced $ ST.char ','++ pValue :: ST.Parser Text+ pValue = pToken <|> pQuotedStr++ pQuotedStr :: ST.Parser Text+ pQuotedStr = pSpaced $ pQuoted $ ST.takeWhile isStrChar++ pSpaced :: ST.Parser a -> ST.Parser a+ pSpaced p = p `ST.wrap` ST.takeWhile ST.isSpace++ pQuoted :: ST.Parser a -> ST.Parser a+ pQuoted p = ST.char '"' *> p <* ST.char '"'++ isStrChar :: (Char -> Bool)+ isStrChar c = c /= '\\' && c /= '"'++ isSpecial :: (Char -> Bool)+ isSpecial c = c <= ' '+ || c == '(' || c == ')'+ || c == '<' || c == '>'+ || c == '@' || c == ',' || c == ';'+ || c == ':' || c == '\\'+ || c == '"' || c == '/'+ || c == '[' || c == ']'+ || c == '?' || c == '='++++ {-# NOINLINE atMedia #-}+ atMedia :: Text -> Either String [Media Text]+ atMedia = AT.parseOnly (pMediaList <* AT.endOfInput)+ where+ pMedia :: AT.Parser (Media Text)+ pMediaList = pMedia `AT.sepBy` pSeparator+ pMedia = do+ mainType <- pToken+ subType <- (AT.char '/' *> pToken) <|> pure ""++ (qs, params) <- partitionEithers <$> AT.many' (AT.eitherP pQuality pParameter)++ let quality = fromMaybe 1.0 . listToMaybe $ qs++ return (mainType, subType, params, quality)++ pParameter :: AT.Parser (Text, Text)+ pParameter = do+ _ <- AT.skipSpace+ _ <- AT.char ';'+ name <- pToken+ _ <- AT.char '='+ value <- pValue+ return (name, value)++ pQuality :: AT.Parser Float+ pQuality = do+ _ <- AT.skipSpace+ _ <- AT.char ';'+ _ <- pSpaced $ AT.char 'q'+ _ <- AT.char '='+ AT.rational++ pToken :: AT.Parser Text+ pToken = pSpaced $ AT.takeTill isSpecial++ pSeparator :: AT.Parser Char+ pSeparator = pSpaced $ AT.char ','++ pValue :: AT.Parser Text+ pValue = pToken <|> pQuotedStr++ pQuotedStr :: AT.Parser Text+ pQuotedStr = pSpaced $ pQuoted $ AT.takeWhile isStrChar++ pSpaced :: AT.Parser a -> AT.Parser a+ pSpaced p = AT.skipSpace *> p <* AT.skipSpace++ pQuoted :: AT.Parser a -> AT.Parser a+ pQuoted p = AT.char '"' *> p <* AT.char '"'++ isStrChar :: (Char -> Bool)+ isStrChar c = c /= '\\' && c /= '"'++ isSpecial :: (Char -> Bool)+ isSpecial c = c <= ' '+ || c == '(' || c == ')'+ || c == '<' || c == '>'+ || c == '@' || c == ',' || c == ';'+ || c == ':' || c == '\\'+ || c == '"' || c == '/'+ || c == '[' || c == ']'+ || c == '?' || c == '='+++ scKeyValue :: ByteString -> Maybe (ByteString, ByteString)+ scKeyValue = SC.parseOnly (pKeyValue <* SC.endOfInput)+ where+ pKeyValue = do+ _ <- SC.skipSpace+ key <- SC.takeWhile1 isToken+ _ <- SC.skipSpace+ _ <- SC.skipSpace+ '=' <- SC.char '='+ _ <- SC.skipSpace+ _ <- SC.char '"'+ val <- SC.scan False scanString+ _ <- SC.char '"'+ return (key, val)+++ acKeyValue :: ByteString -> Either String (ByteString, ByteString)+ acKeyValue = AC.parseOnly (pKeyValue <* AC.endOfInput)+ where+ pKeyValue = do+ _ <- AC.skipSpace+ key <- AC.takeWhile1 isToken+ _ <- AC.skipSpace+ '=' <- AC.char '='+ _ <- AC.skipSpace+ _ <- AC.char '"'+ val <- AC.scan False scanString+ _ <- AC.char '"'+ return (key, val)+++ stKeyValue :: Text -> Maybe (Text, Text)+ stKeyValue = ST.parseOnly (pKeyValue <* ST.endOfInput)+ where+ pKeyValue = do+ _ <- ST.skipSpace+ key <- ST.takeWhile1 isToken+ _ <- ST.skipSpace+ _ <- ST.skipSpace+ '=' <- ST.char '='+ _ <- ST.skipSpace+ _ <- ST.char '"'+ val <- ST.scan False scanString+ _ <- ST.char '"'+ return (key, val)+++ atKeyValue :: Text -> Either String (Text, Text)+ atKeyValue = AT.parseOnly (pKeyValue <* AT.endOfInput)+ where+ pKeyValue = do+ _ <- AT.skipSpace+ key <- AT.takeWhile1 isToken+ _ <- AT.skipSpace+ '=' <- AT.char '='+ _ <- AT.skipSpace+ _ <- AT.char '"'+ val <- AT.scan False scanString+ _ <- AT.char '"'+ return (key, val)+++ scanString :: Bool -> Char -> Maybe Bool+ scanString True _ = Just False+ scanString False '"' = Nothing+ scanString False '\\' = Just True+ scanString False _ = Just False+++ isToken :: Char -> Bool+ isToken c = ('A' <= c && c <= 'Z')+ || ('a' <= c && c <= 'z')+ || ('0' <= c && c <= '9')+ || ('_' == c)+ || ('-' == c)+++-- vim:set ft=haskell sw=2 ts=2 et:
+ lib/Data/ByteString/Parser.hs view
@@ -0,0 +1,337 @@+-- |+-- Module : Data.ByteString.Parser+-- License : CC0-1.0+--+-- Maintainer : mordae@anilinux.org+-- Stability : unstable+-- Portability : non-portable (ghc)+--+-- This module provides a parser for 'ByteString'.+--+-- * If you\'d like to parse ASCII text, you might want to take a look at+-- "Data.ByteString.Parser.Char8". It reuses the same 'Parser', but+-- provides functions working with 'Char' instead of 'Word8' as well as+-- more string utilities.+--+-- * If you\'d like to parse Unicode text, look instead at the+-- "Data.Text.Parser". Is is slower, but in a way more correct.+--++module Data.ByteString.Parser+ ( Parser(..)+ , parseOnly++ -- * Bytes+ , byte+ , notByte+ , anyByte+ , satisfy+ , peekByte++ -- * Strings+ , string+ , Data.ByteString.Parser.take+ , scan+ , runScanner+ , Data.ByteString.Parser.takeWhile+ , takeWhile1+ , takeTill+ , takeTill1++ -- * Combinators+ , provided+ , choice+ , Snack.Combinators.count+ , optional+ , eitherP+ , option+ , many+ , many1+ , manyTill+ , sepBy+ , sepBy1+ , wrap+ , match++ -- * End Of Input+ , takeByteString+ , endOfInput+ , atEnd++ -- * Miscelaneous+ -- |+ -- These are all generic methods, but since I sometimes forget about them,+ -- it is nice to have them listed here for reference what writing parsers.+ , Control.Applicative.empty+ , pure+ , guard+ , when+ , unless+ , void+ )+where+ import Prelude hiding (null, length, splitAt, take)++ import Control.Applicative+ import Control.Monad++ import Data.Maybe+ import Data.Word++ import Data.ByteString as BS+ import Data.ByteString.Unsafe as BS++ import Snack.Combinators+++ newtype Parser a =+ Parser+ { runParser :: ByteString -> Maybe (a, ByteString)+ }++ instance Functor Parser where+ {-# INLINE fmap #-}+ fmap fn Parser{runParser} = Parser \inp ->+ case runParser inp of+ Just (res, rest) -> Just (fn res, rest)+ Nothing -> Nothing++ instance Applicative Parser where+ {-# INLINE pure #-}+ pure x = Parser \inp -> Just (x, inp)++ {-# INLINE (<*>) #-}+ (Parser runFn) <*> (Parser runArg) = Parser \inp ->+ case runFn inp of+ Nothing -> Nothing+ Just (fn, rest) ->+ case runArg rest of+ Nothing -> Nothing+ Just (x, rest') -> Just (fn x, rest')++ instance Alternative Parser where+ {-# INLINE empty #-}+ empty = Parser \_ -> Nothing++ {-# INLINE (<|>) #-}+ (Parser runLeft) <|> (Parser runRight) = Parser \inp ->+ case runLeft inp of+ Just r -> Just r+ Nothing -> runRight inp++ instance Monad Parser where+ {-# INLINE (>>=) #-}+ (Parser runLeft) >>= right = Parser \inp ->+ case runLeft inp of+ Nothing -> Nothing+ Just (x, more) -> runParser (right x) more++ instance MonadPlus Parser++ instance MonadFail Parser where+ {-# INLINE CONLIKE fail #-}+ fail _ = mzero+++ -- |+ -- Discards the remaining input and returns just the parse result.+ -- You might want to combine it with 'endOfInput' for the best effect.+ --+ -- Example:+ --+ -- @+ -- parseOnly (pContacts \<* endOfInput) bstr+ -- @+ --+ {-# INLINE CONLIKE parseOnly #-}+ parseOnly :: Parser a -> ByteString -> Maybe a+ parseOnly par = \inp -> fst <$> runParser par inp+++ -- |+ -- Accepts a single, matching byte.+ --+ {-# INLINE CONLIKE byte #-}+ byte :: Word8 -> Parser Word8+ byte c = satisfy (c ==)+++ -- |+ -- Accepts a single, differing byte.+ --+ {-# INLINE CONLIKE notByte #-}+ notByte :: Word8 -> Parser Word8+ notByte c = satisfy (c /=)+++ -- |+ -- Accepts a single byte.+ --+ {-# INLINE anyByte #-}+ anyByte :: Parser Word8+ anyByte = Parser \inp ->+ if null inp+ then Nothing+ else Just (unsafeHead inp, unsafeTail inp)+++ -- |+ -- Accepts a single byte matching the predicate.+ --+ {-# INLINE CONLIKE satisfy #-}+ satisfy :: (Word8 -> Bool) -> Parser Word8+ satisfy isOk = Parser \inp ->+ if null inp+ then Nothing+ else let c = unsafeHead inp+ in if isOk c+ then Just (c, unsafeTail inp)+ else Nothing+++ -- |+ -- Peeks ahead, but does not consume.+ --+ -- Be careful, peeking behind end of the input fails.+ -- You might want to check using 'atEnd' beforehand.+ --+ {-# INLINE peekByte #-}+ peekByte :: Parser Word8+ peekByte = Parser \inp ->+ if null inp+ then Nothing+ else Just (unsafeHead inp, inp)+++ -- |+ -- Accepts a matching string.+ --+ {-# INLINE CONLIKE string #-}+ string :: ByteString -> Parser ByteString+ string str = Parser \inp ->+ let (pfx, sfx) = splitAt (length str) inp+ in case pfx == str of+ True -> Just (pfx, sfx)+ False -> Nothing+++ -- |+ -- Accepts given number of bytes.+ -- Fails when not enough bytes are available.+ --+ {-# INLINE CONLIKE take #-}+ take :: Int -> Parser ByteString+ take n = Parser \inp ->+ if n > length inp+ then Nothing+ else Just (splitAt n inp)+++ -- |+ -- Scans ahead statefully and then accepts whatever bytes the scanner liked.+ -- Scanner returns 'Nothing' to mark end of the acceptable extent.+ --+ {-# INLINE CONLIKE scan #-}+ scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString+ scan state scanner = fst <$> runScanner state scanner+++ -- |+ -- Like 'scan', but also returns the final scanner state.+ --+ {-# INLINE CONLIKE runScanner #-}+ runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)+ runScanner state scanner = Parser \inp ->+ let (state', n) = scanBytes state scanner 0 (unpack inp)+ (res, more) = splitAt n inp+ in Just ((res, state'), more)+++ {-# INLINE scanBytes #-}+ scanBytes :: s -> (s -> Word8 -> Maybe s) -> Int -> [Word8] -> (s, Int)+ scanBytes !state _scanner !n [] = (state, n)+ scanBytes !state scanner !n (x:more) =+ case scanner state x of+ Just state' -> scanBytes state' scanner (succ n) more+ Nothing -> (state, n)+++ -- |+ -- Efficiently consume as long as the input bytes match the predicate.+ -- An inverse of 'takeTill'.+ --+ {-# INLINE CONLIKE takeWhile #-}+ takeWhile :: (Word8 -> Bool) -> Parser ByteString+ takeWhile test = takeTill (not . test)+++ -- |+ -- Like 'Data.ByteString.Parser.takeWhile', but requires at least a single byte.+ --+ {-# INLINE CONLIKE takeWhile1 #-}+ takeWhile1 :: (Word8 -> Bool) -> Parser ByteString+ takeWhile1 test = provided (not . null) $+ Data.ByteString.Parser.takeWhile test+++ -- |+ -- Efficiently consume until a byte matching the predicate is found.+ -- An inverse of 'Data.ByteString.Parser.takeWhile'.+ --+ {-# INLINE CONLIKE takeTill #-}+ takeTill :: (Word8 -> Bool) -> Parser ByteString+ takeTill test = Parser \inp ->+ let n = fromMaybe (length inp) $ findIndex test inp+ in Just (splitAt n inp)+++ -- |+ -- Same as 'takeTill', but requires at least a single byte.+ --+ {-# INLINE CONLIKE takeTill1 #-}+ takeTill1 :: (Word8 -> Bool) -> Parser ByteString+ takeTill1 test = provided (not . null) $+ Data.ByteString.Parser.takeTill test+++ -- |+ -- Makes the parser not only return the result, but also the original+ -- matched extent.+ --+ {-# INLINE CONLIKE match #-}+ match :: Parser a -> Parser (ByteString, a)+ match par = Parser \inp ->+ case runParser par inp of+ Nothing -> Nothing+ Just (x, more) ->+ let n = length more+ in Just ((BS.take n inp, x), more)+++ -- |+ -- Accept whatever input remains.+ --+ {-# INLINE takeByteString #-}+ takeByteString :: Parser ByteString+ takeByteString = Parser \inp -> Just (inp, mempty)+++ -- |+ -- Accepts end of input and fails if we are not there yet.+ --+ {-# INLINE endOfInput #-}+ endOfInput :: Parser ()+ endOfInput = Parser \case+ inp | null inp -> Just ((), inp)+ _otherwise -> Nothing+++ -- |+ -- Returns whether we are at the end of the input yet.+ --+ {-# INLINE atEnd #-}+ atEnd :: Parser Bool+ atEnd = Parser \inp -> Just (null inp, inp)+++-- vim:set ft=haskell sw=2 ts=2 et:
+ lib/Data/ByteString/Parser.hs-boot view
@@ -0,0 +1,14 @@+module Data.ByteString.Parser+where+ import Control.Applicative+ import Data.ByteString (ByteString)++ newtype Parser a =+ Parser+ { runParser :: ByteString -> Maybe (a, ByteString)+ }++ instance Functor Parser+ instance Applicative Parser+ instance Alternative Parser+ instance Monad Parser
+ lib/Data/ByteString/Parser/Char8.hs view
@@ -0,0 +1,335 @@+-- |+-- Module : Data.ByteString.Parser.Char8+-- License : CC0-1.0+--+-- Maintainer : mordae@anilinux.org+-- Stability : unstable+-- Portability : non-portable (ghc)+--+-- This module provides a parser for ASCII 'ByteString'.+--++module Data.ByteString.Parser.Char8+ ( Parser(..)+ , parseOnly++ -- * Characters+ , char+ , notChar+ , anyChar+ , satisfy+ , space+ , isSpace+ , skipSpace+ , peekChar++ -- * Strings+ , string+ , stringCI+ , Data.ByteString.Parser.Char8.take+ , scan+ , runScanner+ , inRange+ , notInRange+ , Data.ByteString.Parser.Char8.takeWhile+ , takeWhile1+ , takeTill+ , takeTill1++ -- * Numbers+ , signed+ , decimal+ , hexadecimal+ , octal+ , fractional++ -- * Combinators+ , provided+ , choice+ , Data.ByteString.Parser.count+ , optional+ , eitherP+ , option+ , many+ , many1+ , manyTill+ , sepBy+ , sepBy1+ , wrap+ , match++ -- * End Of Input+ , takeByteString+ , endOfInput+ , atEnd++ -- * Miscelaneous+ -- |+ -- These are all generic methods, but since I sometimes forget about them,+ -- it is nice to have them listed here for reference what writing parsers.+ , Control.Applicative.empty+ , pure+ , guard+ , when+ , unless+ , void+ )+where+ import Prelude hiding (null, length, splitAt, take)++ import Control.Applicative+ import Control.Monad++ import Data.Maybe+ import Data.Word+ import GHC.Base (unsafeChr)++ import Data.ByteString as BS+ import Data.ByteString.Unsafe as BS++ import Snack.Combinators++ import Data.ByteString.Parser ( Parser(..), parseOnly+ , string, count, match+ , takeByteString, endOfInput, atEnd+ )++ import qualified Data.ByteString.Lex.Fractional as LF+ import qualified Data.ByteString.Lex.Integral as LI+++ -- |+ -- Accepts a single, matching ASCII character.+ --+ {-# INLINE CONLIKE char #-}+ char :: Char -> Parser Char+ char c = satisfy (c ==)+++ -- |+ -- Accepts a single, differing ASCII character.+ --+ {-# INLINE CONLIKE notChar #-}+ notChar :: Char -> Parser Char+ notChar c = satisfy (c /=)+++ -- |+ -- Accepts a single character.+ --+ {-# INLINE anyChar #-}+ anyChar :: Parser Char+ anyChar = Parser \inp ->+ if null inp+ then Nothing+ else Just (w2c (unsafeHead inp), unsafeTail inp)+++ -- |+ -- Accepts a single character matching the predicate.+ --+ {-# INLINE CONLIKE satisfy #-}+ satisfy :: (Char -> Bool) -> Parser Char+ satisfy isOk = Parser \inp ->+ if null inp+ then Nothing+ else let c = w2c (unsafeHead inp)+ in if isOk c+ then Just (c, unsafeTail inp)+ else Nothing+++ -- |+ -- Accepts a single ASCII white space character.+ -- See 'isSpace' for details.+ --+ {-# INLINE space #-}+ space :: Parser Char+ space = satisfy isSpace+++ -- |+ -- Accepts multiple ASCII white space characters.+ -- See 'isSpace' for details.+ --+ {-# INLINE skipSpace #-}+ skipSpace :: Parser ()+ skipSpace = void $ Data.ByteString.Parser.Char8.takeWhile isSpace+++ -- |+ -- True for any of the @[' ', '\\t', '\\n', '\\v', '\\f', '\\r']@ characters.+ --+ -- Please note that "Data.Text.Parser" re-exports 'Data.Char.isString', that+ -- considers more unicode codepoints, making it significantly slower.+ --+ {-# INLINE isSpace #-}+ isSpace :: Char -> Bool+ isSpace c = (c == ' ') || ('\t' <= c && c <= '\r')+++ -- |+ -- Peeks ahead, but does not consume.+ --+ -- Be careful, peeking behind end of the input fails.+ -- You might want to check using 'atEnd' beforehand.+ --+ {-# INLINE peekChar #-}+ peekChar :: Parser Char+ peekChar = Parser \inp ->+ if null inp+ then Nothing+ else Just (w2c (unsafeHead inp), inp)+++ -- |+ -- Accepts a matching string.+ -- Matching is performed in a case-insensitive manner under ASCII.+ --+ {-# INLINE CONLIKE stringCI #-}+ stringCI :: ByteString -> Parser ByteString+ stringCI str = Parser \inp ->+ let (pfx, sfx) = splitAt (length str) inp+ in case toCaseFold pfx == toCaseFold str of+ True -> Just (pfx, sfx)+ False -> Nothing+++ -- |+ -- Perform simple ASCII case folding.+ --+ {-# INLINE toCaseFold #-}+ toCaseFold :: ByteString -> ByteString+ toCaseFold = BS.map foldCase+ where foldCase w | 65 <= w && w <= 90 = w + 32+ foldCase w = w+++ -- |+ -- Accepts given number of characters.+ -- Fails when not enough characters are available.+ --+ {-# INLINE CONLIKE take #-}+ take :: Int -> Parser ByteString+ take n = Parser \inp ->+ if n > length inp+ then Nothing+ else Just (splitAt n inp)+++ -- |+ -- Scans ahead statefully and then accepts whatever bytes the scanner liked.+ -- Scanner returns 'Nothing' to mark end of the acceptable extent.+ --+ {-# INLINE CONLIKE scan #-}+ scan :: s -> (s -> Char -> Maybe s) -> Parser ByteString+ scan state scanner = fst <$> runScanner state scanner+++ -- |+ -- Like 'scan', but also returns the final scanner state.+ --+ {-# INLINE CONLIKE runScanner #-}+ runScanner :: s -> (s -> Char -> Maybe s) -> Parser (ByteString, s)+ runScanner state scanner = Parser \inp -> loop inp state 0+ where+ loop inp !st !n =+ case n >= length inp of+ True -> Just ((inp, st), mempty)+ False ->+ case unsafeIndex inp n of+ w ->+ case scanner st (w2c w) of+ Nothing -> Just ((unsafeTake n inp, st), unsafeDrop n inp)+ Just st' -> loop inp st' (succ n)+++ -- |+ -- Efficiently consume as long as the input characters match the predicate.+ -- An inverse of 'takeTill'.+ --+ {-# INLINE CONLIKE takeWhile #-}+ takeWhile :: (Char -> Bool) -> Parser ByteString+ takeWhile test = takeTill (not . test)+++ -- |+ -- Like 'takeWhile', but requires at least a single character.+ --+ {-# INLINE CONLIKE takeWhile1 #-}+ takeWhile1 :: (Char -> Bool) -> Parser ByteString+ takeWhile1 test = provided (not . null) $+ Data.ByteString.Parser.Char8.takeWhile test+++ -- |+ -- Efficiently consume until a character matching the predicate is found.+ -- An inverse of 'Data.ByteString.Parser.Char8.takeWhile'.+ --+ {-# INLINE CONLIKE takeTill #-}+ takeTill :: (Char -> Bool) -> Parser ByteString+ takeTill test = Parser \inp ->+ let n = fromMaybe (length inp) $ findIndex (test . w2c) inp+ in Just (splitAt n inp)+++ -- |+ -- Same as 'takeTill', but requires at least a single character.+ --+ {-# INLINE CONLIKE takeTill1 #-}+ takeTill1 :: (Char -> Bool) -> Parser ByteString+ takeTill1 test = provided (not . null) $+ Data.ByteString.Parser.Char8.takeTill test+++ -- |+ -- Accepts optional @\'+\'@ or @\'-\'@ character and then applies it to+ -- the following parser result.+ --+ {-# INLINE signed #-}+ signed :: (Num a) => Parser a -> Parser a+ signed runNumber = (char '-' *> fmap negate runNumber)+ <|> (char '+' *> runNumber)+ <|> (runNumber)+++ -- |+ -- Accepts an integral number in the decimal format.+ --+ {-# INLINE decimal #-}+ decimal :: (Integral a) => Parser a+ decimal = Parser LI.readDecimal+++ -- |+ -- Accepts an integral number in the hexadecimal format in either case.+ -- Does not look for @0x@ or similar prefixes.+ --+ {-# INLINE hexadecimal #-}+ hexadecimal :: (Integral a) => Parser a+ hexadecimal = Parser LI.readHexadecimal+++ -- |+ -- Accepts an integral number in the octal format.+ --+ {-# INLINE octal #-}+ octal :: (Integral a) => Parser a+ octal = Parser LI.readOctal+++ -- |+ -- Accepts a fractional number as a decimal optinally followed by a colon+ -- and the fractional part. Does not support exponentiation.+ --+ {-# INLINE fractional #-}+ fractional :: (Fractional a) => Parser a+ fractional = Parser LF.readDecimal+++ {-# INLINE w2c #-}+ w2c :: Word8 -> Char+ w2c = unsafeChr . fromIntegral+++-- vim:set ft=haskell sw=2 ts=2 et:
+ lib/Data/Text/Parser.hs view
@@ -0,0 +1,335 @@+-- |+-- Module : Data.Text.Parser+-- License : CC0-1.0+--+-- Maintainer : mordae@anilinux.org+-- Stability : unstable+-- Portability : non-portable (ghc)+--+-- This module provides a parser for Unicode 'Text'.+--++module Data.Text.Parser+ ( Parser(..)+ , parseOnly++ -- * Characters+ , char+ , notChar+ , anyChar+ , satisfy+ , space+ , isSpace+ , skipSpace+ , peekChar++ -- * Strings+ , string+ , stringCI+ , Data.Text.Parser.take+ , scan+ , runScanner+ , inRange+ , notInRange+ , Data.Text.Parser.takeWhile+ , takeWhile1+ , takeTill+ , takeTill1++ -- * Numbers+ , signed+ , decimal+ , hexadecimal+ , octal+ , fractional++ -- * Combinators+ , provided+ , choice+ , Snack.Combinators.count+ , optional+ , eitherP+ , option+ , many+ , many1+ , manyTill+ , sepBy+ , sepBy1+ , wrap+ , match++ -- * End Of Input+ , takeText+ , endOfInput+ , atEnd++ -- * Miscelaneous+ -- |+ -- These are all generic methods, but since I sometimes forget about them,+ -- it is nice to have them listed here for reference what writing parsers.+ , Control.Applicative.empty+ , pure+ , guard+ , when+ , unless+ , void+ )+where+ import Prelude hiding (null, length, splitAt, take)++ import Control.Applicative+ import Control.Monad++ import Data.Char+ import Data.Maybe++ import Data.Text as T+ import Data.Text.Unsafe as T+ import Data.Text.Encoding as T++ import qualified Data.ByteString as BS+ import qualified Data.ByteString.Parser.Char8 as BSP++ import Snack.Combinators+++ newtype Parser a =+ Parser+ { runParser :: Text -> Maybe (a, Text)+ }++ instance Functor Parser where+ {-# INLINE fmap #-}+ fmap fn Parser{runParser} = Parser \inp ->+ case runParser inp of+ Just (res, rest) -> Just (fn res, rest)+ Nothing -> Nothing++ instance Applicative Parser where+ {-# INLINE pure #-}+ pure x = Parser \inp -> Just (x, inp)++ {-# INLINE (<*>) #-}+ (Parser runFn) <*> (Parser runArg) = Parser \inp ->+ case runFn inp of+ Nothing -> Nothing+ Just (fn, rest) ->+ case runArg rest of+ Nothing -> Nothing+ Just (x, rest') -> Just (fn x, rest')++ instance Alternative Parser where+ {-# INLINE empty #-}+ empty = Parser \_ -> Nothing++ {-# INLINE (<|>) #-}+ (Parser runLeft) <|> (Parser runRight) = Parser \inp ->+ case runLeft inp of+ Just r -> Just r+ Nothing -> runRight inp++ instance Monad Parser where+ {-# INLINE (>>=) #-}+ (Parser runLeft) >>= right = Parser \inp ->+ case runLeft inp of+ Nothing -> Nothing+ Just (x, more) -> runParser (right x) more++ instance MonadPlus Parser++ instance MonadFail Parser where+ {-# INLINE CONLIKE fail #-}+ fail _ = mzero+++ {-# INLINE CONLIKE parseOnly #-}+ parseOnly :: Parser a -> Text -> Maybe a+ parseOnly par = \inp -> fst <$> runParser par inp+++ {-# INLINE CONLIKE satisfy #-}+ satisfy :: (Char -> Bool) -> Parser Char+ satisfy isOk = Parser \inp ->+ if null inp+ then Nothing+ else let c = unsafeHead inp+ in if isOk c+ then Just (c, unsafeTail inp)+ else Nothing+++ {-# INLINE CONLIKE string #-}+ string :: Text -> Parser Text+ string str = Parser \inp ->+ let (pfx, sfx) = splitAt (length str) inp+ in case pfx == str of+ True -> Just (pfx, sfx)+ False -> Nothing+++ {-# INLINE CONLIKE take #-}+ take :: Int -> Parser Text+ take n = Parser \inp ->+ if n > length inp+ then Nothing+ else Just (splitAt n inp)+++ {-# INLINE CONLIKE scan #-}+ scan :: s -> (s -> Char -> Maybe s) -> Parser Text+ scan state scanner = fst <$> runScanner state scanner+++ -- |+ -- Like 'scan', but also returns the final scanner state.+ --+ {-# INLINE CONLIKE runScanner #-}+ runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)+ runScanner state scanner = Parser \inp -> loop inp state 0+ where+ loop inp !st !n =+ case n >= lengthWord8 inp of+ True -> Just ((inp, st), mempty)+ False ->+ case iter inp n of+ Iter c n' ->+ case scanner st c of+ Nothing -> Just ((takeWord8 n inp, st), dropWord8 n inp)+ Just st' -> loop inp st' (n + n')+++ {-# INLINE CONLIKE takeWhile #-}+ takeWhile :: (Char -> Bool) -> Parser Text+ takeWhile test = takeTill (not . test)+++ {-# INLINE CONLIKE takeWhile1 #-}+ takeWhile1 :: (Char -> Bool) -> Parser Text+ takeWhile1 test = provided (not . null) $+ Data.Text.Parser.takeWhile test+++ {-# INLINE CONLIKE takeTill #-}+ takeTill :: (Char -> Bool) -> Parser Text+ takeTill test = Parser \inp ->+ let n = fromMaybe (length inp) $ findIndex test inp+ in Just (splitAt n inp)+++ {-# INLINE CONLIKE takeTill1 #-}+ takeTill1 :: (Char -> Bool) -> Parser Text+ takeTill1 test = provided (not . null) $+ Data.Text.Parser.takeTill test+++ {-# INLINE CONLIKE match #-}+ match :: Parser a -> Parser (Text, a)+ match par = Parser \inp ->+ case runParser par inp of+ Nothing -> Nothing+ Just (x, more) ->+ let n = length more+ in Just ((T.take n inp, x), more)+++ {-# INLINE takeText #-}+ takeText :: Parser Text+ takeText = Parser \inp -> Just (inp, mempty)+++ {-# INLINE endOfInput #-}+ endOfInput :: Parser ()+ endOfInput = Parser \case+ inp | null inp -> Just ((), inp)+ _otherwise -> Nothing+++ {-# INLINE atEnd #-}+ atEnd :: Parser Bool+ atEnd = Parser \inp -> Just (null inp, inp)+++ {-# INLINE CONLIKE char #-}+ char :: Char -> Parser Char+ char c = satisfy (c ==)+++ {-# INLINE space #-}+ space :: Parser Char+ space = satisfy isSpace+++ {-# INLINE skipSpace #-}+ skipSpace :: Parser ()+ skipSpace = void $ Data.Text.Parser.takeWhile isSpace+++ {-# INLINE CONLIKE notChar #-}+ notChar :: Char -> Parser Char+ notChar c = satisfy (c /=)+++ {-# INLINE anyChar #-}+ anyChar :: Parser Char+ anyChar = Parser \inp ->+ if null inp+ then Nothing+ else Just (unsafeHead inp, unsafeTail inp)+++ {-# INLINE peekChar #-}+ peekChar :: Parser Char+ peekChar = Parser \inp ->+ if null inp+ then Nothing+ else Just (unsafeHead inp, inp)+++ {-# INLINE CONLIKE stringCI #-}+ stringCI :: Text -> Parser Text+ stringCI str = Parser \inp ->+ let (pfx, sfx) = splitAt (length str) inp+ in case toCaseFold pfx == toCaseFold str of+ True -> Just (pfx, sfx)+ False -> Nothing+++ {-# INLINE signed #-}+ signed :: (Num a) => Parser a -> Parser a+ signed runNumber = (char '-' *> fmap negate runNumber)+ <|> (char '+' *> runNumber)+ <|> (runNumber)+++ {-# INLINE CONLIKE unsafeWithUtf8 #-}+ unsafeWithUtf8 :: BSP.Parser a -> Parser a+ unsafeWithUtf8 bspar = Parser \inp ->+ let bstr = encodeUtf8 inp+ in case BSP.runParser bspar bstr of+ Nothing -> Nothing+ Just (x, more) ->+ let n = lengthWord8 inp - BS.length more+ in Just (x, dropWord8 n inp)+++ {-# INLINE decimal #-}+ decimal :: (Integral a) => Parser a+ decimal = unsafeWithUtf8 BSP.decimal+++ {-# INLINE hexadecimal #-}+ hexadecimal :: (Integral a) => Parser a+ hexadecimal = unsafeWithUtf8 BSP.hexadecimal+++ {-# INLINE octal #-}+ octal :: (Integral a) => Parser a+ octal = unsafeWithUtf8 BSP.octal+++ {-# INLINE fractional #-}+ fractional :: (Fractional a) => Parser a+ fractional = unsafeWithUtf8 BSP.fractional+++-- vim:set ft=haskell sw=2 ts=2 et:
+ lib/Data/Text/Parser.hs-boot view
@@ -0,0 +1,14 @@+module Data.Text.Parser+where+ import Control.Applicative+ import Data.Text (Text)++ newtype Parser a =+ Parser+ { runParser :: Text -> Maybe (a, Text)+ }++ instance Functor Parser+ instance Applicative Parser+ instance Alternative Parser+ instance Monad Parser
+ lib/Snack/Combinators.hs view
@@ -0,0 +1,224 @@+-- |+-- Module : Snack.Combinators+-- License : CC0-1.0+--+-- Maintainer : mordae@anilinux.org+-- Stability : unstable+-- Portability : non-portable (ghc)+--++module Snack.Combinators+ ( provided+ , choice+ , count+ , eitherP+ , option+ , many1+ , manyTill+ , sepBy+ , sepBy1+ , wrap+ , inRange+ , notInRange+ )+where+ import Control.Applicative+ import Data.Maybe++ import {-# SOURCE #-} qualified Data.ByteString.Parser as BSP+ import {-# SOURCE #-} qualified Data.Text.Parser as TP+++ -- |+ -- Fails if the value returned by the parser does not conform to the+ -- predicate. Generalized form of 'Data.ByteString.Parser.Char8.string'.+ --+ -- Example:+ --+ -- @+ -- pInput = takeWhile isLetter `provided` (odd . length)+ -- @+ --+ {-# INLINE CONLIKE provided #-}+ {-# SPECIALIZE provided :: (a -> Bool) -> BSP.Parser a -> BSP.Parser a #-}+ {-# SPECIALIZE provided :: (a -> Bool) -> TP.Parser a -> TP.Parser a #-}+ provided :: (Alternative m, Monad m) => (a -> Bool) -> m a -> m a+ provided test par = do+ x <- par+ if test x+ then pure x+ else Control.Applicative.empty+++ -- |+ -- Tries various parsers, one by one. Alias for 'asum'.+ --+ -- Example:+ --+ -- @+ -- pExpression = choice [ pConstant+ -- , pVariable+ -- , pBinaryOperation+ -- , pFunctionApplication+ -- ]+ -- @+ --+ {-# INLINE CONLIKE choice #-}+ {-# SPECIALIZE choice :: [BSP.Parser a] -> BSP.Parser a #-}+ {-# SPECIALIZE choice :: [TP.Parser a] -> TP.Parser a #-}+ choice :: (Alternative f) => [f a] -> f a+ choice = asum+++ -- |+ -- Replicates the parser given number of times, collecting the results+ -- in a list. Fails if any instance of the parser fails.+ --+ -- Example:+ --+ -- @+ -- pFourWords = (:) \<$\> word \<*\> count 3 (blank *> word)+ -- where word = takeWhile1 isLetter+ -- blank = takeWhile1 isSpace+ -- @+ --+ {-# INLINE CONLIKE count #-}+ {-# SPECIALIZE count :: Int -> BSP.Parser a -> BSP.Parser [a] #-}+ {-# SPECIALIZE count :: Int -> TP.Parser a -> TP.Parser [a] #-}+ count :: (Monad m) => Int -> m a -> m [a]+ count n p = Prelude.sequence (Prelude.replicate n p)+++ -- |+ -- Captures first parser as @Left@ or the second as @Right@.+ --+ {-# INLINE CONLIKE eitherP #-}+ {-# SPECIALIZE eitherP :: BSP.Parser a -> BSP.Parser b -> BSP.Parser (Either a b) #-}+ {-# SPECIALIZE eitherP :: TP.Parser a -> TP.Parser b -> TP.Parser (Either a b) #-}+ eitherP :: (Alternative f) => f a -> f b -> f (Either a b)+ eitherP left right = (Left <$> left) <|> (Right <$> right)+++ -- |+ -- Shortcut for 'optional' with a default value.+ --+ -- Example:+ --+ -- @+ -- data Contact =+ -- Contact+ -- { contactName :: Text+ -- , contactEmail :: Maybe Text+ -- }+ --+ -- pContact = Contact \<$\> pFullName \<*\> option pEmail+ -- @+ --+ {-# INLINE CONLIKE option #-}+ {-# SPECIALIZE option :: a -> BSP.Parser a -> BSP.Parser a #-}+ {-# SPECIALIZE option :: a -> TP.Parser a -> TP.Parser a #-}+ option :: (Alternative f) => a -> f a -> f a+ option dfl par = fromMaybe dfl <$> optional par+++ -- |+ -- Like 'many1', but requires at least one match.+ --+ {-# INLINE many1 #-}+ {-# SPECIALIZE many1 :: BSP.Parser a -> BSP.Parser [a] #-}+ {-# SPECIALIZE many1 :: TP.Parser a -> TP.Parser [a] #-}+ many1 :: (Alternative f) => f a -> f [a]+ many1 = some+++ -- |+ -- Like 'many', but stops once the second parser matches the input ahead.+ --+ -- Example:+ --+ -- @+ -- pBodyLines = pLine `manyTill` pEnd+ -- where pLine = takeTill (== '\n')+ -- pEnd = string "\n.\n"+ -- @+ --+ {-# INLINE CONLIKE manyTill #-}+ {-# SPECIALIZE manyTill :: BSP.Parser a -> BSP.Parser a -> BSP.Parser [a] #-}+ {-# SPECIALIZE manyTill :: TP.Parser a -> TP.Parser a -> TP.Parser [a] #-}+ manyTill :: (Alternative f) => f a -> f a -> f [a]+ manyTill par stop = loop+ where loop = (stop *> pure []) <|> ((:) <$> par <*> loop)+++ -- |+ -- Similar to 'many', but interleaves the first parser with the second.+ --+ -- Example:+ --+ -- @+ -- pLines = pLine `sepBy` char '\n'+ -- @+ --+ {-# INLINE CONLIKE sepBy #-}+ {-# SPECIALIZE sepBy :: BSP.Parser a -> BSP.Parser b -> BSP.Parser [a] #-}+ {-# SPECIALIZE sepBy :: TP.Parser a -> TP.Parser b -> TP.Parser [a] #-}+ sepBy :: (Alternative f) => f a -> f b -> f [a]+ sepBy par sep = sepBy1 par sep <|> pure []+++ -- |+ -- Like 'sepBy', but requires at least one match.+ --+ {-# INLINE CONLIKE sepBy1 #-}+ {-# SPECIALIZE sepBy1 :: BSP.Parser a -> BSP.Parser b -> BSP.Parser [a] #-}+ {-# SPECIALIZE sepBy1 :: TP.Parser a -> TP.Parser b -> TP.Parser [a] #-}+ sepBy1 :: (Alternative f) => f a -> f b -> f [a]+ sepBy1 par sep = loop+ where loop = (:) <$> par <*> ((sep *> loop) <|> pure [])+++ -- |+ -- Wraps the parser from both sides.+ --+ -- Example:+ --+ -- @+ -- pToken = takeWhile1 (inClass "A-Za-z0-9_") `wrap` takeWhile isSpace+ -- @+ --+ {-# INLINE CONLIKE wrap #-}+ {-# SPECIALIZE wrap :: BSP.Parser a -> BSP.Parser b -> BSP.Parser a #-}+ {-# SPECIALIZE wrap :: TP.Parser a -> TP.Parser b -> TP.Parser a #-}+ wrap :: (Applicative f) => f a -> f b -> f a+ wrap par wrapper = wrapper *> par <* wrapper+++ -- |+ -- Tests whether the character lies within given range.+ --+ -- Definition:+ --+ -- @+ -- inRange lo hi = \c -> (lo <= c && c <= hi)+ -- @+ --+ {-# INLINE CONLIKE inRange #-}+ inRange :: Char -> Char -> Char -> Bool+ inRange lo hi = \c -> (lo <= c && c <= hi)+++ -- |+ -- Negation of 'inRange'.+ --+ -- Definition:+ --+ -- @+ -- notInRange lo hi = \c -> (c <= lo || hi <= c)+ -- @+ --+ {-# INLINE CONLIKE notInRange #-}+ notInRange :: Char -> Char -> Char -> Bool+ notInRange lo hi = \c -> (lo >= c || c >= hi)+++-- vim:set ft=haskell sw=2 ts=2 et:
+ snack.cabal view
@@ -0,0 +1,60 @@+cabal-version: 3.0+name: snack+version: 0.1.0.0+license: MIT+license-file: LICENSE+copyright: Jan Hamal Dvořák+maintainer: mordae@anilinux.org+author: Jan Hamal Dvořák+homepage: https://github.com/mordae/snack#readme+bug-reports: https://github.com/mordae/snack/issues+synopsis: Strict ByteString Parser Combinator+description: Simple parser combinator for strict ByteString values.+category: Text, Parsing+build-type: Simple+extra-source-files:+ README.md+ Changelog.md++source-repository head+ type: git+ location: https://github.com/mordae/snack.git++library+ exposed-modules:+ Data.ByteString.Parser+ Data.ByteString.Parser.Char8+ Data.Text.Parser++ hs-source-dirs: lib+ other-modules: Snack.Combinators+ default-language: GHC2021+ default-extensions: BlockArguments LambdaCase+ ghc-options:+ -Wall -Wcompat -Wincomplete-uni-patterns -Wunused-packages+ -Wincomplete-record-updates -Widentities -Wredundant-constraints++ build-depends:+ base >=4.13 && <5,+ bytestring >=0.11,+ bytestring-lexing >=0.5,+ text >=2.0++benchmark bench+ type: exitcode-stdio-1.0+ main-is: Bench.hs+ hs-source-dirs: bench+ default-language: Haskell2010+ default-extensions: BlockArguments LambdaCase OverloadedStrings+ ghc-options:+ -Wall -Wcompat -Wincomplete-uni-patterns -Wunused-packages+ -Wincomplete-record-updates -Widentities -Wredundant-constraints++ build-depends:+ attoparsec >=0.13,+ base >=4 && <5,+ bytestring >=0.11,+ criterion,+ snack,+ string-conversions,+ text >=2.0