flatparse 0.5.3.1 → 0.5.4.0

raw patch · 6 files changed

+324/−3 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• flatparse.cabal +4/−2
• src/FlatParse/Basic.hs +2/−0
• src/FlatParse/Basic/Switch.hs +1/−1
• src/FlatParse/Basic/Text.hs +20/−0
• src/FlatParse/Minimal.hs +283/−0
• src/FlatParse/Minimal/Exception.hs +14/−0

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.1.+-- This file has been generated from package.yaml by hpack version 0.39.6. -- -- see: https://github.com/sol/hpack  name:           flatparse-version:        0.5.3.1+version:        0.5.4.0 synopsis:       High-performance parsing from strict bytestrings description:    @Flatparse@ is a high-performance parsing library for strict bytestring input. See the README for more information:                 <https://github.com/AndrasKovacs/flatparse>.@@ -62,6 +62,8 @@       FlatParse.Common.Switch       FlatParse.Examples.BasicLambda.Lexer       FlatParse.Examples.BasicLambda.Parser+      FlatParse.Minimal+      FlatParse.Minimal.Exception       FlatParse.Stateful       FlatParse.Stateful.Addr       FlatParse.Stateful.Base

@@ -135,7 +135,9 @@    -- *** ASCII-encoded numbers   , FP.Text.anyAsciiDecimalWord+  , FP.Text.anyAsciiDecimalWordCPS   , FP.Text.anyAsciiDecimalInt+  , FP.Text.anyAsciiDecimalIntCPS   , FP.Text.anyAsciiDecimalInteger   , FP.Text.anyAsciiHexWord   , FP.Text.anyAsciiHexInt

@@ -1,7 +1,7 @@ -- | Efficient literal branching using Template Haskell.  module FlatParse.Basic.Switch-  ( switch, switchWithPost, rawSwitchWithPost+  ( switch, switchWithPost, rawSwitchWithPost, genTrie, genSwitchTrie'   ) where  import Control.Monad

@@ -18,7 +18,9 @@    -- ** ASCII-encoded numbers   , anyAsciiDecimalWord+  , anyAsciiDecimalWordCPS   , anyAsciiDecimalInt+  , anyAsciiDecimalIntCPS   , anyAsciiDecimalInteger   , anyAsciiHexWord   , anyAsciiHexInt@@ -203,6 +205,15 @@       (# (##) | #)        -> Fail# st {-# inline anyAsciiDecimalWord #-} +-- | Parse a non-empty ASCII decimal digit sequence as a 'Word'.+--   Fails on overflow.+anyAsciiDecimalWordCPS :: (Word# -> ParserT st e a) -> ParserT st e a+anyAsciiDecimalWordCPS k = ParserT \fp eob s st ->+    case Common.anyAsciiDecimalWord# eob s of+      (# | (# w, s' #) #) -> runParserT# (k w) fp eob s' st+      (# (##) | #)        -> Fail# st+{-# inline anyAsciiDecimalWordCPS #-}+ -- | Parse a non-empty ASCII decimal digit sequence as a positive 'Int'. --   Fails on overflow. anyAsciiDecimalInt :: ParserT st e Int@@ -211,6 +222,15 @@       (# | (# n, s' #) #) -> OK#   st (I# n) s'       (# (##) | #)        -> Fail# st {-# inline anyAsciiDecimalInt #-}++-- | Parse a non-empty ASCII decimal digit sequence as a positive 'Int'.+--   Fails on overflow.+anyAsciiDecimalIntCPS :: (Int -> ParserT st e a) -> ParserT st e a+anyAsciiDecimalIntCPS k = ParserT \fp eob s st ->+    case Common.anyAsciiDecimalInt# eob s of+      (# | (# n, s' #) #) -> runParserT# (k (I# n)) fp eob s' st+      (# (##) | #)        -> Fail# st+{-# inline anyAsciiDecimalIntCPS #-}  -- | Parse a non-empty ASCII decimal digit sequence as a positive 'Integer'. anyAsciiDecimalInteger :: ParserT st e Integer

@@ -0,0 +1,283 @@+{-# language Strict, UnboxedTuples, ImportQualifiedPost, ScopedTypeVariables, TypeApplications #-}+-- {-# options_ghc -ddump-simpl -ddump-to-file -dsuppress-all -dno-suppress-type-signatures #-}++{-|+A stripped-down module that's mostly useful for __deserialization__.++- There's no precise error reporting and no efficient '(<|>)' operator. Internally, we only have+  parsing errors that are represented as an 'IO' exception. This exception can be thrown and caught,+  but the overheads of the exception machinery makes this ill-advised for control flow. Instead, users+  should use 'switch' to branch on tag-like input data.+- It is not possible to build 'ByteString'-s from the input during parsing.+- Since we only use 'IO' exceptions for failure, the implementation does not need to use any unboxed+  sum types. This makes the generated code smaller and faster. Also, __unboxing__ result types works+  robustly, so there's no need to use CPS-style combinators for that.+-}++module FlatParse.Minimal (+    module FlatParse.Minimal+  , module FlatParse.Minimal.Exception+  , FlatParse.Common.Position.Pos(..)+  , FlatParse.Common.Position.endPos+  , FlatParse.Common.Position.addrToPos#+  , FlatParse.Common.Position.posToAddr#+  , FlatParse.Common.Position.Span(..)+  , FlatParse.Common.Position.unsafeSlice+  , Common.strToUtf8+  , Common.utf8ToStr+  ) where++import Control.Exception+import Control.Monad.IO.Class+import GHC.Exts+import GHC.ForeignPtr+import GHC.IO (IO(..))+import Language.Haskell.TH++import Data.ByteString qualified  as B+import Data.ByteString.Internal qualified  as B+import Data.ByteString.Unsafe qualified  as B++import FlatParse.Basic qualified as FPB+import FlatParse.Basic.Switch qualified as FPB+import FlatParse.Common.Assorted qualified as Common+import FlatParse.Common.Numbers qualified as Common+import FlatParse.Common.Position+import FlatParse.Common.Switch qualified as Common+import FlatParse.Minimal.Exception++{-# inline parseError #-}+-- | Throw the designated parse error.+parseError :: Parser a+parseError = Parser \eob s st -> parseError# st++newtype Parser a = Parser# {runParser# :: Addr# -> Addr# -> State# RealWorld -> (# a, Addr#, State# RealWorld #)}++pattern Parser :: (Addr# -> Addr# -> State# RealWorld -> (# a, Addr#, State# RealWorld #))+                  -> Parser a+pattern Parser f <- Parser# f where+  Parser f = Parser# (oneShot \eob s st -> f eob s st)+{-# inline Parser #-}+{-# complete Parser #-}++-- Catching parsing exception+----------------------------------------------------------------------------------------------------++data ParseRes# a = ParseRes# a Addr#++{-# inline parserToIO #-}+parserToIO :: Parser a+           -> (Addr# -> Addr# -> IO (ParseRes# a))+parserToIO (Parser f) eob s =+  IO \st -> case f eob s st of (# a, s, st #) -> (# st, ParseRes# a s #)++{-# inline ioToParser #-}+ioToParser :: (Addr# -> Addr# -> IO (ParseRes# a))+           -> Parser a+ioToParser f = Parser \eob s st ->+  case f eob s of IO f -> case f st of (# st, ParseRes# a s #) -> (# a, s, st #)++-- | Catch a 'ParseException' and retry the second parser. This is not efficient enough for control+--   flow purposes. One use case is in debugging: you can catch and rethrow errors at specific+--   program points where informative debug messages can be printed.+{-# inline catchParseError #-}+catchParseError :: Parser a -> Parser a -> Parser a+catchParseError f g = ioToParser \eob s ->+  catch @ParseException (parserToIO f eob s) \_ -> parserToIO g eob s++----------------------------------------------------------------------------------------------------++instance Functor Parser where+  {-# inline fmap #-}+  fmap = \f (Parser g) -> Parser \eob s st -> case g eob s st of+    (# a, s, st #) -> let b = f a in (# b, s, st #)++  {-# inline (<$) #-}+  (<$) = \a -> fmap (\_ -> a)++instance Applicative Parser where+  {-# inline pure #-}+  pure = \a -> Parser \eob s st -> (# a, s, st #)++  {-# inline (<*>) #-}+  (<*>) = \(Parser mf) (Parser ma) -> Parser \eob s st -> case mf eob s st of+    (# f, s, st #) -> case ma eob s st of+      (# a, s, st #) -> let b = f a in (# b, s, st #)++  {-# inline (<*) #-}+  (<*) = \(Parser ma) (Parser mb) -> Parser \eob s st -> case ma eob s st of+    (# !a, s, st #) -> case mb eob s st of+      (# !b, s, st #) -> (# a, s, st #)++  {-# inline (*>) #-}+  (*>) = \(Parser ma) (Parser mb) -> Parser \eob s st -> case ma eob s st of+    (# !a, s, st #) -> mb eob s st++-- | Variant of 'pure' that does not force its argument.+{-# inline pureLazy #-}+pureLazy :: a -> Parser a+pureLazy = \ a -> Parser \eob s st -> (# a, s, st #)++instance Monad Parser where+  {-# inline return #-}+  return = pure++  {-# inline (>>=) #-}+  (>>=) = \(Parser ma) f -> Parser \eob s st -> case ma eob s st of+    (# !a, s, st #) -> runParser# (f a) eob s st++  {-# inline (>>) #-}+  (>>) = (*>)++instance MonadIO Parser where+  {-# inline liftIO #-}+  liftIO = \(IO ma) -> Parser \eob s st -> case ma st of+    (# st, !a #) -> (# a, s, st #)++-- | End-of-file, else throw error.+{-# inline eof #-}+eof :: Parser ()+eof = Parser \eob s st -> case eqAddr# eob s of+  1# -> (# (), s, st #)+  _  -> parseError# st++-- | Parsing result.+data Result a+  = OK a B.ByteString -- ^ Success case with result value and the remaining input.+  | Error             -- ^ Parsing error.+  deriving Show++-- | Run a parser.+{-# inlinable runParser #-}+runParser :: Parser a -> B.ByteString -> IO (Result a)+runParser (Parser f) b@(B.PS (ForeignPtr _ fp) _ (I# len)) =+  B.unsafeUseAsCString b \(Ptr buf) -> do+    let end = plusAddr# buf len+    (IO \st -> case f end buf st of+      (# a, s, st #) -> let offset = minusAddr# s buf+                            !rest  = B.drop (I# offset) b+                        in (# st, OK a rest  #))+    `catch` \(_ :: ParseException) -> pure Error++{-# inline runParserUtf8 #-}+-- | Run a pure parser on a 'String', converting it to the corresponding UTF-8 bytes.+--   Reminder: @OverloadedStrings@ for 'B.ByteString' does not yield a valid UTF-8+--   encoding! For non-ASCII 'B.ByteString' literal input, use this wrapper or+--   properly convert your input first.+runParserUtf8 :: Parser a -> String -> IO (Result a)+runParserUtf8 p s = runParser p (Common.strToUtf8 s)++-- | Parse a non-empty ASCII decimal digit sequence as a 'Word'.+--   Fails on overflow.+{-# inline anyAsciiDecimalWord #-}+anyAsciiDecimalWord :: Parser Word+anyAsciiDecimalWord = Parser \eob s st -> case Common.anyAsciiDecimalWord# eob s of+  (# | (# x, s #) #) -> (# W# x, s, st #)+  (# _ | #)          -> parseError# st++-- | Parse a non-empty ASCII decimal digit sequence as a positive 'Int'.+--   Fails on overflow.+{-# inline anyAsciiDecimalInt #-}+anyAsciiDecimalInt :: Parser Int+anyAsciiDecimalInt = Parser \eob s st -> case Common.anyAsciiDecimalInt# eob s of+  (# | (# x, s #) #) -> (# I# x, s, st #)+  (# _ | #)          -> parseError# st++-- | Parse a non-empty ASCII decimal digit sequence as a positive 'Integer'.+{-# inline anyAsciiDecimalInteger #-}+anyAsciiDecimalInteger :: Parser Integer+anyAsciiDecimalInteger = unsafeEmbedBasicIO $ FPB.anyAsciiDecimalInteger++{-# inline unsafeEmbedBasicIO #-}+-- | Run a @FlatParse.Basic@ parser. Warning: the parser must not return any 'ByteString'+--   constructed from the input buffer!+unsafeEmbedBasicIO :: FPB.ParserIO () a -> Parser a+unsafeEmbedBasicIO = \(FPB.ParserT f) -> Parser \eob s st ->+  case f FinalPtr eob s st of+    (# st, (# (# !a, s #) | | #) #) -> (# a, s, st #)+    (# st, _                     #) -> parseError# st+++-- | Run a @FlatParse.Minimal@ parser inside a @FlatParse.Basic@ parser.+{-# inline embedMinimal #-}+embedMinimal :: Parser a -> FPB.ParserIO () a+embedMinimal = \(Parser f) -> FPB.ParserT \_ eob s st ->+  case f eob s st of (# !a, s, st #) -> FPB.OK# st a s++{-# inline spanOf #-}+-- | Return the consumed span of a parser.+spanOf :: Parser a -> Parser Span+spanOf (Parser f) = Parser \eob s st -> case f eob s st of+  (# a, s', st' #) -> let span = Span (addrToPos# eob s) (addrToPos# eob s')+                      in (# span, s', st' #)++-- | Skip forward @n@ bytes. Errors if fewer than @n@ bytes are available.  Behavior is undefined if+--   the given number is negative.+{-# inline skip #-}+skip :: Int -> Parser ()+skip = \(I# n) -> Parser \eob s st ->+  case n <=# minusAddr# eob s of+    1# -> (# (), plusAddr# s n, st #)+    _  -> parseError# st++-- | Go back @i@ bytes in the input. Takes a positive integer.+--+-- Extremely unsafe. Makes no checks. Almost certainly a Bad Idea.+{-# inline skipBack #-}+skipBack :: Int -> Parser ()+skipBack = \(I# n) -> Parser \eob s st -> (# (), plusAddr# s (negateInt# n), st #)++----------------------------------------------------------------------------------------------------++-- | Parse a UTF-8 string literal. This is a template function, you can use it as @$(string "foo")@,+--   for example, and the splice has type @Parser e ()@.+string :: String -> Q Exp+string str = [| unsafeEmbedBasicIO $(FPB.bytes (Common.strToBytes str)) |]++-- | Parse a UTF-8 character literal. This is a template function, you can use it as+--   @$(char \'x\')@, for example, and the splice in this case has type @Parser e ()@.+char :: Char -> Q Exp+char c = string [c]++{-|+This is a template function which makes it possible to branch on a collection of string literals in+an efficient way. By using `switch`, such branching is compiled to a trie of primitive parsing+operations, which has optimized control flow, vectorized reads and grouped checking for needed input+bytes.++The syntax is slightly magical, it overloads the usual @case@ expression. An example:++@+    $(switch [| case _ of+        "foo" -> pure True+        "bar" -> pure False |])+@++The underscore is mandatory in @case _ of@. Each branch must be a string literal, but optionally+we may have a default case, like in++@+    $(switch [| case _ of+        "foo" -> pure 10+        "bar" -> pure 20+        _     -> pure 30 |])+@++All case right hand sides must be parsers with the same type. That type is also the type+of the whole 'switch' expression.++A 'switch' has longest match semantics, and the order of cases does not matter, except for+the default case, which may only appear as the last case.++If a 'switch' does not have a default case, and no case matches the input, then it throws an+error. A fallthrough to the default case does not consume any input.+-}+switch :: Q Exp -> Q Exp+switch exp = do+  (!cases, !fallback) <- Common.parseSwitch exp+  !fromMinimal <- [| embedMinimal |]+  !toMinimal   <- [| unsafeEmbedBasicIO |]+  let !cases' = (fmap . fmap) (AppE fromMinimal) cases+  let !fallback' = fmap (AppE fromMinimal) fallback+  !t <- FPB.genTrie $! FPB.genSwitchTrie' Nothing cases' fallback'+  pure $ AppE toMinimal t

@@ -0,0 +1,14 @@+{-# language EmptyCase, PolyKinds, KindSignatures, RankNTypes #-}+{-# options_ghc -Wno-incomplete-patterns #-}++module FlatParse.Minimal.Exception where++import GHC.Exts+import Control.Exception++data ParseException = ParseException deriving Show+instance Exception ParseException++{-# noinline parseError# #-}+parseError# :: forall r (b :: TYPE r). State# RealWorld -> b+parseError# = \st -> case raiseIO# (toException ParseException) st of