simple-parser 0.2.1 → 0.2.2

raw patch · 6 files changed

+104/−14 lines, 6 filesdep +mmorphPVP ok

version bump matches the API change (PVP)

Dependencies added: mmorph

API changes (from Hackage documentation)

Files

• simple-parser.cabal +4/−2
• src/SimpleParser.hs +5/−3
• src/SimpleParser/Examples/Json.hs +2/−3
• src/SimpleParser/Parser.hs +35/−5
• src/SimpleParser/Stream.hs +1/−1
• test/Main.hs +57/−0

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: cae86899037beab7723314f49d8129dda7254a4261348de1d4b2e5ed8ebde7bf+-- hash: 05dbeeb0f7613ae6d38c54b0654472b0b1d48dc401b57a41cae0dc16554fb065  name:           simple-parser-version:        0.2.1+version:        0.2.2 synopsis:       Simple parser combinators description:    Please see the README on GitHub at <https://github.com/ejconlon/simple-parser#readme> category:       Parsing@@ -44,6 +44,7 @@       base >=4.12 && <5     , containers >=0.6 && <0.7     , list-t >=1.0 && <1.1+    , mmorph >=1.1 && <1.2     , mtl >=2.2 && <2.3     , text >=1.2 && <1.3   default-language: Haskell2010@@ -61,6 +62,7 @@       base >=4.12 && <5     , containers >=0.6 && <0.7     , list-t >=1.0 && <1.1+    , mmorph >=1.1 && <1.2     , mtl >=2.2 && <2.3     , simple-parser     , tasty

@@ -1,6 +1,8 @@--- | Re-exports for all modules. See 'SimpleParser.Examples.Json' or the test suit for examples,--- 'SimpleParser.Parser' for the core transformer, 'SimpleParser.Stream' for the source abstraction,--- or 'SimpleParser.Input' for useful combinators.+-- | This is basically a simpler and slower (Mega)Parsec that is fully backtracking by default.+--+-- The root module re-exports all modules. See "SimpleParser.Examples.Json" or the test suit for examples,+-- "SimpleParser.Parser" for the core transformer, "SimpleParser.Stream" for the source abstraction,+-- or "SimpleParser.Input" for useful combinators. module SimpleParser   ( module SimpleParser.Input   , module SimpleParser.Parser

@@ -9,7 +9,6 @@ import Control.Applicative (empty) import Control.Monad (void) import Data.Char (isSpace)-import Data.Foldable (asum) import Data.Text (Text) import Data.Void (Void) import SimpleParser@@ -104,7 +103,7 @@ nullParser = JsonNull <$ nullTok  boolParser :: JsonParser (JsonF a)-boolParser = branchParser [JsonBool True <$ trueTok, JsonBool False <$ falseTok]+boolParser = isolateParser (branchParser [JsonBool True <$ trueTok, JsonBool False <$ falseTok])  objectPairParser :: JsonParser a -> JsonParser (String, a) objectPairParser root = do@@ -120,7 +119,7 @@ arrayParser root = jsonBetween openBracket closeBracket (fmap JsonArray (jsonSepBy root comma))  rootParser :: JsonParser a -> JsonParser (JsonF a)-rootParser root = asum opts where+rootParser root = isolateParser (branchParser opts) where   pairParser = objectPairParser root   opts =     [ objectParser pairParser

@@ -7,6 +7,7 @@   , reflectParser   , branchParser   , suppressParser+  , isolateParser   , defaultParser   , optionalParser   , silenceParser@@ -14,12 +15,14 @@   , greedyStarParser_   , greedyPlusParser   , greedyPlusParser_+  , lookAheadParser   ) where  import Control.Applicative (Alternative (..), liftA2) import Control.Monad (MonadPlus (..), ap, (>=>)) import Control.Monad.Except (MonadError (..)) import Control.Monad.Identity (Identity (..))+import Control.Monad.Morph (MFunctor (..)) import Control.Monad.State (MonadState (..)) import Control.Monad.Trans (MonadTrans (..)) import Data.Foldable (toList)@@ -73,6 +76,9 @@ instance MonadTrans (ParserT e s) where   lift ma = ParserT (\s -> lift (fmap (\a -> ParseResult (ParseSuccess a) s) ma)) +instance MFunctor (ParserT e s) where+  hoist trans (ParserT f) = ParserT (hoist trans . f)+ -- | Runs a non-effectful parser from an inital state and collects all results. runParser :: Parser e s a -> s -> [ParseResult e s a] runParser m s = runIdentity (ListT.toList (runParserT m s))@@ -100,6 +106,7 @@         pure (Just (ParseResult (ParseSuccess v) t, ListT (go rest)))  -- | Combines the results of many parsers.+-- Equvalent to 'asum'. branchParser :: (Foldable f, Monad m) => f (ParserT e s m a) -> ParserT e s m a branchParser = start . toList where   start ps =@@ -115,10 +122,8 @@           r:rs -> run s r rs       Just (a, rest) -> pure (Just (a, rest)) --- | If the parse results in ANY successes, keep only those. Otherwise return all failures.--- This may block indefinitely as it awaits either the end of the parser or its first success.-suppressParser :: Monad m => ParserT e s m a -> ParserT e s m a-suppressParser parser = ParserT (ListT . go [] . runParserT parser) where+gatherParser :: Monad m => Bool -> ParserT e s m a -> ParserT e s m a+gatherParser single parser = ParserT (ListT . go [] . runParserT parser) where   go !acc listt = do     m <- ListT.uncons listt     case m of@@ -126,7 +131,9 @@       Just (r@(ParseResult v _), rest) ->         case v of           ParseError _ -> go (r:acc) rest-          ParseSuccess _ -> pure (Just (r, ListT (filterOk rest)))+          ParseSuccess _ ->+            let t = if single then empty else ListT (filterOk rest)+            in pure (Just (r, t))    returnErr racc =     case racc of@@ -143,6 +150,18 @@           ParseError _ -> nextListt           ParseSuccess _ -> pure (Just (r, ListT nextListt)) +-- | If the parse results in ANY successes, keep only those. Otherwise return all failures.+-- This may block indefinitely as it awaits either the end of the parser or its first success.+-- See 'isolateParser' if you want only one success.+suppressParser :: Monad m => ParserT e s m a -> ParserT e s m a+suppressParser = gatherParser False++-- | If the parse results in ANY successes, keep only THE FIRST. Otherwise return all failures.+-- This may block indefinitely as it awaits either the end of the parser or its first success.+-- See 'suppressParser' if you want all successes.+isolateParser :: Monad m => ParserT e s m a -> ParserT e s m a+isolateParser = gatherParser True+ -- | If the parser yields no results (success or failure), yield a given value. defaultParser :: Monad m => a -> ParserT e s m a -> ParserT e s m a defaultParser def parser = ParserT (\s -> ListT (go s (runParserT parser s))) where@@ -158,6 +177,7 @@ optionalParser parser = defaultParser Nothing (fmap Just parser)  -- | Removes all failures from the parse results.+-- Equivalent to 'catchError (const empty)'. silenceParser :: Monad m => ParserT e s m a -> ParserT e s m a silenceParser parser = ParserT (ListT . go . runParserT parser) where   go listt = do@@ -197,3 +217,13 @@ -- | Same as 'greedyPlusParser' but discards the result. greedyPlusParser_ :: Monad m => ParserT e s m a -> ParserT e s m () greedyPlusParser_ parser = parser *> greedyStarParser_ parser++-- | Yield the results of the given parser, but rewind back to the starting state.+-- Note that these results may contain errors, so you may want to stifle them with 'silenceParser', for example.+lookAheadParser :: Monad m => ParserT e s m a -> ParserT e s m a+lookAheadParser parser = do+  s <- get+  flip catchError (\e -> put s *> throwError e) $ do+    v <- parser+    put s+    pure v

@@ -1,5 +1,5 @@ -- | This reworks 'Text.Megaparsec.Stream' to split interfaces.--- See https://hackage.haskell.org/package/megaparsec-9.0.1/docs/Text-Megaparsec-Stream.html+-- See <https://hackage.haskell.org/package/megaparsec-9.0.1/docs/Text-Megaparsec-Stream.html Text.Megaparsec.Stream>. module SimpleParser.Stream   ( Chunked (..)   , Stream (..)

@@ -425,6 +425,44 @@         ]   in testParserTrees parser cases +test_isolate_success :: [TestTree]+test_isolate_success =+  let state = OffsetStream 0 "hi"+      parser = isolateParser (asum [pure 1, pure 2]) :: TestParser Int+      cases =+        [ ("non-empty", InputOutput "hi" [parseSuccessResult 1 state])+        ]+  in testParserTrees parser cases++test_isolate_fail_first :: [TestTree]+test_isolate_fail_first =+  let err = Error "boo"+      parser = isolateParser (asum [throwError err, pure 2]) :: TestParser Int+      cases =+        [ ("non-empty", InputOutput "hi" [parseSuccessResult 2 (OffsetStream 0 "hi")])+        ]+  in testParserTrees parser cases++test_isolate_fail_second :: [TestTree]+test_isolate_fail_second =+  let err = Error "boo"+      parser = isolateParser (asum [pure 1, throwError err]) :: TestParser Int+      cases =+        [ ("non-empty", InputOutput "hi" [parseSuccessResult 1 (OffsetStream 0 "hi")])+        ]+  in testParserTrees parser cases++test_isolate_fail_both :: [TestTree]+test_isolate_fail_both =+  let state = OffsetStream 0 "hi"+      err1 = Error "boo1"+      err2 = Error "boo2"+      parser = isolateParser (asum [throwError err1, throwError err2]) :: TestParser Int+      cases =+        [ ("non-empty", InputOutput "hi" [parseErrorResult err1 state, parseErrorResult err2 state])+        ]+  in testParserTrees parser cases+ test_silence_success :: [TestTree] test_silence_success =   let state = OffsetStream 0 "hi"@@ -459,6 +497,25 @@       parser = silenceParser (asum [throwError err1, throwError err2]) :: TestParser Int       cases =         [ ("non-empty", InputOutput "hi" [])+        ]+  in testParserTrees parser cases++test_look_ahead_success :: [TestTree]+test_look_ahead_success =+  let parser = lookAheadParser anyToken+      cases =+        [ ("empty", InputOutput "" [])+        , ("non-empty", InputOutput "hi" [parseSuccessResult 'h' (OffsetStream 0 "hi")])+        ]+  in testParserTrees parser cases++test_look_ahead_failure :: [TestTree]+test_look_ahead_failure =+  let err = Error "boo"+      parser = lookAheadParser (anyToken *> throwError err) :: TestParser Char+      cases =+        [ ("empty", InputOutput "" [])+        , ("non-empty", InputOutput "hi" [parseErrorResult err (OffsetStream 0 "hi")])         ]   in testParserTrees parser cases