From 5179d5accba4f279c4c926cffb6dcc2b86352f54 Mon Sep 17 00:00:00 2001
From: 3ddy <eivind@hukkelberg.net>
Date: Thu, 9 Jan 2020 12:06:06 +0100
Subject: [PATCH 1/8] added Compactable and Filterable instances to ParserT

---
 bower.json                   |  1 +
 src/Text/Parsing/Parser.purs | 73 ++++++++++++++++++++++++++++++++++--
 2 files changed, 71 insertions(+), 3 deletions(-)

diff --git a/bower.json b/bower.json
index a98673c..5db248e 100644
--- a/bower.json
+++ b/bower.json
@@ -22,6 +22,7 @@
   "dependencies": {
     "purescript-arrays": "^5.0.0",
     "purescript-either": "^4.0.0",
+    "purescript-filterable": "^3.0.2",
     "purescript-foldable-traversable": "^4.0.0",
     "purescript-identity": "^4.0.0",
     "purescript-integers": "^4.0.0",
diff --git a/src/Text/Parsing/Parser.purs b/src/Text/Parsing/Parser.purs
index 55204ad..6d2ad2c 100644
--- a/src/Text/Parsing/Parser.purs
+++ b/src/Text/Parsing/Parser.purs
@@ -9,6 +9,7 @@ module Text.Parsing.Parser
   , runParserT
   , hoistParserT
   , mapParserT
+  , setConsumed
   , consume
   , position
   , fail
@@ -23,11 +24,14 @@ import Control.Lazy (defer, class Lazy)
 import Control.Monad.Error.Class (class MonadThrow, throwError)
 import Control.Monad.Except (class MonadError, ExceptT(..), runExceptT, mapExceptT)
 import Control.Monad.Rec.Class (class MonadRec)
-import Control.Monad.State (class MonadState, StateT(..), evalStateT, gets, mapStateT, modify_, runStateT)
+import Control.Monad.State (class MonadState, StateT(..), evalStateT, get, gets, put, mapStateT, modify_, runStateT)
 import Control.Monad.Trans.Class (class MonadTrans, lift)
 import Control.MonadPlus (class Alternative, class MonadZero, class MonadPlus, class Plus)
+import Data.Compactable (class Compactable)
 import Data.Either (Either(..))
+import Data.Filterable (class Filterable)
 import Data.Identity (Identity)
+import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype, unwrap, over)
 import Data.Tuple (Tuple(..))
 import Text.Parsing.Parser.Pos (Position, initialPos)
@@ -120,10 +124,73 @@ instance monadPlusParserT :: Monad m => MonadPlus (ParserT s m)
 instance monadTransParserT :: MonadTrans (ParserT s) where
   lift = ParserT <<< lift <<< lift
 
+instance compactableParserT :: Monad m => Compactable (ParserT s m) where
+  compact p1 = do
+    state <- get
+    p1 >>= case _ of
+      Just r -> pure r
+      Nothing -> put state *> fail "Parse returned Nothing"
+  separate p1 =
+    { left: do
+      state <- get
+      p1 >>= case _ of
+        Left r -> pure r
+        Right r -> put state *> fail "Parse returned Right"
+    , right: do
+      state <- get
+      p1 >>= case _ of
+        Left r -> put state *> fail "Parse returned Left"
+        Right r -> pure r
+    }
+
+instance filterableParserT :: Monad m => Filterable (ParserT s m) where
+  partitionMap pred p1 =
+    { left: do
+      state <- get
+      p1 <#> pred >>= case _ of
+        Left r -> pure r
+        Right r -> put state *> fail "Predicate returned Right"
+    , right: do
+      state <- get
+      p1 <#> pred >>= case _ of
+        Left r -> put state *> fail "Predicate returned Left"
+        Right r -> pure r
+    }
+  partition pred p1 =
+    { yes: do
+      state <- get
+      r <- p1
+      case pred r of
+        true -> pure r
+        false -> put state *> fail "Result did not satisfy predicate"
+    , no: do
+      state <- get
+      r <- p1
+      case pred r of
+        true -> put state *> fail "Result unexpectedly satisfied predicate"
+        false -> pure r
+    }
+  filterMap pred p1 = do
+    state <- get
+    p1 <#> pred >>= case _ of
+      Just r -> pure r
+      Nothing -> put state *> fail "Predicate returned Nothing"
+  filter pred p1 = do
+    state <- get
+    r <- p1
+    case pred r of
+      true -> pure r
+      false -> put state *> fail "Result did not satisfy predicate"
+
+
+-- | Set or unset the consumed flag.
+setConsumed :: forall s m. Monad m => Boolean -> ParserT s m Unit
+setConsumed bool = modify_ \(ParseState input pos _) ->
+  ParseState input pos bool
+
 -- | Set the consumed flag.
 consume :: forall s m. Monad m => ParserT s m Unit
-consume = modify_ \(ParseState input pos _) ->
-  ParseState input pos true
+consume = setConsumed true
 
 -- | Returns the current position in the stream.
 position :: forall s m. Monad m => ParserT s m Position

From 32db7b4886435706d9d1a84eac2ae1c66aa45611 Mon Sep 17 00:00:00 2001
From: 3ddy <eivind@hukkelberg.net>
Date: Thu, 16 Jan 2020 17:26:27 +0100
Subject: [PATCH 2/8] add tests

---
 test/Main.purs | 41 +++++++++++++++++++++++++++++++++++++++--
 1 file changed, 39 insertions(+), 2 deletions(-)

diff --git a/test/Main.purs b/test/Main.purs
index 8bd3742..0caf3b0 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -6,7 +6,8 @@ import Control.Alt ((<|>))
 import Control.Lazy (fix)
 import Data.Array (some)
 import Data.Either (Either(..))
-import Data.List (List(..), fromFoldable, many)
+import Data.Filterable (filter, filterMap, compact, separate, partition, partitionMap)
+import Data.List (List(..), fromFoldable, many, tail, (:))
 import Data.Maybe (Maybe(..))
 import Data.String.CodeUnits (fromCharArray, singleton)
 import Data.Tuple (Tuple(..))
@@ -14,7 +15,7 @@ import Effect (Effect)
 import Effect.Console (logShow)
 import Test.Assert (assert')
 import Text.Parsing.Parser (Parser, ParserT, runParser, parseErrorPosition)
-import Text.Parsing.Parser.Combinators (endBy1, sepBy1, optionMaybe, try, chainl, between)
+import Text.Parsing.Parser.Combinators (endBy1, sepBy1, sepBy, optionMaybe, try, chainl, between)
 import Text.Parsing.Parser.Expr (Assoc(..), Operator(..), buildExprParser)
 import Text.Parsing.Parser.Language (javaStyle, haskellStyle, haskellDef)
 import Text.Parsing.Parser.Pos (Position(..), initialPos)
@@ -412,6 +413,40 @@ javaStyleTest = do
         "hello {- comment\n -} foo"
         (mkPos 7)
 
+filterableTest :: TestM
+filterableTest = do
+  -- filter does nothing when the predicate returns true
+  parseTest "6" 6 (filter (_ /= 5) digit)
+
+  -- filter acts as if the parser failed when predicate returns false
+  parseErrorTestPosition (filter (_ /= 6) digit) "6" (mkPos 1)
+
+  -- if a result is "filtered away", `alt` will try the next parser
+  parseTest "6" 6
+    $ filter (_ /= 6) digit <|> filter (_ /= 7) digit
+
+  -- using filterMap to elegantly apply a function that returns maybe
+  parseTest "1,2,3,4" (2 : 3 : 4 : Nil)
+    $ filterMap tail (digit `sepBy` string ",")
+
+-- `filterMap f` should be the same as `compact <<< map f`
+  parseTest "1,2,3,4" (2 : 3 : 4 : Nil)
+    $ (compact <<< map tail) (digit `sepBy` string ",")
+
+  -- same as above, throwing an error in the parser if the filterMap fails
+  (\p -> parseErrorTestPosition p "" (mkPos 1))
+    $ filterMap tail (digit `sepBy` string ",")
+
+  parseTest "1" 2
+    $ (_.right <<< separate) (digit $> Right 2)
+
+  parseTest "1" 3
+    $ (_.left <<< partitionMap (\n -> Left $ n + 2)) digit
+
+  -- when run after another parser with *>, correct error position is given
+  (\p -> parseErrorTestPosition p "12" (mkPos 2))
+    $ digit *> (_.yes <<< partition (_ == 3)) digit
+
 main :: Effect Unit
 main = do
 
@@ -493,3 +528,5 @@ main = do
 
   haskellStyleTest
   javaStyleTest
+
+  filterableTest
\ No newline at end of file

From faa71d58987c6f8fec6caddcc62f8c681d2e35bf Mon Sep 17 00:00:00 2001
From: 3ddy <eivind@hukkelberg.net>
Date: Thu, 16 Jan 2020 17:30:07 +0100
Subject: [PATCH 3/8] add unconsume

---
 src/Text/Parsing/Parser.purs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/src/Text/Parsing/Parser.purs b/src/Text/Parsing/Parser.purs
index 6d2ad2c..99a9ba1 100644
--- a/src/Text/Parsing/Parser.purs
+++ b/src/Text/Parsing/Parser.purs
@@ -11,6 +11,7 @@ module Text.Parsing.Parser
   , mapParserT
   , setConsumed
   , consume
+  , unconsume
   , position
   , fail
   , failWithPosition
@@ -192,6 +193,9 @@ setConsumed bool = modify_ \(ParseState input pos _) ->
 consume :: forall s m. Monad m => ParserT s m Unit
 consume = setConsumed true
 
+unconsume :: forall s m. Monad m => ParserT s m Unit
+unconsume = setConsumed false
+
 -- | Returns the current position in the stream.
 position :: forall s m. Monad m => ParserT s m Position
 position = gets \(ParseState _ pos _) -> pos

From b9ba84a9d1109987200231c295d13f39c8ecba21 Mon Sep 17 00:00:00 2001
From: 3ddy <eivind@hukkelberg.net>
Date: Thu, 16 Jan 2020 17:31:55 +0100
Subject: [PATCH 4/8] forgot a doc

---
 src/Text/Parsing/Parser.purs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Text/Parsing/Parser.purs b/src/Text/Parsing/Parser.purs
index 99a9ba1..82bb639 100644
--- a/src/Text/Parsing/Parser.purs
+++ b/src/Text/Parsing/Parser.purs
@@ -193,6 +193,7 @@ setConsumed bool = modify_ \(ParseState input pos _) ->
 consume :: forall s m. Monad m => ParserT s m Unit
 consume = setConsumed true
 
+-- | Unset the consumed flag.
 unconsume :: forall s m. Monad m => ParserT s m Unit
 unconsume = setConsumed false
 

From 8a3c00dd2b00d5e3f0f3a6311865d58d0589fc95 Mon Sep 17 00:00:00 2001
From: 3ddy <eivind@hukkelberg.net>
Date: Thu, 16 Jan 2020 17:44:27 +0100
Subject: [PATCH 5/8] updated to psc-0.13.5 from psc-0.12.0 and added
 filterable dependency in psc-package.json

---
 psc-package.json | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/psc-package.json b/psc-package.json
index ef8e887..71849ab 100644
--- a/psc-package.json
+++ b/psc-package.json
@@ -1,10 +1,11 @@
 {
   "name": "purescript-parsing",
-  "set": "psc-0.12.0",
+  "set": "psc-0.13.5",
   "source": "https://github.com/purescript/package-sets.git",
   "depends": [
     "arrays",
     "either",
+    "filterable",
     "foldable-traversable",
     "identity",
     "integers",

From 664abda96a17f321be70827203c47188e7596a3c Mon Sep 17 00:00:00 2001
From: 3ddy <eivind@hukkelberg.net>
Date: Tue, 21 Jan 2020 16:18:22 +0100
Subject: [PATCH 6/8] add filterMapWithError and filterMapEither

---
 src/Text/Parsing/Parser/Combinators.purs | 23 +++++++++++++++++++++++
 test/Main.purs                           | 16 +++++++++++++++-
 2 files changed, 38 insertions(+), 1 deletion(-)

diff --git a/src/Text/Parsing/Parser/Combinators.purs b/src/Text/Parsing/Parser/Combinators.purs
index df2daa1..38e73dc 100644
--- a/src/Text/Parsing/Parser/Combinators.purs
+++ b/src/Text/Parsing/Parser/Combinators.purs
@@ -28,6 +28,7 @@ import Control.Monad.Except (runExceptT, ExceptT(..))
 import Control.Monad.State (StateT(..), runStateT)
 import Control.Plus (empty, (<|>))
 import Data.Either (Either(..))
+import Data.Filterable (filterMap, partitionMap)
 import Data.Foldable (class Foldable, foldl)
 import Data.List (List(..), (:), many, some, singleton)
 import Data.Maybe (Maybe(..))
@@ -198,3 +199,25 @@ many1Till p end = do
   x <- p
   xs <- manyTill p end
   pure (x:xs)
+
+-- | Parse a phrase, and if it succeeds, run the mapping function over it. If
+-- | the provided parser fails, it will fail normally. If the mapping function
+-- | returns Nothing, the parser will fail with the provided error message.
+filterMapWithError
+  :: forall s a m b
+   . Monad m
+  => (a -> Maybe b) -> String -> ParserT s m a -> ParserT s m b
+filterMapWithError mapper error p =
+  lookAhead p >>= do pure >>> filterMap mapper >>> (_ <|> fail error)
+
+-- | Same as `filterMapWithError`, but instead of providing a string to error
+-- | with, the mapper should return an Either, which is a Right containing the
+-- | new result, or a Left containing the error message.
+filterMapEither
+  :: forall s a m b
+   . Monad m
+  => (a -> Either String b) -> ParserT s m a -> ParserT s m b
+filterMapEither mapper p = lookAhead p >>= do
+  pure
+    >>> partitionMap mapper
+    >>> \{left, right} -> right <|> (left >>= fail)
diff --git a/test/Main.purs b/test/Main.purs
index 0caf3b0..9e31498 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -15,7 +15,7 @@ import Effect (Effect)
 import Effect.Console (logShow)
 import Test.Assert (assert')
 import Text.Parsing.Parser (Parser, ParserT, runParser, parseErrorPosition)
-import Text.Parsing.Parser.Combinators (endBy1, sepBy1, sepBy, optionMaybe, try, chainl, between)
+import Text.Parsing.Parser.Combinators (endBy1, sepBy1, sepBy, optionMaybe, try, chainl, between, filterMapWithError, filterMapEither)
 import Text.Parsing.Parser.Expr (Assoc(..), Operator(..), buildExprParser)
 import Text.Parsing.Parser.Language (javaStyle, haskellStyle, haskellDef)
 import Text.Parsing.Parser.Pos (Position(..), initialPos)
@@ -447,6 +447,20 @@ filterableTest = do
   (\p -> parseErrorTestPosition p "12" (mkPos 2))
     $ digit *> (_.yes <<< partition (_ == 3)) digit
 
+  -- filterMapWithError using Just as the mapper will act just like the original parser
+  parseTest "6" 6
+    $ filterMapWithError Just "shouldn't fail" digit
+
+  -- filterMapEither using Right as the mapper will act just like the original parser
+  parseTest "6" 6
+    $ filterMapEither Right digit
+
+  -- when run after another parser with *>, correct error position is given
+  (\p -> parseErrorTestPosition p "12" (mkPos 2))
+    $ digit *> filterMapEither
+                 (\n -> if n == 2 then Left "error" else Right n)
+                 digit
+
 main :: Effect Unit
 main = do
 

From 66b2a6c1e609d1227bbc9b827ad1ad3346cc5a77 Mon Sep 17 00:00:00 2001
From: 3ddy <eivind@hukkelberg.net>
Date: Mon, 27 Jan 2020 08:06:09 +0100
Subject: [PATCH 7/8] fix indentation

---
 src/Text/Parsing/Parser.purs | 52 ++++++++++++++++++------------------
 1 file changed, 26 insertions(+), 26 deletions(-)

diff --git a/src/Text/Parsing/Parser.purs b/src/Text/Parsing/Parser.purs
index 82bb639..ae5861f 100644
--- a/src/Text/Parsing/Parser.purs
+++ b/src/Text/Parsing/Parser.purs
@@ -133,43 +133,43 @@ instance compactableParserT :: Monad m => Compactable (ParserT s m) where
       Nothing -> put state *> fail "Parse returned Nothing"
   separate p1 =
     { left: do
-      state <- get
-      p1 >>= case _ of
-        Left r -> pure r
-        Right r -> put state *> fail "Parse returned Right"
+        state <- get
+        p1 >>= case _ of
+          Left r -> pure r
+          Right r -> put state *> fail "Parse returned Right"
     , right: do
-      state <- get
-      p1 >>= case _ of
-        Left r -> put state *> fail "Parse returned Left"
-        Right r -> pure r
+        state <- get
+        p1 >>= case _ of
+          Left r -> put state *> fail "Parse returned Left"
+          Right r -> pure r
     }
 
 instance filterableParserT :: Monad m => Filterable (ParserT s m) where
   partitionMap pred p1 =
     { left: do
-      state <- get
-      p1 <#> pred >>= case _ of
-        Left r -> pure r
-        Right r -> put state *> fail "Predicate returned Right"
+        state <- get
+        p1 <#> pred >>= case _ of
+          Left r -> pure r
+          Right r -> put state *> fail "Predicate returned Right"
     , right: do
-      state <- get
-      p1 <#> pred >>= case _ of
-        Left r -> put state *> fail "Predicate returned Left"
-        Right r -> pure r
+        state <- get
+        p1 <#> pred >>= case _ of
+          Left r -> put state *> fail "Predicate returned Left"
+          Right r -> pure r
     }
   partition pred p1 =
     { yes: do
-      state <- get
-      r <- p1
-      case pred r of
-        true -> pure r
-        false -> put state *> fail "Result did not satisfy predicate"
+        state <- get
+        r <- p1
+        case pred r of
+          true -> pure r
+          false -> put state *> fail "Result did not satisfy predicate"
     , no: do
-      state <- get
-      r <- p1
-      case pred r of
-        true -> put state *> fail "Result unexpectedly satisfied predicate"
-        false -> pure r
+        state <- get
+        r <- p1
+        case pred r of
+          true -> put state *> fail "Result unexpectedly satisfied predicate"
+          false -> pure r
     }
   filterMap pred p1 = do
     state <- get

From cd9bb37f88ad11d41ef5eac86511ea01f0452269 Mon Sep 17 00:00:00 2001
From: 3ddy <eivind@hukkelberg.net>
Date: Mon, 27 Jan 2020 08:09:32 +0100
Subject: [PATCH 8/8] fixed pattern matching on some unused values

---
 src/Text/Parsing/Parser.purs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Text/Parsing/Parser.purs b/src/Text/Parsing/Parser.purs
index ae5861f..335a725 100644
--- a/src/Text/Parsing/Parser.purs
+++ b/src/Text/Parsing/Parser.purs
@@ -136,11 +136,11 @@ instance compactableParserT :: Monad m => Compactable (ParserT s m) where
         state <- get
         p1 >>= case _ of
           Left r -> pure r
-          Right r -> put state *> fail "Parse returned Right"
+          Right _ -> put state *> fail "Parse returned Right"
     , right: do
         state <- get
         p1 >>= case _ of
-          Left r -> put state *> fail "Parse returned Left"
+          Left _ -> put state *> fail "Parse returned Left"
           Right r -> pure r
     }
 
@@ -150,11 +150,11 @@ instance filterableParserT :: Monad m => Filterable (ParserT s m) where
         state <- get
         p1 <#> pred >>= case _ of
           Left r -> pure r
-          Right r -> put state *> fail "Predicate returned Right"
+          Right _ -> put state *> fail "Predicate returned Right"
     , right: do
         state <- get
         p1 <#> pred >>= case _ of
-          Left r -> put state *> fail "Predicate returned Left"
+          Left _ -> put state *> fail "Predicate returned Left"
           Right r -> pure r
     }
   partition pred p1 =