From 309ed1bfce224eadda9e63494e973fdc076dcaad Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 6 Feb 2026 16:00:30 -0800
Subject: [PATCH 001/103] doc fixes

---
 src/Control/Lens/Grammar.hs        | 3 ++-
 src/Control/Lens/Grammar/Kleene.hs | 2 +-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 27ce10b..64ba174 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -78,7 +78,8 @@ Unfortunately, we can't use TemplateHaskell to generate it in [GHCi]
 which is used to test this documenation.
 Normally we would write `makeNestedPrisms` @''SemVer@,
 but here is equivalent explicit Haskell code instead.
-Since @SemVer@ is a newtype, @_SemVer@ can be an `Control.Lens.Iso.Iso`.
+Since @SemVer@ has only one constructor,
+@_SemVer@ can be an `Control.Lens.Iso.Iso`.
 
 >>> :set -XRecordWildCards
 >>> import Control.Lens (Iso', iso)
diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index f13a1f5..2884553 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -63,7 +63,7 @@ class Monoid k => KleeneStarAlgebra k where
 orK :: (Foldable f, KleeneStarAlgebra k) => f k -> k
 orK = foldl' (>|<) zeroK
 
--- | universal
+-- | existential
 anyK :: (Foldable f, KleeneStarAlgebra k) => (a -> k) -> f a -> k
 anyK f = foldl' (\b a -> b >|< f a) zeroK
 

From 55b8d817d8a79a779a33ad86f8d40262e66a48aa Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sat, 7 Feb 2026 18:05:19 -0800
Subject: [PATCH 002/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 37 ++++++++++++++++++++-----------------
 1 file changed, 20 insertions(+), 17 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 64ba174..b3a94de 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -239,6 +239,9 @@ Just "1+2*3"
 >>> do pr <- printG arithGrammar (Num 69); return (pr "") :: Maybe String
 Just "69"
 
+If all `rule`s are non-recursive, then a `Grammar`
+can be rewritten as a `RegGrammar`.
+
 -}
 type Grammar token a = forall p.
   ( Lexical token p
@@ -246,19 +249,7 @@ type Grammar token a = forall p.
   , Alternator p
   ) => p a a
 
-{- |
-In addition to context-sensitivity via `Monadic` combinators,
-`CtxGrammar`s adds general filtration via `Filtrator` to `Grammar`s.
-
->>> :{
-palindromeG :: CtxGrammar Char String
-palindromeG = rule "palindrome" $
-  satisfied (\wrd -> reverse wrd == wrd) >?< manyP (anyToken @Char)
-:}
-
-The `satisfied` pattern is used together with the `Choice` &
-`Data.Profunctor.Cochoice` applicator `>?<` for general filtration.
-For context-sensitivity,
+{- | For context-sensitivity,
 the `Monadic` interface is used by importing "Data.Profunctor.Monadic"
 qualified and using a "bonding" notation which mixes
 "idiom" style with qualified do-notation.
@@ -291,15 +282,15 @@ The qualified do-notation changes the signature of
 @P.@`Data.Profunctor.Monadic.>>=`,
 so that we must apply the constructor pattern @_LenVec@
 to the do-block with the `>?` applicator.
-Any bound named variable, @var <- action@,
+Any scoped bound action, @var <- action@,
 gets "bonded" to the constructor pattern.
 Any unbound actions, except for the last action in the do-block,
 does not get bonded to the pattern.
 The last action does get bonded to the pattern.
-Any unnamed bound action, @_ <- action@,
+Any unscoped bound action, @_ <- action@,
 also gets bonded to the pattern,
-but being unnamed means it isn't added to the context.
-If all bound actions are unnamed, then a `CtxGrammar` can
+but being unscoped means it isn't added to the context.
+If all bound actions are unscoped, then a `CtxGrammar` can
 be rewritten as a `Grammar` since it is context-free.
 We can't generate a `RegBnf` since the `rule`s
 of a `CtxGrammar` aren't static, but dynamic and contextual.
@@ -313,6 +304,18 @@ We can generate parsers and printers as expected.
 ["2;6,7"]
 >>> [pr "" | pr <- printG lenvecGrammar (LenVec 200 [100])] :: [String]
 []
+
+In addition to context-sensitivity via `Monadic` combinators,
+`CtxGrammar`s adds general filtration via `Filtrator` to `Grammar`s.
+The `satisfy` function can be used as a general predicate character class.
+And the `satisfied` pattern is used together with the `Choice` &
+`Data.Profunctor.Cochoice` applicator `>?<` for general filtration.
+
+>>> :{
+palindromeG :: CtxGrammar Char String
+palindromeG = rule "palindrome" $
+  satisfied (\wrd -> reverse wrd == wrd) >?< manyP (anyToken @Char)
+:}
 >>> [pal | word <- ["racecar", "word"], (pal, "") <- parseG palindromeG word]
 ["racecar"]
 -}

From cdc8f7d40f2fb27cca21f9b736c310d16f1ed2b3 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sat, 7 Feb 2026 18:28:08 -0800
Subject: [PATCH 003/103] Update Distributor.hs

---
 src/Data/Profunctor/Distributor.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index 1d2fd37..231d5ad 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -15,8 +15,6 @@ module Data.Profunctor.Distributor
   , Alternator (..)
   , choice
   , option
-    -- * Homogeneous
-  , Homogeneous (..)
     -- * SepBy
   , SepBy (..)
   , sepBy
@@ -26,6 +24,8 @@ module Data.Profunctor.Distributor
   , chain
   , chain1
   , intercalateP
+    -- * Homogeneous
+  , Homogeneous (..)
   ) where
 
 import Control.Applicative hiding (WrappedArrow)

From 6cbf0947bc2862e8bc3817632139a2be0a9a3fb1 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sat, 7 Feb 2026 19:01:58 -0800
Subject: [PATCH 004/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index b3a94de..0e1358e 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -316,6 +316,7 @@ palindromeG :: CtxGrammar Char String
 palindromeG = rule "palindrome" $
   satisfied (\wrd -> reverse wrd == wrd) >?< manyP (anyToken @Char)
 :}
+
 >>> [pal | word <- ["racecar", "word"], (pal, "") <- parseG palindromeG word]
 ["racecar"]
 -}
@@ -446,6 +447,8 @@ newtype RegString = RegString {runRegString :: RegEx Char}
 
 {- | `RegBnf`s are an embedded domain specific language
 of Backus-Naur forms extended by regular expression strings.
+A `RegBnf` consists of a distinguished `RegString` "start" rule,
+and a set of named `RegString` `rule`s.
 Like `RegString`s they have a string-like interface.
 
 >>> let bnf = fromString "{start} = foo|bar" :: RegBnf
@@ -453,6 +456,11 @@ Like `RegString`s they have a string-like interface.
 {start} = foo|bar
 >>> bnf
 "{start} = foo|bar"
+>>> rule "baz" bnf
+"{start} = \\q{baz}\n{baz} = foo|bar"
+>>> putStringLn (ruleRec "infloop" (\x -> x) :: RegBnf)
+{start} = \q{infloop}
+{infloop} = \q{infloop}
 
 `RegBnf`s can be generated from context-free `Grammar`s with `regbnfG`.
 

From 394c2c8783c5342d28ef5b38365b5a1e71ab9cde Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sat, 7 Feb 2026 19:46:30 -0800
Subject: [PATCH 005/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 0e1358e..4f01907 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -456,11 +456,8 @@ Like `RegString`s they have a string-like interface.
 {start} = foo|bar
 >>> bnf
 "{start} = foo|bar"
->>> rule "baz" bnf
-"{start} = \\q{baz}\n{baz} = foo|bar"
->>> putStringLn (ruleRec "infloop" (\x -> x) :: RegBnf)
-{start} = \q{infloop}
-{infloop} = \q{infloop}
+>>> :type toList bnf
+toList bnf :: [Char]
 
 `RegBnf`s can be generated from context-free `Grammar`s with `regbnfG`.
 
@@ -470,6 +467,13 @@ regbnfG regbnfGrammar :: RegBnf
 Like `RegString`s, `RegBnf`s can be constructed using
 `Lexical`, `Monoid` and `KleeneStarAlgebra` combinators.
 But they also support `BackusNaurForm` `rule`s and `ruleRec`s.
+
+>>> putStringLn (rule "baz" (bnf >|< terminal "baz"))
+{start} = \q{baz}
+{baz} = foo|bar|baz
+>>> putStringLn (ruleRec "∞" (\x -> x) :: RegBnf)
+{start} = \q{∞}
+{∞} = \q{∞}
 -}
 newtype RegBnf = RegBnf {runRegBnf :: Bnf RegString}
   deriving newtype

From 8b74db88d63a21ca0f8e7c38affdb17c8381d8e3 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sat, 7 Feb 2026 20:13:05 -0800
Subject: [PATCH 006/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 4f01907..242ff48 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -307,7 +307,7 @@ We can generate parsers and printers as expected.
 
 In addition to context-sensitivity via `Monadic` combinators,
 `CtxGrammar`s adds general filtration via `Filtrator` to `Grammar`s.
-The `satisfy` function can be used as a general predicate character class.
+The `satisfy` function is a general character class.
 And the `satisfied` pattern is used together with the `Choice` &
 `Data.Profunctor.Cochoice` applicator `>?<` for general filtration.
 

From c5fe85b0523b7be1a16d850d50cc10f5fe653ef6 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sat, 7 Feb 2026 20:48:11 -0800
Subject: [PATCH 007/103] Update Boole.hs

---
 src/Control/Lens/Grammar/Boole.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Control/Lens/Grammar/Boole.hs b/src/Control/Lens/Grammar/Boole.hs
index f5a5cef..3a5b2ec 100644
--- a/src/Control/Lens/Grammar/Boole.hs
+++ b/src/Control/Lens/Grammar/Boole.hs
@@ -74,8 +74,8 @@ allB f = foldl' (\b a -> b >&&< f a) (fromBool True)
 anyB :: (Foldable f, BooleanAlgebra b) => (a -> b) -> f a -> b
 anyB f = foldl' (\b a -> b >||< f a) (fromBool False)
 
--- | `TokenTest` forms a closed `Tokenized` `BooleanAlgebra`
--- of `Categorized` `tokenClass`es.
+-- | `TokenTest` forms a closed `Tokenized` `BooleanAlgebra`,
+-- for use an an argument to `tokenClass`.
 newtype TokenTest token = TokenTest (RegExam token (TokenTest token))
 
 -- | `TokenAlgebra` extends `Tokenized` methods to support

From 26cd2b0a65145b95dd704aebb324eaf6c9fa8b75 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 12 Feb 2026 12:00:08 -0800
Subject: [PATCH 008/103] Caveat notes

Notes that some definitions are more powerful than name implies (bad for RegGrammar and good for CtxGrammar)

Thanks to @mniip for bringing the latter to my awareness.
---
 src/Control/Lens/Grammar.hs | 15 ++++++++++++++-
 1 file changed, 14 insertions(+), 1 deletion(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 242ff48..cf6d204 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -23,7 +23,7 @@ module Control.Lens.Grammar
   , RegBnf (..)
   , regbnfG
   , regbnfGrammar
-    -- * Context-sensitive grammar
+    -- * Unrestricted, context-sensitive grammar
   , CtxGrammar
   , printG
   , parseG
@@ -242,6 +242,11 @@ Just "69"
 If all `rule`s are non-recursive, then a `Grammar`
 can be rewritten as a `RegGrammar`.
 
+Since Haskell permits general recursion, and `RegGrammar`s are
+embedded in Haskell, one can define context-free grammars with them,
+but its recommended to use `Grammar`s for `rule` abstraction
+and generator support.
+
 -}
 type Grammar token a = forall p.
   ( Lexical token p
@@ -319,6 +324,14 @@ palindromeG = rule "palindrome" $
 
 >>> [pal | word <- ["racecar", "word"], (pal, "") <- parseG palindromeG word]
 ["racecar"]
+
+Since Haskell permits computable predicates,
+`CtxGrammar`s are embedded in Haskell,
+and `Filtrator` is implied by the `Monadic` `Altenator` combinator `mfiltrate`,
+the context-sensitivity of `CtxGrammar` also yields
+general filtration, or _unrestricted_ grammars,
+which can parse recursively enumerable languages.
+
 -}
 type CtxGrammar token a = forall p.
   ( Lexical token p

From 585702e9bd0b2817ef8c43b54eef917084b749ff Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 12 Feb 2026 12:30:49 -0800
Subject: [PATCH 009/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 24 +++++++++++++++---------
 1 file changed, 15 insertions(+), 9 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index cf6d204..a7a95ac 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -56,8 +56,9 @@ import Witherable
 {- |
 A regular grammar may be constructed using
 `Lexical` and `Alternator` combinators.
+
 Let's see an example using
-[semantic versioning](https://semver.org/).
+[semantic versioning](https://semver.org/) syntax.
 
 >>> import Numeric.Natural (Natural)
 >>> :{
@@ -222,7 +223,7 @@ arithGrammar = ruleRec "arith" sumG
       _Num . iso show read >? someP (asIn @Char DecimalNumber)
 :}
 
-We can generate a `RegBnf`, printers and parsers from @arithGrammar@.
+We can generate grammar strings, printers and parsers from @arithGrammar@.
 
 >>> putStringLn (regbnfG arithGrammar)
 {start} = \q{arith}
@@ -231,7 +232,6 @@ We can generate a `RegBnf`, printers and parsers from @arithGrammar@.
 {number} = \p{Nd}+
 {product} = \q{factor}(\*\q{factor})*
 {sum} = \q{product}(\+\q{product})*
-
 >>> [x | (x,"") <- parseG arithGrammar "1+2*3+4"]
 [Add (Add (Num 1) (Mul (Num 2) (Num 3))) (Num 4)]
 >>> unparseG arithGrammar (Add (Num 1) (Mul (Num 2) (Num 3))) "" :: Maybe String
@@ -241,11 +241,10 @@ Just "69"
 
 If all `rule`s are non-recursive, then a `Grammar`
 can be rewritten as a `RegGrammar`.
-
 Since Haskell permits general recursion, and `RegGrammar`s are
-embedded in Haskell, one can define context-free grammars with them,
-but its recommended to use `Grammar`s for `rule` abstraction
-and generator support.
+embedded in Haskell, you can define context-free grammars with them.
+But it's recommended to use `Grammar`s for `rule` abstraction
+and generator support for `ruleRec`.
 
 -}
 type Grammar token a = forall p.
@@ -354,8 +353,9 @@ type Lexical token p =
   ) :: Constraint
 
 {- | `RegString`s are an embedded domain specific language
-of regular expression strings. Since they are strings,
-they have a string-like interface.
+of regular expression strings.
+
+Since they are strings, they have a string-like interface.
 
 >>> let rex = fromString "ab|c" :: RegString
 >>> putStringLn rex
@@ -460,8 +460,14 @@ newtype RegString = RegString {runRegString :: RegEx Char}
 
 {- | `RegBnf`s are an embedded domain specific language
 of Backus-Naur forms extended by regular expression strings.
+
 A `RegBnf` consists of a distinguished `RegString` "start" rule,
 and a set of named `RegString` `rule`s.
+
+>>> putStringLn (rule "baz" (terminal "foo" >|< terminal "bar") :: RegBnf)
+{start} = \q{baz}
+{baz} = foo|bar
+
 Like `RegString`s they have a string-like interface.
 
 >>> let bnf = fromString "{start} = foo|bar" :: RegBnf

From a640e69f4c5b65e60d2e720a597a799beddb924f Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 12 Feb 2026 12:34:46 -0800
Subject: [PATCH 010/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index a7a95ac..0f82960 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -56,7 +56,6 @@ import Witherable
 {- |
 A regular grammar may be constructed using
 `Lexical` and `Alternator` combinators.
-
 Let's see an example using
 [semantic versioning](https://semver.org/) syntax.
 

From bf9881705b385c1d3c48895cd5ff0ed056579aa9 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 12 Feb 2026 12:45:46 -0800
Subject: [PATCH 011/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 0f82960..ce60a59 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -293,8 +293,8 @@ The last action does get bonded to the pattern.
 Any unscoped bound action, @_ <- action@,
 also gets bonded to the pattern,
 but being unscoped means it isn't added to the context.
-If all bound actions are unscoped, then a `CtxGrammar` can
-be rewritten as a `Grammar` since it is context-free.
+If all bound actions are unscoped, and filtration isn't used,
+then a `CtxGrammar` can be rewritten as a `Grammar` since it is context-free.
 We can't generate a `RegBnf` since the `rule`s
 of a `CtxGrammar` aren't static, but dynamic and contextual.
 We can generate parsers and printers as expected.

From 5affb7ed311a5178343e99559e0cef3a912ba949 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 16 Feb 2026 13:26:58 -0800
Subject: [PATCH 012/103] imprism

---
 src/Control/Lens/Monocle.hs     | 11 +++++++++++
 src/Data/Profunctor/Monoidal.hs | 12 ++++++++++++
 2 files changed, 23 insertions(+)

diff --git a/src/Control/Lens/Monocle.hs b/src/Control/Lens/Monocle.hs
index c2d055e..40afc8f 100644
--- a/src/Control/Lens/Monocle.hs
+++ b/src/Control/Lens/Monocle.hs
@@ -19,6 +19,7 @@ module Control.Lens.Monocle
   , monocle
   , withMonocle
   , cloneMonocle
+  , imprism
   , mapMonocle
   , ditraversed
   , forevered
@@ -61,6 +62,16 @@ monomorphically typed `Monocle` for different purposes.
 cloneMonocle :: AMonocle s t a b -> Monocle s t a b
 cloneMonocle mon = unwrapPafb . mapMonocle mon . WrapPafb
 
+{- | Convert a `Monocle` to an improper `Prism`.
+
+>>> review (imprism (ditraversed @Complex)) (1 :: Double)
+1.0 :+ 1.0
+>>> preview (imprism (ditraversed)) (1 :+ 2 :: Complex Double)
+Just 1.0
+-}
+imprism :: Monocle s t a b -> Prism s t a b
+imprism mon = clonePrism mon
+
 {- | Build a `Monocle` from a `Traversable` & `Distributive`,
 homogeneous, countable product.
 
diff --git a/src/Data/Profunctor/Monoidal.hs b/src/Data/Profunctor/Monoidal.hs
index b1aefa7..91d1d60 100644
--- a/src/Data/Profunctor/Monoidal.hs
+++ b/src/Data/Profunctor/Monoidal.hs
@@ -25,6 +25,7 @@ import Control.Applicative qualified as Ap (WrappedArrow)
 import Control.Arrow
 import Control.Lens hiding (chosen)
 import Control.Lens.Internal.Context
+import Control.Lens.Internal.Prism
 import Control.Lens.Internal.Profunctor
 import Control.Lens.PartialIso
 import Data.Bifunctor.Clown
@@ -247,3 +248,14 @@ instance (Profunctor p, Alternative (p a))
     empty = proreturn empty
     ab <|> cd = proreturn (proextract ab <|> proextract cd)
     many = proreturn . many . proextract
+instance Applicative (Market a b s) where
+  pure t = Market (pure t) (pure (Left t))
+  Market f0 g0 <*> Market f1 g1 = Market
+    (\b -> f0 b (f1 b))
+    (\s ->
+      case g0 s of
+        Left bt -> case g1 s of
+          Left b -> Left (bt b)
+          Right a -> Right a
+        Right a -> Right a
+    )

From ad5bddd3528a918b3b4977aa44548c7047f71cad Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 16 Feb 2026 13:39:09 -0800
Subject: [PATCH 013/103] filtration & partiality clarity

---
 src/Control/Lens/Grammar.hs        | 9 ++++-----
 src/Control/Lens/PartialIso.hs     | 2 +-
 src/Data/Profunctor/Distributor.hs | 2 +-
 src/Data/Profunctor/Filtrator.hs   | 6 +++---
 4 files changed, 9 insertions(+), 10 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index ce60a59..f6c6c87 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -323,11 +323,10 @@ palindromeG = rule "palindrome" $
 >>> [pal | word <- ["racecar", "word"], (pal, "") <- parseG palindromeG word]
 ["racecar"]
 
-Since Haskell permits computable predicates,
-`CtxGrammar`s are embedded in Haskell,
-and `Filtrator` is implied by the `Monadic` `Altenator` combinator `mfiltrate`,
-the context-sensitivity of `CtxGrammar` also yields
-general filtration, or _unrestricted_ grammars,
+Since `CtxGrammar`s are embedded in Haskell which permits computable predicates,
+and `Filtrator` has a default definition for `Monadic` `Alternator`s,
+the context-sensitivity of `CtxGrammar` implies
+general filtration of unrestricted grammars,
 which can parse recursively enumerable languages.
 
 -}
diff --git a/src/Control/Lens/PartialIso.hs b/src/Control/Lens/PartialIso.hs
index 64c927a..be822a2 100644
--- a/src/Control/Lens/PartialIso.hs
+++ b/src/Control/Lens/PartialIso.hs
@@ -222,7 +222,7 @@ infixl 4 >?
 (?<) pat = withPrism pat $ \f g -> unright . dimap (either id f) g
 infixl 4 ?<
 
-{- | Action of `APartialIso` on `Choice` and `Cochoice` `Profunctor`s. -}
+{- | Action of `APartialIso` on `Choice` & `Cochoice` partial profunctors. -}
 (>?<)
   :: (Choice p, Cochoice p)
   => APartialIso s t a b
diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index 231d5ad..f74b342 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -330,7 +330,7 @@ class (Choice p, Distributor p, forall x. Alternative (p x))
     prop> zeroP = empty
     prop> x >+< y = alternate (Left x) <|> alternate (Right y)
 
-    `alternate` has a default for `Cochoice`.
+    `alternate` has a default for `Choice` & `Cochoice` partial profunctors.
     -}
     alternate
       :: Either (p a b) (p c d)
diff --git a/src/Data/Profunctor/Filtrator.hs b/src/Data/Profunctor/Filtrator.hs
index 75a1e42..4538d09 100644
--- a/src/Data/Profunctor/Filtrator.hs
+++ b/src/Data/Profunctor/Filtrator.hs
@@ -42,7 +42,7 @@ class (Cochoice p, forall x. Filterable (p x))
 
     `filtrate` is a distant relative to `Data.Either.partitionEithers`.
 
-    `filtrate` has a default for `Choice`.
+    `filtrate` has a default for `Choice` & `Cochcoice` partial profunctors.
     -}
     filtrate
       :: p (Either a c) (Either b d)
@@ -56,9 +56,9 @@ class (Cochoice p, forall x. Filterable (p x))
       &&&
       dimapMaybe (Just . Right) (either (const Nothing) Just)
 
--- | `mfiltrate` can be used as `filtrate`, for `Monadic` `Alternator`s.
+-- | `Filtrator` has a default definition for `Monadic` `Alternator`s.
 --
--- prop> mfiltrate = filtrate
+-- prop> filtrate = mfiltrate
 mfiltrate
   :: (Monadic p, Alternator p)
   => p (Either a c) (Either b d)

From 5042384f0bef03f27ede6f6a284c35f67c401397 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 16 Feb 2026 14:01:03 -0800
Subject: [PATCH 014/103] testing for Brzozowski Matching

unfortunately it's quite slow for most of the grammars with a lot of monoidal sequencing on large example strings

I only enabled testing for regexGrammar and arithGrammar.
---
 test/Main.hs | 48 +++++++++++++++++++++++++++---------------------
 1 file changed, 27 insertions(+), 21 deletions(-)

diff --git a/test/Main.hs b/test/Main.hs
index 06bb306..155ccb9 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -3,6 +3,7 @@ module Main (main) where
 import Data.Foldable hiding (toList)
 import Data.Maybe (listToMaybe)
 import Control.Lens.Grammar
+import Control.Lens.Grammar.BackusNaur
 import Test.DocTest
 import Test.Hspec
 
@@ -18,14 +19,14 @@ main :: IO ()
 main = do
   doctests
   hspec $ do
-    testGrammar "regexGrammar" regexGrammar regexExamples
-    testGrammar "semverGrammar" semverGrammar semverExamples
-    testGrammar "semverCtxGrammar" semverCtxGrammar semverExamples
-    testGrammar "arithGrammar" arithGrammar arithExamples
-    testGrammar "jsonGrammar" jsonGrammar jsonExamples
-    testGrammar "sexprGrammar" sexprGrammar sexprExamples
-    testGrammar "lambdaGrammar" lambdaGrammar lambdaExamples
-    testGrammar "lenvecGrammar" lenvecGrammar lenvecExamples
+    describe "regexGrammar" $ for_ regexExamples $ testGrammarExample regexGrammar
+    describe "semverGrammar" $ for_ semverExamples $ testCtxGrammarExample semverGrammar
+    describe "semverCtxGrammar" $ for_ semverExamples $ testCtxGrammarExample semverCtxGrammar
+    describe "arithGrammar" $ for_ arithExamples $ testGrammarExample arithGrammar
+    describe "jsonGrammar" $ for_ jsonExamples $ testCtxGrammarExample jsonGrammar
+    describe "sexprGrammar" $ for_ sexprExamples $ testCtxGrammarExample sexprGrammar
+    describe "lambdaGrammar" $ for_ lambdaExamples $ testCtxGrammarExample lambdaGrammar
+    describe "lenvecGrammar" $ for_ lenvecExamples $ testCtxGrammarExample lenvecGrammar
 
 doctests :: IO ()
 doctests = do
@@ -77,16 +78,21 @@ doctests = do
     putStrLn modulePath
     doctest (modulePath : languageExtensions)
 
-testGrammar :: (Show a, Eq a) => String -> CtxGrammar Char a -> [(a, String)] -> Spec
-testGrammar name grammar examples =
-  describe name $
-    for_ examples $ \(expectedSyntax, expectedString) -> do
-      it ("should parse from " <> expectedString <> " correctly") $ do
-        let actualSyntax = [parsed | (parsed, "") <- parseG grammar expectedString]
-        listToMaybe actualSyntax `shouldBe` Just expectedSyntax
-      it ("should unparse to " <> expectedString <> " correctly") $ do
-        let actualString = unparseG grammar expectedSyntax ""
-        actualString `shouldBe` Just expectedString
-      it ("should print to " <> expectedString <> " correctly") $ do
-        let actualString = ($ "") <$> printG grammar expectedSyntax
-        actualString `shouldBe` Just expectedString
+testGrammarExample :: (Show a, Eq a) => Grammar Char a -> (a, String) -> Spec
+testGrammarExample grammar (expectedSyntax, expectedString) = do
+  testCtxGrammarExample grammar (expectedSyntax, expectedString)
+  it ("should match from " <> expectedString <> " correctly") $ do
+    let actualMatch = expectedString =~ regbnfG grammar
+    actualMatch `shouldBe` True
+
+testCtxGrammarExample :: (Show a, Eq a) => CtxGrammar Char a -> (a, String) -> Spec
+testCtxGrammarExample grammar (expectedSyntax, expectedString) = do
+  it ("should parse from " <> expectedString <> " correctly") $ do
+    let actualSyntax = [parsed | (parsed, "") <- parseG grammar expectedString]
+    listToMaybe actualSyntax `shouldBe` Just expectedSyntax
+  it ("should unparse to " <> expectedString <> " correctly") $ do
+    let actualString = unparseG grammar expectedSyntax ""
+    actualString `shouldBe` Just expectedString
+  it ("should print to " <> expectedString <> " correctly") $ do
+    let actualString = ($ "") <$> printG grammar expectedSyntax
+    actualString `shouldBe` Just expectedString

From bd04c6891f8f45b324c4f3109e9dcbf671f1879c Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 16 Feb 2026 14:50:12 -0800
Subject: [PATCH 015/103] Update Monocle.hs

---
 src/Control/Lens/Monocle.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Control/Lens/Monocle.hs b/src/Control/Lens/Monocle.hs
index 40afc8f..98c392e 100644
--- a/src/Control/Lens/Monocle.hs
+++ b/src/Control/Lens/Monocle.hs
@@ -62,7 +62,7 @@ monomorphically typed `Monocle` for different purposes.
 cloneMonocle :: AMonocle s t a b -> Monocle s t a b
 cloneMonocle mon = unwrapPafb . mapMonocle mon . WrapPafb
 
-{- | Convert a `Monocle` to an improper `Prism`.
+{- | Convert a `Monocle` to an improper `Control.Lens.Prism.Prism`.
 
 >>> review (imprism (ditraversed @Complex)) (1 :: Double)
 1.0 :+ 1.0

From 1bcabc9ce128a90d6952e85a2ec5da11665ec5f0 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 16 Feb 2026 14:50:17 -0800
Subject: [PATCH 016/103] Update Filtrator.hs

---
 src/Data/Profunctor/Filtrator.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/Data/Profunctor/Filtrator.hs b/src/Data/Profunctor/Filtrator.hs
index 4538d09..0431d5d 100644
--- a/src/Data/Profunctor/Filtrator.hs
+++ b/src/Data/Profunctor/Filtrator.hs
@@ -41,8 +41,11 @@ class (Cochoice p, forall x. Filterable (p x))
     prop> unright = snd . filtrate
 
     `filtrate` is a distant relative to `Data.Either.partitionEithers`.
+    `filtrate` can be given a default value for `Monadic` `Alternator`s via `mfiltrate`.
 
-    `filtrate` has a default for `Choice` & `Cochcoice` partial profunctors.
+    prop> filtrate = mfiltrate
+
+    `filtrate` has a default for `Choice` & `Cochoice` partial profunctors.
     -}
     filtrate
       :: p (Either a c) (Either b d)

From 886859b2dd8d80766a1e3b457cf5744c6c2e956d Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 16 Feb 2026 15:22:00 -0800
Subject: [PATCH 017/103] Update Monocle.hs

---
 src/Control/Lens/Monocle.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Control/Lens/Monocle.hs b/src/Control/Lens/Monocle.hs
index 98c392e..06c756d 100644
--- a/src/Control/Lens/Monocle.hs
+++ b/src/Control/Lens/Monocle.hs
@@ -64,10 +64,10 @@ cloneMonocle mon = unwrapPafb . mapMonocle mon . WrapPafb
 
 {- | Convert a `Monocle` to an improper `Control.Lens.Prism.Prism`.
 
->>> review (imprism (ditraversed @Complex)) (1 :: Double)
-1.0 :+ 1.0
->>> preview (imprism (ditraversed)) (1 :+ 2 :: Complex Double)
-Just 1.0
+>>> review (imprism ditraversed) 1 :: Complex Int
+1 :+ 1
+>>> preview (imprism ditraversed) (1 :+ 2 :: Complex Int)
+Just 1
 -}
 imprism :: Monocle s t a b -> Prism s t a b
 imprism mon = clonePrism mon

From 114b1f827f9c56baf1595e1eaaf08ce3b1daa7a3 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 16 Feb 2026 18:31:22 -0800
Subject: [PATCH 018/103] monomorphically

---
 src/Control/Lens/Diopter.hs    | 3 +--
 src/Control/Lens/Grate.hs      | 3 +--
 src/Control/Lens/Monocle.hs    | 3 +--
 src/Control/Lens/PartialIso.hs | 3 +--
 src/Control/Lens/Wither.hs     | 3 +--
 5 files changed, 5 insertions(+), 10 deletions(-)

diff --git a/src/Control/Lens/Diopter.hs b/src/Control/Lens/Diopter.hs
index c78b06c..e94584c 100644
--- a/src/Control/Lens/Diopter.hs
+++ b/src/Control/Lens/Diopter.hs
@@ -41,8 +41,7 @@ type Diopter s t a b = forall p f.
   (Distributor p, Applicative f)
     => p a (f b) -> p s (f t)
 
-{- | If you see `ADiopter` in a signature for a function,
-the function is expecting a `Diopter`. -}
+{- | `ADiopter` is monomorphically a `Diopter`. -}
 type ADiopter s t a b =
   Dioptrice a b a (Identity b) -> Dioptrice a b s (Identity t)
 
diff --git a/src/Control/Lens/Grate.hs b/src/Control/Lens/Grate.hs
index 9db64ae..520065b 100644
--- a/src/Control/Lens/Grate.hs
+++ b/src/Control/Lens/Grate.hs
@@ -48,8 +48,7 @@ type Grate s t a b = forall p f.
   (Closed p, Monoidal p, Distributive f, Applicative f)
     => p a (f b) -> p s (f t)
 
-{- | If you see `AGrate` in a signature for a function,
-the function is expecting a `Grate`. -}
+{- | `AGrate` is monomorphically a `Grate`. -}
 type AGrate s t a b =
   Grating a b a (Identity b) -> Grating a b s (Identity t)
 
diff --git a/src/Control/Lens/Monocle.hs b/src/Control/Lens/Monocle.hs
index 06c756d..da093f7 100644
--- a/src/Control/Lens/Monocle.hs
+++ b/src/Control/Lens/Monocle.hs
@@ -43,8 +43,7 @@ type Monocle s t a b = forall p f.
   (Monoidal p, Applicative f)
     => p a (f b) -> p s (f t)
 
-{- | If you see `AMonocle` in a signature for a function,
-the function is expecting a `Monocle`. -}
+{- | `AMonocle` is monomorphically a `Monocle`. -}
 type AMonocle s t a b =
   Monocular a b a (Identity b) -> Monocular a b s (Identity t)
 
diff --git a/src/Control/Lens/PartialIso.hs b/src/Control/Lens/PartialIso.hs
index be822a2..6e581ee 100644
--- a/src/Control/Lens/PartialIso.hs
+++ b/src/Control/Lens/PartialIso.hs
@@ -117,8 +117,7 @@ some equivalence class of terms.
 -}
 type PartialIso' s a = PartialIso s s a a
 
-{- | If you see `APartialIso` in a signature for a function,
-the function is expecting a `PartialIso`. -}
+{- | `APartialIso` is monomorphically a `PartialIso`. -}
 type APartialIso s t a b =
   PartialExchange a b a (Maybe b) -> PartialExchange a b s (Maybe t)
 
diff --git a/src/Control/Lens/Wither.hs b/src/Control/Lens/Wither.hs
index 72dd0be..8dd88a5 100644
--- a/src/Control/Lens/Wither.hs
+++ b/src/Control/Lens/Wither.hs
@@ -48,8 +48,7 @@ Every one of the following is a `Wither`.
 -}
 type Wither s t a b = forall f. Alternative f => (a -> f b) -> s -> f t
 
-{- | If you see `AWither` in a signature for a function,
-the function is expecting a `Wither`. -}
+{- | `AWither` is monomorphically a `Wither`. -}
 type AWither s t a b = (a -> Altar a b b) -> s -> Altar a b t
 
 {- | `Witheroid`s generalize `Wither`s.

From 0a301588dd1407d474a3744cc8111623bc64d19f Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 16 Feb 2026 18:56:17 -0800
Subject: [PATCH 019/103] Update Wither.hs

---
 src/Control/Lens/Wither.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/Control/Lens/Wither.hs b/src/Control/Lens/Wither.hs
index 8dd88a5..7b5d7c5 100644
--- a/src/Control/Lens/Wither.hs
+++ b/src/Control/Lens/Wither.hs
@@ -37,7 +37,6 @@ import Witherable
 
 {- | `Wither`s extends `Control.Lens.Traversal.Traversal`s by filtering.
 
-
 Every one of the following is a `Wither`.
 
 * `Control.Lens.Iso.Iso`

From 5f82d43d752f57b93d4deef350745579abf8e5b1 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 16 Feb 2026 18:56:32 -0800
Subject: [PATCH 020/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index f6c6c87..f0aeff1 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -309,10 +309,10 @@ We can generate parsers and printers as expected.
 []
 
 In addition to context-sensitivity via `Monadic` combinators,
-`CtxGrammar`s adds general filtration via `Filtrator` to `Grammar`s.
-The `satisfy` function is a general character class.
+`CtxGrammar`s add unrestricted filtration to `Grammar`s.
+The `satisfy` combinator is an unrestricted token filter.
 And the `satisfied` pattern is used together with the `Choice` &
-`Data.Profunctor.Cochoice` applicator `>?<` for general filtration.
+`Data.Profunctor.Cochoice` applicator `>?<` for unrestricted filtration.
 
 >>> :{
 palindromeG :: CtxGrammar Char String
@@ -323,11 +323,11 @@ palindromeG = rule "palindrome" $
 >>> [pal | word <- ["racecar", "word"], (pal, "") <- parseG palindromeG word]
 ["racecar"]
 
-Since `CtxGrammar`s are embedded in Haskell which permits computable predicates,
+Since `CtxGrammar`s are embedded in Haskell, permitting computable predicates,
 and `Filtrator` has a default definition for `Monadic` `Alternator`s,
 the context-sensitivity of `CtxGrammar` implies
-general filtration of unrestricted grammars,
-which can parse recursively enumerable languages.
+unrestricted filtration of grammars by computable predicates,
+which can recognize the class of recursively enumerable languages.
 
 -}
 type CtxGrammar token a = forall p.

From fd1e9a2d743caba36c672edd059fb002f2f5e339 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 16 Feb 2026 19:27:01 -0800
Subject: [PATCH 021/103] Update NestedPrismTH.hs

---
 src/Control/Lens/Internal/NestedPrismTH.hs | 41 ++++++++++++++++------
 1 file changed, 30 insertions(+), 11 deletions(-)

diff --git a/src/Control/Lens/Internal/NestedPrismTH.hs b/src/Control/Lens/Internal/NestedPrismTH.hs
index 83e2520..d0d7538 100644
--- a/src/Control/Lens/Internal/NestedPrismTH.hs
+++ b/src/Control/Lens/Internal/NestedPrismTH.hs
@@ -33,21 +33,40 @@ import qualified Data.Set as Set
 import Data.Set (Set)
 import Prelude
 
--- | Generate a `Control.Lens.Prism.Prism`
+-- | Similar to `Control.Lens.Internal.PrismTH.makePrisms`,
+-- `makeNestedPrisms` generates a `Control.Lens.Prism.Prism`
 -- for each constructor of a data type.
--- `Control.Lens.Iso.Iso`s generated when possible.
--- `Control.Lens.Review.Review`s are created for constructors with existentially
--- quantified constructors and GADTs.
---
--- See `Control.Lens.Internal.PrismTH.makePrisms` for details and examples.
+-- `Control.Lens.Iso.Iso`s are generated when possible.
+-- `Control.Lens.Review.Review`s are generated for constructors
+-- with existentially quantified constructors and GADTs.
 -- The difference in `makeNestedPrisms`
 -- is that constructors with @n > 2@ arguments
 -- will use right-nested pairs, rather than a flat @n@-tuple.
--- This makes them suitable for use on the left-hand-side of
--- `Control.Lens.PartialIso.>~`,
--- `Control.Lens.PartialIso.>?` and `Control.Lens.PartialIso.>?<`;
--- with repeated use of `Data.Profunctor.Distributor.>*<`
--- on the right-hand-side, resulting in right-nested pairs.
+-- This makes them suitable for bonding,
+-- by use of the applicator `Control.Lens.PartialIso.>?`
+-- to `Data.Profunctor.Monoidal.Monoidal` idiom notation
+-- with `Data.Profunctor.Monoidal.>*<`,
+-- or to `Data.Profunctor.Monadic.Monadic` qualified do-notation.
+--
+-- /e.g./
+--
+-- @
+-- data FooBarBazBux a
+--   = Foo Int
+--   | Bar a
+--   | Baz Int Char
+--   | Bux Doube String Bool
+-- makePrisms ''FooBarBazBux
+-- @
+--
+-- will create
+--
+-- @
+-- _Foo :: Prism' (FooBarBaz a) Int
+-- _Bar :: Prism (FooBarBaz a) (FooBarBaz b) a b
+-- _Baz :: Prism' (FooBarBaz a) (Int, Char)
+-- _Bux :: Prism' (FooBarBaz a) (Double, (String, Bool))
+-- @
 makeNestedPrisms :: Name -> DecsQ
 makeNestedPrisms typeName =
   do info <- D.reifyDatatype typeName

From 497984522aa82813494439b923e4750717a396e5 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 17 Feb 2026 08:54:11 -0800
Subject: [PATCH 022/103] simplify replicateP

---
 src/Data/Profunctor/Distributor.hs | 28 +++++++++++++++-------------
 src/Data/Profunctor/Monoidal.hs    | 10 ++++++----
 2 files changed, 21 insertions(+), 17 deletions(-)

diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index f74b342..ceff5b3 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -93,7 +93,7 @@ class Monoidal p => Distributor p where
 
   {- | The zero structure morphism of a `Distributor`.
 
-  `zeroP` has a default for `Alternator`.
+  `zeroP` has a default for `Alternators`.
 
   prop> zeroP = empty
   -}
@@ -103,7 +103,7 @@ class Monoidal p => Distributor p where
 
   {- | The sum structure morphism of a `Distributor`.
 
-  `>+<` has a default for `Alternator`.
+  `>+<` has a default for `Alternators`.
 
   prop> x >+< y = alternate (Left x) <|> alternate (Right y)
   -}
@@ -315,7 +315,13 @@ instance Homogeneous Tree where
 
 {- | The `Alternator` class co-extends `Choice` and `Distributor`,
 as well as `Alternative`, adding the `alternate` method,
-which is a lax monoidal structure morphism on sums.
+which is a lax monoidal structure morphism on sums, with these
+these laws relating them.
+
+prop> left' = alternate . Left
+prop> right' = alternate . Right
+prop> zeroP = empty
+prop> x >+< y = alternate (Left x) <|> alternate (Right y)
 
 For the case of `Functor`s the analog of `alternate` can be defined
 without any other constraint, but the case of `Profunctor`s turns
@@ -324,13 +330,8 @@ out to be slighly more complex.
 class (Choice p, Distributor p, forall x. Alternative (p x))
   => Alternator p where
 
-    {- |
-    prop> left' = alternate . Left
-    prop> right' = alternate . Right
-    prop> zeroP = empty
-    prop> x >+< y = alternate (Left x) <|> alternate (Right y)
-
-    `alternate` has a default for `Choice` & `Cochoice` partial profunctors.
+    {- | The structure morphism for an `Alternator`,
+    `alternate` has a default for `Choice` & `Cochoice` partial distributors.
     -}
     alternate
       :: Either (p a b) (p c d)
@@ -418,7 +419,7 @@ several (SepBy beg end sep) p = iso toList fromList . eotList >~
   beg >* (oneP >+< p >*< manyP (sep >* p)) *< end
 
 {- |
-prop> several1 noSep p = someP p
+prop> several1 noSep = someP
 -}
 several1
   :: (IsList s, IsList t, Distributor p, Choice p)
@@ -451,8 +452,9 @@ chain1 association pat (SepBy beg end sep) = leftOrRight chainl1 chainr1
 
 {- | `intercalateP` adds a `SepBy` to `replicateP`. -}
 intercalateP
-  :: (Monoidal p, Choice p, AsEmpty s, AsEmpty t, Cons s t a b)
-  => Int -> SepBy (p () ()) -> p a b -> p s t
+  :: (Monoidal p, Choice p, AsEmpty s, Cons s s a a)
+  => Int {- ^ number of repetitions -}
+  -> SepBy (p () ()) -> p a a -> p s s
 intercalateP n (SepBy beg end _) _ | n <= 0 =
   beg >* lmap (const Empty) asEmpty *< end
 intercalateP n (SepBy beg end comma) p =
diff --git a/src/Data/Profunctor/Monoidal.hs b/src/Data/Profunctor/Monoidal.hs
index 91d1d60..7c6d163 100644
--- a/src/Data/Profunctor/Monoidal.hs
+++ b/src/Data/Profunctor/Monoidal.hs
@@ -127,11 +127,13 @@ ditraverse
 ditraverse p = traverse (\f -> lmap f p) (distribute id)
 
 {- | `replicateP` is analagous to `Control.Monad.replicateM`,
-for `Monoidal` & `Choice` `Profunctor`s. -}
+for `Monoidal` & `Choice` `Profunctor`s. When the number
+of repetitions is less than or equal to 0, it returns `asEmpty`.
+-}
 replicateP
-  :: (Monoidal p, Choice p, AsEmpty s, AsEmpty t, Cons s t a b)
-  => Int -> p a b -> p s t
-replicateP n _ | n <= 0 = lmap (const Empty) asEmpty
+  :: (Monoidal p, Choice p, AsEmpty s, Cons s s a a)
+  => Int {- ^ number of repetitions -} -> p a a -> p s s
+replicateP n _ | n <= 0 = asEmpty
 replicateP n a = a >:< replicateP (n-1) a
 
 {- | For any `Monoidal`, `Choice` & `Strong` `Profunctor`,

From 9e19e1ee21fccbe8403dde82ceb1185d035f35c3 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 17 Feb 2026 09:02:05 -0800
Subject: [PATCH 023/103] Update Distributor.hs

---
 src/Data/Profunctor/Distributor.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index ceff5b3..31ca2ea 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -93,7 +93,7 @@ class Monoidal p => Distributor p where
 
   {- | The zero structure morphism of a `Distributor`.
 
-  `zeroP` has a default for `Alternators`.
+  `zeroP` has a default for `Alternator`s.
 
   prop> zeroP = empty
   -}
@@ -103,7 +103,7 @@ class Monoidal p => Distributor p where
 
   {- | The sum structure morphism of a `Distributor`.
 
-  `>+<` has a default for `Alternators`.
+  `>+<` has a default for `Alternator`s.
 
   prop> x >+< y = alternate (Left x) <|> alternate (Right y)
   -}

From d0d8a5682995874bfc80937b6bbd8be51541a79c Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 17 Feb 2026 09:06:10 -0800
Subject: [PATCH 024/103] Update Distributor.hs

---
 src/Data/Profunctor/Distributor.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index 31ca2ea..dfbb109 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -456,6 +456,6 @@ intercalateP
   => Int {- ^ number of repetitions -}
   -> SepBy (p () ()) -> p a a -> p s s
 intercalateP n (SepBy beg end _) _ | n <= 0 =
-  beg >* lmap (const Empty) asEmpty *< end
+  beg >* asEmpty *< end
 intercalateP n (SepBy beg end comma) p =
   beg >* p >:< replicateP (n-1) (comma >* p) *< end

From 06aa886b4543b1077379734a26183ee195f4eda0 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 17 Feb 2026 09:07:27 -0800
Subject: [PATCH 025/103] Update Main.hs

---
 test/Main.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/Main.hs b/test/Main.hs
index 155ccb9..2b7079b 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -81,7 +81,7 @@ doctests = do
 testGrammarExample :: (Show a, Eq a) => Grammar Char a -> (a, String) -> Spec
 testGrammarExample grammar (expectedSyntax, expectedString) = do
   testCtxGrammarExample grammar (expectedSyntax, expectedString)
-  it ("should match from " <> expectedString <> " correctly") $ do
+  it ("should match " <> expectedString <> " correctly") $ do
     let actualMatch = expectedString =~ regbnfG grammar
     actualMatch `shouldBe` True
 

From 03068f43a161eaae345d9162f1a1d343cb9d7b96 Mon Sep 17 00:00:00 2001
From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com>
Date: Mon, 23 Feb 2026 23:52:50 +0000
Subject: [PATCH 026/103] Initial plan


From f0ed836114d338d03c0f10d77efe3134b68d39fa Mon Sep 17 00:00:00 2001
From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com>
Date: Mon, 23 Feb 2026 23:53:27 +0000
Subject: [PATCH 027/103] Increment minor version to 0.4.0.0

Co-authored-by: echatav <2265940+echatav@users.noreply.github.com>
---
 distributors.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/distributors.cabal b/distributors.cabal
index 9a92b07..4b3429a 100644
--- a/distributors.cabal
+++ b/distributors.cabal
@@ -5,7 +5,7 @@ cabal-version: 2.2
 -- see: https://github.com/sol/hpack
 
 name:           distributors
-version:        0.3.0.0
+version:        0.4.0.0
 synopsis:       Unifying Parsers, Printers & Grammars
 description:    Distributors provides mathematically inspired abstractions for coders to write parsers that can also be inverted to printers.
 category:       Profunctors, Optics, Parsing

From b96bfbe33c2f896e2e30c83d3d4f6606d779f095 Mon Sep 17 00:00:00 2001
From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com>
Date: Mon, 23 Feb 2026 23:55:11 +0000
Subject: [PATCH 028/103] Correct version to 0.3.0.1

Co-authored-by: echatav <2265940+echatav@users.noreply.github.com>
---
 distributors.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/distributors.cabal b/distributors.cabal
index 4b3429a..35f40e4 100644
--- a/distributors.cabal
+++ b/distributors.cabal
@@ -5,7 +5,7 @@ cabal-version: 2.2
 -- see: https://github.com/sol/hpack
 
 name:           distributors
-version:        0.4.0.0
+version:        0.3.0.1
 synopsis:       Unifying Parsers, Printers & Grammars
 description:    Distributors provides mathematically inspired abstractions for coders to write parsers that can also be inverted to printers.
 category:       Profunctors, Optics, Parsing

From 3f4680a2932861d496ad5b481badbccea41d3e6e Mon Sep 17 00:00:00 2001
From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com>
Date: Tue, 24 Feb 2026 00:00:22 +0000
Subject: [PATCH 029/103] Initial plan


From e5805a562568628695214b90209c54f3dee6e05a Mon Sep 17 00:00:00 2001
From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com>
Date: Tue, 24 Feb 2026 00:00:58 +0000
Subject: [PATCH 030/103] Fix spelling error: Doube -> Double in
 NestedPrismTH.hs comment

Co-authored-by: echatav <2265940+echatav@users.noreply.github.com>
---
 src/Control/Lens/Internal/NestedPrismTH.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Control/Lens/Internal/NestedPrismTH.hs b/src/Control/Lens/Internal/NestedPrismTH.hs
index d0d7538..f501976 100644
--- a/src/Control/Lens/Internal/NestedPrismTH.hs
+++ b/src/Control/Lens/Internal/NestedPrismTH.hs
@@ -55,7 +55,7 @@ import Prelude
 --   = Foo Int
 --   | Bar a
 --   | Baz Int Char
---   | Bux Doube String Bool
+--   | Bux Double String Bool
 -- makePrisms ''FooBarBazBux
 -- @
 --

From 9b53de6722bca82acf24ac1dde135295a3b00159 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 25 Feb 2026 16:42:00 -0800
Subject: [PATCH 031/103] Update distributors.cabal

---
 distributors.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/distributors.cabal b/distributors.cabal
index 35f40e4..9a92b07 100644
--- a/distributors.cabal
+++ b/distributors.cabal
@@ -5,7 +5,7 @@ cabal-version: 2.2
 -- see: https://github.com/sol/hpack
 
 name:           distributors
-version:        0.3.0.1
+version:        0.3.0.0
 synopsis:       Unifying Parsers, Printers & Grammars
 description:    Distributors provides mathematically inspired abstractions for coders to write parsers that can also be inverted to printers.
 category:       Profunctors, Optics, Parsing

From 01507dfb4c233895bbddad2720baf0a39d4a9538 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 25 Feb 2026 19:28:43 -0800
Subject: [PATCH 032/103] Update Distributor.hs

---
 src/Data/Profunctor/Distributor.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index dfbb109..bc8d17d 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -347,7 +347,7 @@ class (Choice p, Distributor p, forall x. Alternative (p x))
 
     {- | One or more. -}
     someP :: p a b -> p [a] [b]
-    someP p = _Cons >? p >*< manyP p
+    someP x = x >:< manyP x
 
 -- | Combines all `Alternative` choices in the specified list.
 choice :: (Foldable f, Alternative p) => f (p a) -> p a

From 5e83b4fd1f69ae7024a45ad7c1bc68b822d5879c Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sat, 21 Mar 2026 16:22:57 -0700
Subject: [PATCH 033/103] malternate

---
 src/Data/Profunctor/Distributor.hs | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index bc8d17d..ef3eda9 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -13,6 +13,7 @@ module Data.Profunctor.Distributor
     Distributor (..), dialt
     -- * Alternator
   , Alternator (..)
+  , malternate
   , choice
   , option
     -- * SepBy
@@ -34,6 +35,7 @@ import Control.Arrow
 import Control.Lens hiding (chosen)
 import Control.Lens.Internal.Profunctor
 import Control.Lens.PartialIso
+import Control.Monad
 import Data.Bifunctor.Clown
 import Data.Bifunctor.Joker
 import Data.Bifunctor.Product
@@ -349,6 +351,19 @@ class (Choice p, Distributor p, forall x. Alternative (p x))
     someP :: p a b -> p [a] [b]
     someP x = x >:< manyP x
 
+-- | `malternate` gives a default `alternate` method for
+-- has a default definition when `Data.Profunctor.Monadic.Monadic`.
+--
+-- prop> alternate = malternate
+malternate
+  :: (Choice p, forall x. Alternative (p x), forall x. Monad (p x))
+  => Either (p a b) (p c d)
+  -> p (Either a c) (Either b d)
+malternate =
+  (left' >=> either (pure . Left) (const empty))
+  |||
+  (right' >=> either (const empty) (pure . Right))
+
 -- | Combines all `Alternative` choices in the specified list.
 choice :: (Foldable f, Alternative p) => f (p a) -> p a
 choice = foldl' (<|>) empty

From 5e17d7883994798101a08f540ae83ce3ba9b84b7 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sat, 21 Mar 2026 16:42:32 -0700
Subject: [PATCH 034/103] cleaning

---
 src/Data/Profunctor/Distributor.hs | 8 ++++----
 src/Data/Profunctor/Filtrator.hs   | 7 +++----
 2 files changed, 7 insertions(+), 8 deletions(-)

diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index ef3eda9..681723b 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -52,6 +52,7 @@ import Data.Profunctor qualified as Pro (WrappedArrow)
 import Data.Profunctor.Cayley
 import Data.Profunctor.Composition
 import Data.Profunctor.Monad
+import Data.Profunctor.Monadic
 import Data.Profunctor.Monoidal
 import Data.Profunctor.Yoneda
 import Data.Proxy
@@ -351,13 +352,12 @@ class (Choice p, Distributor p, forall x. Alternative (p x))
     someP :: p a b -> p [a] [b]
     someP x = x >:< manyP x
 
--- | `malternate` gives a default `alternate` method for
--- has a default definition when `Data.Profunctor.Monadic.Monadic`.
+-- | `malternate` gives a default `alternate` when `Monadic`.
 --
 -- prop> alternate = malternate
 malternate
-  :: (Choice p, forall x. Alternative (p x), forall x. Monad (p x))
-  => Either (p a b) (p c d)
+  :: (Monadic p, Choice p, forall x. Alternative (p x))
+  => Either (p a b) (p c d) -- ^ `Left` or `Right` alternates
   -> p (Either a c) (Either b d)
 malternate =
   (left' >=> either (pure . Left) (const empty))
diff --git a/src/Data/Profunctor/Filtrator.hs b/src/Data/Profunctor/Filtrator.hs
index 0431d5d..5a2fa55 100644
--- a/src/Data/Profunctor/Filtrator.hs
+++ b/src/Data/Profunctor/Filtrator.hs
@@ -20,7 +20,6 @@ import Control.Lens.PartialIso
 import Control.Lens.Internal.Profunctor
 import Control.Monad
 import Data.Profunctor
-import Data.Profunctor.Distributor
 import Data.Profunctor.Monad
 import Data.Profunctor.Monadic (Monadic)
 import Data.Profunctor.Yoneda
@@ -59,12 +58,12 @@ class (Cochoice p, forall x. Filterable (p x))
       &&&
       dimapMaybe (Just . Right) (either (const Nothing) Just)
 
--- | `Filtrator` has a default definition for `Monadic` `Alternator`s.
+-- | `Filtrator` has a default definition for `Monadic` `Alternative`s.
 --
 -- prop> filtrate = mfiltrate
 mfiltrate
-  :: (Monadic p, Alternator p)
-  => p (Either a c) (Either b d)
+  :: (Monadic p, forall x. Alternative (p x))
+  => p (Either a c) (Either b d) -- ^ partition `Either`
   -> (p a b, p c d)
 mfiltrate =
   (lmap Left >=> either pure (const empty))

From fd7056a36fece5bda2eed096b103b74778907caf Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 24 Mar 2026 11:05:52 -0700
Subject: [PATCH 035/103] Parsector

---
 distributors.cabal                       |   2 +
 src/Control/Lens/Grammar.hs              |  29 ++-
 src/Control/Monad/Try.hs                 |  24 +++
 src/Data/Profunctor/Grammar.hs           |   3 +
 src/Data/Profunctor/Grammar/Parsector.hs | 256 +++++++++++++++++++++++
 src/Data/Profunctor/Monadic.hs           |   9 +
 6 files changed, 322 insertions(+), 1 deletion(-)
 create mode 100644 src/Control/Monad/Try.hs
 create mode 100644 src/Data/Profunctor/Grammar/Parsector.hs

diff --git a/distributors.cabal b/distributors.cabal
index 9a92b07..fe94eb2 100644
--- a/distributors.cabal
+++ b/distributors.cabal
@@ -41,9 +41,11 @@ library
       Control.Lens.Monocle
       Control.Lens.PartialIso
       Control.Lens.Wither
+      Control.Monad.Try
       Data.Profunctor.Distributor
       Data.Profunctor.Filtrator
       Data.Profunctor.Grammar
+      Data.Profunctor.Grammar.Parsector
       Data.Profunctor.Monadic
       Data.Profunctor.Monoidal
   other-modules:
diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index f0aeff1..e7d4ce6 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -28,6 +28,8 @@ module Control.Lens.Grammar
   , printG
   , parseG
   , unparseG
+  , parsecG
+  , unparsecG
     -- * Utility
   , putStringLn
   ) where
@@ -47,6 +49,7 @@ import Data.Profunctor.Filtrator
 import Data.Profunctor.Monadic
 import Data.Profunctor.Monoidal
 import Data.Profunctor.Grammar
+import Data.Profunctor.Grammar.Parsector
 import qualified Data.Set as Set
 import Data.String
 import GHC.Exts
@@ -335,7 +338,7 @@ type CtxGrammar token a = forall p.
   , forall x. BackusNaurForm (p x x)
   , Alternator p
   , Filtrator p
-  , Monadic p
+  , MonadicTry p
   ) => p a a
 
 {- |
@@ -793,6 +796,30 @@ unparseG
   -> m string
 unparseG parsor = unparseP parsor
 
+{- | `parsecG` generates a Parsec-style parser from a `CtxGrammar`,
+returning either a `Expect` error or the parsed value
+and remaining input.
+-}
+parsecG
+  :: (Cons string string token token, Snoc string string token token)
+  => (Item string ~ token, Categorized token)
+  => CtxGrammar token a
+  -> string {- ^ input -}
+  -> Either (Expect string, string) (a, string)
+parsecG parsector = parsecP parsector
+
+{- | `unparsecG` generates a Parsec-style unparser from a `CtxGrammar`,
+returning either a `Expect` error or the output string.
+-}
+unparsecG
+  :: (Cons string string token token, Snoc string string token token)
+  => (Item string ~ token, Categorized token)
+  => CtxGrammar token a
+  -> a {- ^ syntax -}
+  -> string {- ^ input -}
+  -> Either (Expect string, string) string
+unparsecG parsector = unparsecP parsector
+
 {- | `putStringLn` is a utility that generalizes `putStrLn`
 to string-like interfaces such as `RegString` and `RegBnf`.
 -}
diff --git a/src/Control/Monad/Try.hs b/src/Control/Monad/Try.hs
new file mode 100644
index 0000000..d1661c9
--- /dev/null
+++ b/src/Control/Monad/Try.hs
@@ -0,0 +1,24 @@
+module Control.Monad.Try
+  ( MonadTry (..)
+  , fail
+  , mzero
+  , mplus
+  , mchoice
+  ) where
+
+import Control.Monad
+import Data.Foldable
+
+{- |
+
+prop> x <|> y = try x `mplus` y
+prop> fail msg <|> x = x = x <|> fail msg
+
+-}
+class (MonadFail m, MonadPlus m) => MonadTry m where
+  try :: m a -> m a
+  default try :: m a -> m a
+  try = id
+
+mchoice :: (Foldable f, MonadPlus p) => f (p a) -> p a
+mchoice = foldl' mplus mzero
diff --git a/src/Data/Profunctor/Grammar.hs b/src/Data/Profunctor/Grammar.hs
index aca3466..b9df3e9 100644
--- a/src/Data/Profunctor/Grammar.hs
+++ b/src/Data/Profunctor/Grammar.hs
@@ -31,6 +31,7 @@ import Control.Lens.Grammar.Kleene
 import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
 import Control.Monad
+import Control.Monad.Try
 import Data.Coerce
 import Data.Monoid
 import Data.Profunctor
@@ -177,6 +178,7 @@ instance
 instance BackusNaurForm (Parsor s m a b)
 instance (Alternative m, Monad m) => MonadFail (Parsor s m a) where
   fail _ = empty
+instance (Alternative m, Monad m) => MonadTry (Parsor s m a)
 instance AsEmpty s => Matching s (Parsor s [] a b) where
   word =~ p = case
     [ () | (_, remaining) <- runParsor p Nothing word
@@ -284,6 +286,7 @@ instance
 instance BackusNaurForm (Printor s m a b)
 instance (Alternative m, Monad m) => MonadFail (Printor s m a) where
   fail _ = empty
+instance (Alternative m, Monad m) => MonadTry (Printor s m a)
 
 -- Grammor instances
 instance Functor (Grammor k a) where fmap _ = coerce
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
new file mode 100644
index 0000000..62fc078
--- /dev/null
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -0,0 +1,256 @@
+{-|
+Module      : Data.Profunctor.Grammar.Parsector
+Description : Parsec-style invertible parser profunctor
+Copyright   : (C) 2026 - Eitan Chatav
+License     : BSD-style (see the file LICENSE)
+Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
+Stability   : provisional
+Portability : non-portable
+-}
+
+module Data.Profunctor.Grammar.Parsector
+  ( -- * Parsector
+    Parsector (..)
+  , StateCallbacks (..)
+  , Expect (..)
+  , parsecP
+  , unparsecP
+  ) where
+
+import Control.Applicative
+import Data.Function
+import Control.Lens
+import Control.Lens.Grammar.BackusNaur
+import Control.Lens.Grammar.Boole
+import Control.Lens.PartialIso
+import Control.Lens.Grammar.Symbol
+import Control.Lens.Grammar.Token
+import Control.Monad
+import Control.Monad.Try
+import Control.Lens.Grammar.Kleene
+import Data.Profunctor
+import Data.Profunctor.Distributor
+import Data.Profunctor.Filtrator
+import GHC.Exts
+import Witherable
+
+newtype Parsector s a b = Parsector
+  { runParsector :: forall x. StateCallbacks s a b x -> x }
+
+data StateCallbacks s a b x = StateCallbacks
+  { streamInput :: s
+  , streamOffset :: !Word
+  , syntaxInput :: Maybe a
+  , consumedOk :: b -> s -> Expect s -> x
+  , consumedErr :: Expect s -> x
+  , emptyOk :: b -> s -> Expect s -> x
+  , emptyErr :: Expect s -> x
+  }
+
+data Expect s = Expect
+  { expectOffset :: Word
+  , expectPattern :: Bnf (RegEx (Item s)) -- ^ first set grammar
+  }
+deriving instance
+  ( Categorized (Item s)
+  , Show (Item s)
+  , Show (Categorize (Item s))
+  ) => Show (Expect s)
+deriving instance Categorized (Item s) => Eq (Expect s)
+deriving instance Categorized (Item s) => Ord (Expect s)
+
+-- | Run a `Parsector` as a parser, consuming tokens from the input.
+parsecP :: Parsector s a b -> s -> Either (Expect s, s) (b, s)
+parsecP (Parsector p) s = p StateCallbacks
+  { streamInput = s
+  , streamOffset = 0
+  , syntaxInput = Nothing
+  , consumedOk = \b st _ -> Right (b, st)
+  , consumedErr = \err -> Left (err, s)
+  , emptyOk = \b st _ -> Right (b, st)
+  , emptyErr = \err -> Left (err, s)
+  }
+
+-- | Run a `Parsector` as an unparser, snocing tokens onto an empty input.
+unparsecP :: Parsector s a b -> a -> s -> Either (Expect s, s) s
+unparsecP (Parsector p) a s = snd <$> p StateCallbacks
+  { streamInput = s
+  , streamOffset = 0
+  , syntaxInput = Just a
+  , consumedOk = \b st _ -> Right (b, st)
+  , consumedErr = \err -> Left (err, s)
+  , emptyOk = \b st _ -> Right (b, st)
+  , emptyErr = \err -> Left (err, s)
+  }
+
+satisfyParsector
+  :: ( Cons s s a a
+     , Snoc s s a a
+     , Item s ~ a
+     , Categorized a
+     )
+  => TokenTest a
+  -> Parsector s a a
+satisfyParsector test = Parsector $ \args ->
+  let
+    st = streamInput args
+    off = streamOffset args
+    failExp = Expect off (tokenClass test)
+    succExp = Expect (off + 1) zeroK
+  in
+    case syntaxInput args of
+      Just tok
+        | tokenClass test tok -> consumedOk args tok (snoc st tok) succExp
+        | otherwise -> consumedErr args failExp
+      Nothing -> case uncons st of
+        Nothing -> emptyErr args failExp
+        Just (tok, rest)
+          | tokenClass test tok -> consumedOk args tok rest succExp
+          | otherwise -> emptyErr args failExp
+
+-- Parsector instances
+instance Categorized (Item s) => Semigroup (Expect s) where
+  e1 <> e2 = case compare (expectOffset e1) (expectOffset e2) of
+    GT -> e1
+    LT -> e2
+    EQ -> Expect
+      { expectOffset = expectOffset e1
+      , expectPattern = expectPattern e1 >|< expectPattern e2
+      }
+instance Categorized (Item s) => Monoid (Expect s) where
+  mempty = Expect
+    { expectOffset = 0
+    , expectPattern = zeroK
+    }
+instance Profunctor (Parsector s) where
+  dimap f g p = Parsector $ \args -> runParsector p args
+    { syntaxInput = fmap f (syntaxInput args)
+    , consumedOk = consumedOk args . g
+    , emptyOk = emptyOk args . g
+    }
+instance Functor (Parsector s a) where
+  fmap = rmap
+instance Categorized (Item s) => Applicative (Parsector s a) where
+  pure b = Parsector $ \args ->
+    emptyOk args b (streamInput args) Expect
+      { expectOffset = streamOffset args
+      , expectPattern = zeroK
+      }
+  (<*>) = ap
+instance Categorized (Item s) => Alternative (Parsector s a) where
+  empty = Parsector $ \args -> emptyErr args Expect
+    { expectOffset = streamOffset args
+    , expectPattern = zeroK
+    }
+  p <|> q = try p `mplus` q
+instance Categorized (Item s) => Monad (Parsector s a) where
+  p >>= k = Parsector $ \args -> runParsector p args
+    { consumedOk = \b st' err -> runParsector (k b) args
+        { streamInput = st'
+        , streamOffset = expectOffset err
+        , emptyOk = \x st'' err' -> consumedOk args x st'' (err <> err')
+        , emptyErr = \err' -> consumedErr args (err <> err')
+        }
+    , emptyOk = \b st' err -> runParsector (k b) args
+        { streamInput = st'
+        , streamOffset = expectOffset err
+        , emptyOk = \x st'' err' -> emptyOk args x st'' (err <> err')
+        , emptyErr = \err' -> emptyErr args (err <> err')
+        }
+    }
+instance Categorized (Item s) => MonadPlus (Parsector s a) where
+  Parsector p `mplus` Parsector q = Parsector $ \args -> p args
+    { emptyErr = \err -> q args
+        { emptyOk = \b st' err' -> emptyOk args b st' (err <> err')
+        , emptyErr = \err' -> emptyErr args (err <> err')
+        }
+    }
+instance Categorized (Item s) => MonadFail (Parsector s a) where
+  fail msg = rule msg empty
+instance Categorized (Item s) => MonadTry (Parsector s a) where
+  try (Parsector p) = Parsector $ \args ->
+    p args { consumedErr = emptyErr args }
+instance Categorized (Item s) => Filterable (Parsector s a) where
+  mapMaybe = dimapMaybe Just
+instance Categorized (Item s) => Alternator (Parsector s) where
+  alternate (Left p) = Parsector $ \args ->
+    case syntaxInput args of
+      Just (Right _) -> emptyErr args Expect
+        { expectOffset = streamOffset args
+        , expectPattern = zeroK
+        }
+      mEAC -> runParsector p args
+        { syntaxInput = mEAC >>= either Just (const Nothing)
+        , consumedOk = \b st' err -> consumedOk args (Left b) st' err
+        , emptyOk = \b st' err -> emptyOk args (Left b) st' err
+        }
+  alternate (Right p) = Parsector $ \args ->
+    case syntaxInput args of
+      Just (Left _) -> emptyErr args Expect
+        { expectOffset = streamOffset args
+        , expectPattern = zeroK
+        }
+      mEAC -> runParsector p args
+        { syntaxInput = mEAC >>= either (const Nothing) Just
+        , consumedOk = \d st' err -> consumedOk args (Right d) st' err
+        , emptyOk = \d st' err -> emptyOk args (Right d) st' err
+        }
+instance Categorized (Item s) => Choice (Parsector s) where
+  left' = alternate . Left
+  right' = alternate . Right
+instance Categorized (Item s) => Distributor (Parsector s) where
+  x >+< y = alternate (Right y) <|> alternate (Left x)
+instance Categorized (Item s) => Filtrator (Parsector s) where
+  filtrate (Parsector p) =
+    ( Parsector $ \args ->
+        p args
+          { syntaxInput = Left <$> syntaxInput args
+          , consumedOk = \ebd st' err -> case ebd of
+              Left b -> consumedOk args b st' err
+              Right _ -> consumedErr args err
+          , emptyOk = \ebd st' err -> case ebd of
+              Left b -> emptyOk args b st' err
+              Right _ -> emptyErr args err
+          }
+    , Parsector $ \args ->
+        p args
+          { syntaxInput = Right <$> syntaxInput args
+          , consumedOk = \ebd st' err -> case ebd of
+              Right d -> consumedOk args d st' err
+              Left _ -> consumedErr args err
+          , emptyOk = \ebd st' err -> case ebd of
+              Right d -> emptyOk args d st' err
+              Left _ -> emptyErr args err
+          }
+    )
+instance Categorized (Item s) => Cochoice (Parsector s) where
+  unleft = fst . filtrate
+  unright = snd . filtrate
+instance
+  ( Categorized token, Item s ~ token
+  , Cons s s token token, Snoc s s token token
+  ) => TokenAlgebra token (Parsector s token token)
+instance
+  ( Categorized token, Item s ~ token
+  , Cons s s token token, Snoc s s token token
+  ) => TerminalSymbol token (Parsector s () ())
+instance
+  ( Categorized token, Item s ~ token
+  , Cons s s token token, Snoc s s token token
+  ) => Tokenized token (Parsector s token token) where
+  anyToken = satisfyParsector anyToken
+  token t = satisfyParsector (token t)
+  oneOf ts = satisfyParsector (oneOf ts)
+  notOneOf ts = satisfyParsector (notOneOf ts)
+  asIn cat = satisfyParsector (asIn cat)
+  notAsIn cat = satisfyParsector (notAsIn cat)
+instance Categorized (Item s)
+  => BackusNaurForm (Parsector s a b) where
+  rule name (Parsector p) = Parsector $ \args -> p args
+    { emptyOk = \b st' -> emptyOk args b st' . label
+    , emptyErr = emptyErr args . label
+    }
+    where
+      label fl = fl
+        { expectPattern = rule name (expectPattern fl)}
+  ruleRec name f = rule name (fix f)
diff --git a/src/Data/Profunctor/Monadic.hs b/src/Data/Profunctor/Monadic.hs
index 54d4a37..e00755a 100644
--- a/src/Data/Profunctor/Monadic.hs
+++ b/src/Data/Profunctor/Monadic.hs
@@ -25,9 +25,16 @@ module Data.Profunctor.Monadic
   , (>>=)
   , (>>)
   , return
+  , MonadicTry
   , fail
+  , try
+  , mzero
+  , mplus
+  , mchoice
   ) where
 
+import Control.Monad hiding ((>>=), (>>))
+import Control.Monad.Try
 import Data.Profunctor
 import Prelude hiding ((>>=), (>>))
 
@@ -50,3 +57,5 @@ p >>= f = do
 (>>) :: Monadic p => p () c -> p a b -> p a b
 infixl 1 >>
 x >> y = do _ <- lmap (const ()) x; y
+
+type MonadicTry p = (Profunctor p, forall x. MonadTry (p x))

From fdf60c04fcb4c19400d28f939d3027f405385d14 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 24 Mar 2026 15:38:26 -0700
Subject: [PATCH 036/103] regex refactor

remove redundant terms which represent the same regex value.
---
 src/Control/Lens/Grammar.hs            |  95 +++++-----
 src/Control/Lens/Grammar/BackusNaur.hs |   9 +-
 src/Control/Lens/Grammar/Boole.hs      | 135 -------------
 src/Control/Lens/Grammar/Kleene.hs     | 250 ++++++++++++++++++-------
 src/Data/Profunctor/Grammar.hs         |   1 -
 test/Examples/Json.hs                  |   1 +
 test/Examples/RegString.hs             |   3 +-
 test/Examples/SExpr.hs                 |   2 +-
 8 files changed, 232 insertions(+), 264 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index f0aeff1..e180957 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -369,7 +369,7 @@ ab|c
 `RegString`s are actually stored as an algebraic datatype, `RegEx`.
 
 >>> runRegString rex
-RegExam (Alternate (Terminal "ab") (Terminal "c"))
+RegExam (Alternate (Sequence (RegExam (OneOf (fromList "a"))) (RegExam (OneOf (fromList "b")))) (RegExam (OneOf (fromList "c"))))
 
 `RegString`s are similar to regular expression strings in many other
 programming languages. We can use them to see if a word and pattern
@@ -519,20 +519,19 @@ are a context-free language.
 >>> putStringLn (regbnfG regexGrammar)
 {start} = \q{regex}
 {alternate} = \q{sequence}(\|\q{sequence})*
-{atom} = (\\q\{)\q{char}*\}|\q{char}|\q{char-class}|\(\q{regex}\)
+{atom} = \\q\q{nonterminal}|\q{class}|\(\q{regex}\)
 {category} = Ll|Lu|Lt|Lm|Lo|Mn|Mc|Me|Nd|Nl|No|Pc|Pd|Ps|Pe|Pi|Pf|Po|Sm|Sc|Sk|So|Zs|Zl|Zp|Cc|Cf|Cs|Co|Cn
-{category-test} = (\\p\{)\q{category}\}|(\\P\{)(\q{category}(\|\q{category})*)\}
 {char} = [^\(\)\*\+\?\[\\\]\^\{\|\}\P{Cc}]|\\\q{char-escaped}
-{char-any} = \[\^\]
-{char-class} = \q{fail}|\q{char-any}|\q{one-of}|\q{not-one-of}|\q{category-test}
 {char-control} = NUL|SOH|STX|ETX|EOT|ENQ|ACK|BEL|BS|HT|LF|VT|FF|CR|SO|SI|DLE|DC1|DC2|DC3|DC4|NAK|SYN|ETB|CAN|EM|SUB|ESC|FS|GS|RS|US|DEL|PAD|HOP|BPH|NBH|IND|NEL|SSA|ESA|HTS|HTJ|VTS|PLD|PLU|RI|SS2|SS3|DCS|PU1|PU2|STS|CCH|MW|SPA|EPA|SOS|SGCI|SCI|CSI|ST|OSC|PM|APC
 {char-escaped} = [\(\)\*\+\?\[\\\]\^\{\|\}]|\q{char-control}
+{class} = \q{class-one-of}|\q{class-not-one-of}
+{class-category} = \\p\{\q{category}\}|\\P\{(\q{category}(\|\q{category})*)\}
+{class-not-one-of} = \q{class-category}|\[\^\q{char}*(\q{class-category}?\])
+{class-one-of} = \q{char}|\[\q{char}*\]
 {expression} = \q{atom}\?|\q{atom}\*|\q{atom}\+|\q{atom}
-{fail} = \[\]
-{not-one-of} = (\[\^)\q{char}+(\q{category-test}?\])
-{one-of} = \[\q{char}+\]
+{nonterminal} = \{\q{char}*\}
 {regex} = \q{alternate}
-{sequence} = \q{char}*|\q{expression}*
+{sequence} = \q{expression}*
 -}
 regexGrammar :: Grammar Char RegString
 regexGrammar = _RegString >~ ruleRec "regex" altG
@@ -540,10 +539,8 @@ regexGrammar = _RegString >~ ruleRec "regex" altG
     altG rex = rule "alternate" $
       chain1 Left (_RegExam . _Alternate) (sepBy (terminal "|")) (seqG rex)
 
-    seqG rex = rule "sequence" $ choice
-      [ _Terminal >? manyP charG
-      , chain Left _Sequence (_Terminal . _Empty) noSep (exprG rex)
-      ]
+    seqG rex = rule "sequence" $
+      chain Left _Sequence _Epsilon noSep (exprG rex)
 
     exprG rex = rule "expression" $ choice
       [ _KleeneOpt >? atomG rex *< terminal "?"
@@ -553,20 +550,11 @@ regexGrammar = _RegString >~ ruleRec "regex" altG
       ]
 
     atomG rex = rule "atom" $ choice
-      [ _NonTerminal >? terminal "\\q{" >* manyP charG *< terminal "}"
-      , _Terminal >? charG >:< asEmpty
+      [ _NonTerminal >? terminal "\\q" >* nonterminalG
       , _RegExam >? classG
       , terminal "(" >* rex *< terminal ")"
       ]
 
-    catTestG = rule "category-test" $ choice
-      [ _AsIn >? terminal "\\p{" >* categoryG *< terminal "}"
-      , _NotAsIn >? several1 (sepBy (terminal "|"))
-          { beginBy = terminal "\\P{"
-          , endBy = terminal "}"
-          } categoryG
-      ]
-
     categoryG = rule "category" $ choice
       [ _LowercaseLetter >? terminal "Ll"
       , _UppercaseLetter >? terminal "Lu"
@@ -600,24 +588,33 @@ regexGrammar = _RegString >~ ruleRec "regex" altG
       , _NotAssigned >? terminal "Cn"
       ]
 
-    classG = rule "char-class" $ choice
-      [ _Fail >? failG
-      , _Pass >? anyG
-      , _OneOf >? oneOfG
-      , _NotOneOf >? notOneOfG
-      , _NotOneOf >? pure Set.empty >*< catTestG
+    classG = rule "class" $ choice
+      [ _OneOf >? classOneOfG
+      , _NotOneOf >? classNotOneOfG
       ]
 
-    failG = rule "fail" $ terminal "[]"
+    classCatG = rule "class-category" $ choice
+      [ _AsIn >? terminal "\\p{" >* categoryG *< terminal "}"
+      , _NotAsIn >? several1 (sepBy (terminal "|"))
+          { beginBy = terminal "\\P{"
+          , endBy = terminal "}"
+          } categoryG
+      ]
 
-    anyG = rule "char-any" $ terminal "[^]"
+    classOneOfG = rule "class-one-of" $ choice
+      [ iso toList fromList >~ charG >:< asEmpty
+      , terminal "[" >* several noSep charG *< terminal "]"
+      ]
 
-    oneOfG = rule "one-of" $ terminal "[" >* several1 noSep charG *< terminal "]"
+    classNotOneOfG = rule "class-not-one-of" $ choice
+      [ asEmpty >*< classCatG
+      , terminal "[^" >* several noSep charG >*<
+          option (NotAsIn Set.empty) classCatG *< terminal "]"
+      ]
 
-    notOneOfG = rule "not-one-of" $
-      terminal "[^" >* several1 noSep charG
-        >*< option (NotAsIn Set.empty) catTestG
-        *< terminal "]"
+nonterminalG :: Grammar Char String
+nonterminalG = rule "nonterminal" $
+  terminal "{" >* manyP charG *< terminal "}"
 
 charG :: Grammar Char Char
 charG = rule "char" $
@@ -704,30 +701,26 @@ That means that it can generate a self-hosted definition.
 >>> putStringLn (regbnfG regbnfGrammar)
 {start} = \q{regbnf}
 {alternate} = \q{sequence}(\|\q{sequence})*
-{atom} = (\\q\{)\q{char}*\}|\q{char}|\q{char-class}|\(\q{regex}\)
+{atom} = \\q\q{nonterminal}|\q{class}|\(\q{regex}\)
 {category} = Ll|Lu|Lt|Lm|Lo|Mn|Mc|Me|Nd|Nl|No|Pc|Pd|Ps|Pe|Pi|Pf|Po|Sm|Sc|Sk|So|Zs|Zl|Zp|Cc|Cf|Cs|Co|Cn
-{category-test} = (\\p\{)\q{category}\}|(\\P\{)(\q{category}(\|\q{category})*)\}
 {char} = [^\(\)\*\+\?\[\\\]\^\{\|\}\P{Cc}]|\\\q{char-escaped}
-{char-any} = \[\^\]
-{char-class} = \q{fail}|\q{char-any}|\q{one-of}|\q{not-one-of}|\q{category-test}
 {char-control} = NUL|SOH|STX|ETX|EOT|ENQ|ACK|BEL|BS|HT|LF|VT|FF|CR|SO|SI|DLE|DC1|DC2|DC3|DC4|NAK|SYN|ETB|CAN|EM|SUB|ESC|FS|GS|RS|US|DEL|PAD|HOP|BPH|NBH|IND|NEL|SSA|ESA|HTS|HTJ|VTS|PLD|PLU|RI|SS2|SS3|DCS|PU1|PU2|STS|CCH|MW|SPA|EPA|SOS|SGCI|SCI|CSI|ST|OSC|PM|APC
 {char-escaped} = [\(\)\*\+\?\[\\\]\^\{\|\}]|\q{char-control}
+{class} = \q{class-one-of}|\q{class-not-one-of}
+{class-category} = \\p\{\q{category}\}|\\P\{(\q{category}(\|\q{category})*)\}
+{class-not-one-of} = \q{class-category}|\[\^\q{char}*(\q{class-category}?\])
+{class-one-of} = \q{char}|\[\q{char}*\]
 {expression} = \q{atom}\?|\q{atom}\*|\q{atom}\+|\q{atom}
-{fail} = \[\]
-{not-one-of} = (\[\^)\q{char}+(\q{category-test}?\])
-{one-of} = \[\q{char}+\]
-{regbnf} = (\{start\} = )\q{regex}(\LF\q{rule})*
+{nonterminal} = \{\q{char}*\}
+{regbnf} = \{start\} = \q{regex}(\LF\q{nonterminal}( = )\q{regex})*
 {regex} = \q{alternate}
-{rule} = \{\q{char}*(\} = )\q{regex}
-{sequence} = \q{char}*|\q{expression}*
+{sequence} = \q{expression}*
 -}
 regbnfGrammar :: Grammar Char RegBnf
 regbnfGrammar = rule "regbnf" $ _RegBnf . _Bnf >~
-  terminal "{start} = " >* regexGrammar
-    >*< several noSep (terminal "\n" >* ruleG)
-  where
-    ruleG = rule "rule" $ terminal "{" >* manyP charG *< terminal "} = "
-      >*< regexGrammar
+  terminal "{start} = " >* regexGrammar >*< several noSep
+    (terminal "\n" >* nonterminalG *< terminal " = " >*< regexGrammar)
+      
 
 {- | `regstringG` generates a `RegString` from a regular grammar.
 Since context-free `Grammar`s and `CtxGrammar`s aren't necessarily regular,
diff --git a/src/Control/Lens/Grammar/BackusNaur.hs b/src/Control/Lens/Grammar/BackusNaur.hs
index 8beba91..b3c7d5d 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -26,7 +26,6 @@ module Control.Lens.Grammar.BackusNaur
 
 import Control.Lens
 import Control.Lens.Extras
-import Control.Lens.Grammar.Boole
 import Control.Lens.Grammar.Kleene
 import Control.Lens.Grammar.Token
 import Control.Lens.Grammar.Symbol
@@ -97,9 +96,7 @@ diffB prefix (Bnf start rules) =
   where
     -- derivative wrt 1 token, memoized
     diff1B = memo2 $ \x -> \case
-      Terminal [] -> zeroK
-      Terminal (tokenY:streamY) ->
-        if x == tokenY then terminal streamY else zeroK
+      Epsilon -> zeroK
       NonTerminal nameY -> anyK (diff1B x) (rulesNamed nameY rules)
       Sequence y1 y2 ->
         if δ (Bnf y1 rules) then y1'y2 >|< y1y2' else y1'y2
@@ -109,8 +106,6 @@ diffB prefix (Bnf start rules) =
       KleeneStar y -> diff1B x y <> starK y
       KleeneOpt y -> diff1B x y
       KleenePlus y -> diff1B x y <> starK y
-      RegExam Fail -> zeroK
-      RegExam Pass -> mempty
       RegExam (OneOf chars) ->
         if x `elem` chars then mempty else zeroK
       RegExam (NotOneOf chars (AsIn cat)) ->
@@ -126,7 +121,7 @@ diffB prefix (Bnf start rules) =
   => Bnf (RegEx token) -> Bool
 δ (Bnf start rules) = ν start where
   ν = memo $ \case
-    Terminal [] -> True
+    Epsilon -> True
     KleeneStar _ -> True
     KleeneOpt _ -> True
     KleenePlus y -> ν y
diff --git a/src/Control/Lens/Grammar/Boole.hs b/src/Control/Lens/Grammar/Boole.hs
index 3a5b2ec..c272fcd 100644
--- a/src/Control/Lens/Grammar/Boole.hs
+++ b/src/Control/Lens/Grammar/Boole.hs
@@ -16,20 +16,10 @@ module Control.Lens.Grammar.Boole
   ( -- * BooleanAlgebra
     BooleanAlgebra (..)
   , andB, orB, allB, anyB
-    -- * TokenAlgebra
-  , TokenAlgebra (..)
-  , TokenTest (..)
   ) where
 
-import Control.Applicative
-import Control.Lens.Grammar.Kleene
-import Control.Lens.Grammar.Token
 import Data.Foldable
 import Data.Monoid
-import Data.Profunctor
-import Data.Profunctor.Distributor
-import qualified Data.Set as Set
-import GHC.Generics
 
 -- | A `BooleanAlgebra`, like `Bool`, supporting classical logical operations.
 class BooleanAlgebra b where
@@ -74,137 +64,12 @@ allB f = foldl' (\b a -> b >&&< f a) (fromBool True)
 anyB :: (Foldable f, BooleanAlgebra b) => (a -> b) -> f a -> b
 anyB f = foldl' (\b a -> b >||< f a) (fromBool False)
 
--- | `TokenTest` forms a closed `Tokenized` `BooleanAlgebra`,
--- for use an an argument to `tokenClass`.
-newtype TokenTest token = TokenTest (RegExam token (TokenTest token))
-
--- | `TokenAlgebra` extends `Tokenized` methods to support
--- `BooleanAlgebra` operations in a `tokenClass`
-class Tokenized token p => TokenAlgebra token p where
-  -- | Arguments of `tokenClass` can be constructed from
-  -- `Tokenized` and `BooleanAlgebra` methods.
-  tokenClass :: TokenTest token -> p
-  default tokenClass
-    :: (p ~ q token token, Alternator q, Cochoice q)
-    => TokenTest token -> p
-  tokenClass (TokenTest exam) = case exam of
-    Fail -> empty
-    Pass -> anyToken
-    OneOf chars -> oneOf chars
-    NotOneOf chars (AsIn cat) ->
-      satisfy (notOneOf chars >&&< asIn cat)
-    NotOneOf chars (NotAsIn cats) ->
-      satisfy (notOneOf chars >&&< allB notAsIn cats)
-    Alternate exam1 exam2 -> tokenClass exam1 <|> tokenClass exam2
-
 --instances
 instance BooleanAlgebra (x -> Bool)
-instance Categorized token => TokenAlgebra token (token -> Bool) where
-  tokenClass (TokenTest exam) = case exam of
-    Fail -> const False
-    Pass -> const True
-    OneOf chars -> oneOf chars
-    NotOneOf chars (AsIn cat) -> notOneOf chars >&&< asIn cat
-    NotOneOf chars (NotAsIn cats) -> notOneOf chars >&&< allB notAsIn cats
-    Alternate exam1 exam2 -> tokenClass exam1 >||< tokenClass exam2
 instance (Applicative f, BooleanAlgebra bool)
   => BooleanAlgebra (Ap f bool)
-deriving stock instance Generic (TokenTest token)
-deriving stock instance
-  (Categorized token, Read token, Read (Categorize token))
-    => Read (TokenTest token)
-deriving stock instance
-  (Categorized token, Show token, Show (Categorize token))
-    => Show (TokenTest token)
 instance BooleanAlgebra Bool where
   fromBool = id
   notB = not
   (>&&<) = (&&)
   (>||<) = (||)
-deriving newtype instance Categorized token
-  => Eq (TokenTest token)
-deriving newtype instance Categorized token
-  => Ord (TokenTest token)
-deriving newtype instance Categorized token
-  => BooleanAlgebra (TokenTest token)
-deriving newtype instance Categorized token
-  => Tokenized token (TokenTest token)
-instance Categorized token
-  => TokenAlgebra token (RegEx token) where
-  tokenClass (TokenTest tokenExam) = case tokenExam of
-    Fail -> RegExam Fail
-    Pass -> RegExam Pass
-    OneOf as -> RegExam (OneOf as)
-    NotOneOf as catTest -> RegExam (NotOneOf as catTest)
-    Alternate exam1 exam2 ->
-      RegExam (Alternate (tokenClass exam1) (tokenClass exam2))
-instance Categorized token
-  => BooleanAlgebra (RegExam token (TokenTest token)) where
-  fromBool = \case
-    False -> Fail
-    True -> Pass
-  notB Fail = Pass
-  notB Pass = Fail
-  notB (Alternate (TokenTest x) (TokenTest y)) = notB x >&&< notB y
-  notB (OneOf xs) = notOneOf xs
-  notB (NotOneOf xs (AsIn y)) = oneOf xs >||< notAsIn y
-  notB (NotOneOf xs (NotAsIn ys)) = oneOf xs >||< anyB asIn ys
-  _ >&&< Fail = Fail
-  Fail >&&< _ = Fail
-  x >&&< Pass = x
-  Pass >&&< y = y
-  x >&&< Alternate (TokenTest y) (TokenTest z) = (x >&&< y) >||< (x >&&< z)
-  Alternate (TokenTest x) (TokenTest y) >&&< z = (x >&&< z) >||< (y >&&< z)
-  OneOf xs >&&< OneOf ys = OneOf (Set.intersection xs ys)
-  OneOf xs >&&< NotOneOf ys (AsIn z) = OneOf
-    (Set.filter (\x -> categorize x == z) (Set.difference xs ys))
-  NotOneOf xs (AsIn y) >&&< OneOf zs = OneOf
-    (Set.filter (\z -> categorize z == y) (Set.difference zs xs))
-  OneOf xs >&&< NotOneOf ys (NotAsIn zs) = OneOf
-    (Set.filter (\x -> categorize x `notElem` zs) (Set.difference xs ys))
-  NotOneOf xs (NotAsIn ys) >&&< OneOf zs = OneOf
-    (Set.filter (\z -> categorize z `notElem` ys) (Set.difference zs xs))
-  NotOneOf xs (AsIn y) >&&< NotOneOf ws (AsIn z) =
-    if y /= z then Fail else NotOneOf
-      (Set.filter (\x -> categorize x == y)
-      (Set.union xs ws)) (AsIn y)
-  NotOneOf xs (AsIn y) >&&< NotOneOf ws (NotAsIn zs) =
-    if y `elem` zs then Fail else NotOneOf
-      (Set.filter (\x -> categorize x == y)
-      (Set.union xs ws)) (AsIn y)
-  NotOneOf xs (NotAsIn ys) >&&< NotOneOf ws (AsIn z) =
-    if z `elem` ys then Fail else NotOneOf
-      (Set.filter (\x -> categorize x == z) (Set.union xs ws))
-      (AsIn z)
-  NotOneOf xs (NotAsIn ys) >&&< NotOneOf ws (NotAsIn zs) =
-    let
-      xws = Set.union xs ws
-      yzs = Set.union ys zs
-    in
-      NotOneOf
-        (Set.filter (\x -> categorize x `notElem` yzs) xws)
-        (NotAsIn yzs)
-  x >||< Fail = x
-  Fail >||< y = y
-  _ >||< Pass = Pass
-  Pass >||< _ = Pass
-  x >||< Alternate y z = Alternate (TokenTest x) (TokenTest (Alternate y z))
-  Alternate x y >||< z = Alternate (TokenTest (Alternate x y)) (TokenTest z)
-  OneOf xs >||< OneOf ys = oneOf (Set.union xs ys)
-  OneOf xs >||< NotOneOf ys z =
-    Alternate (TokenTest (OneOf xs)) (TokenTest (NotOneOf ys z))
-  NotOneOf xs y >||< OneOf zs =
-    Alternate (TokenTest (NotOneOf xs y)) (TokenTest (OneOf zs))
-  NotOneOf xs (NotAsIn ys) >||< NotOneOf ws (NotAsIn zs) =
-    notOneOf (Set.intersection xs ws) >&&< allB notAsIn (Set.intersection ys zs)
-  NotOneOf xs (AsIn y) >||< NotOneOf ws (AsIn z) =
-    if y == z then NotOneOf (Set.intersection xs ws) (AsIn y)
-    else Alternate
-      (TokenTest (NotOneOf xs (AsIn y)))
-      (TokenTest (NotOneOf ws (AsIn z)))
-  NotOneOf xs (NotAsIn ys) >||< NotOneOf ws (AsIn z) = Alternate
-    (TokenTest (NotOneOf xs (NotAsIn ys)))
-    (TokenTest (NotOneOf ws (AsIn z)))
-  NotOneOf xs (AsIn y) >||< NotOneOf ws (NotAsIn zs) = Alternate
-    (TokenTest (NotOneOf xs (AsIn y)))
-    (TokenTest (NotOneOf ws (NotAsIn zs)))
diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index 2884553..9837f43 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -20,15 +20,20 @@ module Control.Lens.Grammar.Kleene
   , RegEx (..)
   , RegExam (..)
   , CategoryTest (..)
+    -- * TokenAlgebra
+  , TokenClass (..)
+  , TokenAlgebra (..)
   ) where
 
 import Control.Applicative
+import Control.Lens.Grammar.Boole
 import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
 import Data.Foldable
 import Data.MemoTrie
 import Data.Monoid
 import Data.Profunctor
+import Data.Profunctor.Distributor
 import Data.Set (Set)
 import qualified Data.Set as Set
 import GHC.Generics
@@ -69,7 +74,7 @@ anyK f = foldl' (\b a -> b >|< f a) zeroK
 
 -- | The `RegEx`pression type is the prototypical `KleeneStarAlgebra`.
 data RegEx token
-  = Terminal [token]
+  = Epsilon
   | NonTerminal String
   | Sequence (RegEx token) (RegEx token)
   | KleeneStar (RegEx token)
@@ -77,27 +82,57 @@ data RegEx token
   | KleenePlus (RegEx token)
   | RegExam (RegExam token (RegEx token))
 
-{- | A component of both `RegEx`pressions
-and `Control.Lens.Grammar.Boole.TokenTest`s, so that the latter can
-be embedded in the former with `Control.Lens.Grammar.Boole.tokenClass`.
+{- | A component of both `RegEx`pressions and `TokenClass`es,
+so that the latter can be embedded in the former with `tokenClass`.
 -}
 data RegExam token alg
-  = Fail
-  | Pass
-  | OneOf (Set token)
+  = OneOf (Set token)
   | NotOneOf (Set token) (CategoryTest token)
   | Alternate alg alg
 
+failExam :: RegExam token alg
+failExam = OneOf Set.empty
+
+passExam :: RegExam token alg
+passExam = NotOneOf Set.empty (NotAsIn Set.empty)
+
+isFailExam :: RegExam token alg -> Bool
+isFailExam (OneOf xs) = Set.null xs
+isFailExam _ = False
+
+isPassExam :: RegExam token alg -> Bool
+isPassExam (NotOneOf xs (NotAsIn ys)) = Set.null xs && Set.null ys
+isPassExam _ = False
+
 {- | `CategoryTest`s for `Categorized` tokens.-}
 data CategoryTest token
   = AsIn (Categorize token)
   | NotAsIn (Set (Categorize token))
 
+-- | `TokenClass` forms a closed `Tokenized` `BooleanAlgebra`.
+newtype TokenClass token = TokenClass (RegExam token (TokenClass token))
+
+-- | `TokenAlgebra` extends `Tokenized` methods to support
+-- `BooleanAlgebra` operations in a `tokenClass`.
+class Tokenized token p => TokenAlgebra token p where
+  tokenClass :: TokenClass token -> p
+  default tokenClass
+    :: (p ~ q token token, Alternator q, Cochoice q)
+    => TokenClass token -> p
+  tokenClass (TokenClass exam) = case exam of
+    OneOf chars -> oneOf chars
+    NotOneOf chars (AsIn cat) ->
+      satisfy (notOneOf chars >&&< asIn cat)
+    NotOneOf chars (NotAsIn cats) ->
+      satisfy (notOneOf chars >&&< allB notAsIn cats)
+    Alternate exam1 exam2 -> tokenClass exam1 <|> tokenClass exam2
+
 --instances
 instance (Alternative f, Monoid k) => KleeneStarAlgebra (Ap f k)
 deriving stock instance Generic (RegEx token)
 deriving stock instance Generic (RegExam token alg)
 deriving stock instance Generic1 (RegExam token)
+deriving stock instance Generic (TokenClass token)
 deriving stock instance Generic (CategoryTest token)
 deriving stock instance Categorized token => Eq (RegEx token)
 deriving stock instance Categorized token => Ord (RegEx token)
@@ -107,67 +142,155 @@ deriving stock instance
 deriving stock instance
   (Categorized token, Show token, Show (Categorize token))
     => Show (RegEx token)
-instance TerminalSymbol token (RegEx token) where
-  terminal = Terminal . toList
+deriving stock instance
+  (Categorized token, Read token, Read (Categorize token))
+    => Read (TokenClass token)
+deriving stock instance
+  (Categorized token, Show token, Show (Categorize token))
+    => Show (TokenClass token)
+deriving newtype instance Categorized token => Eq (TokenClass token)
+deriving newtype instance Categorized token => Ord (TokenClass token)
+deriving newtype instance Categorized token => Tokenized token (TokenClass token)
+deriving newtype instance Categorized token => BooleanAlgebra (TokenClass token)
+instance Categorized token => TerminalSymbol token (RegEx token) where
+  terminal = foldl (\acc t -> acc <> token t) mempty
 instance NonTerminalSymbol (RegEx token) where
   nonTerminal = NonTerminal
 instance Categorized token => Tokenized token (RegEx token) where
-  anyToken = RegExam Pass
-  token a = Terminal [a]
-  oneOf as | null as = RegExam Fail
-  oneOf as | length as == 1 = Terminal (toList as)
-  oneOf as = RegExam (OneOf (foldr Set.insert Set.empty as))
-  notOneOf as | null as = RegExam Pass
-  notOneOf as = RegExam
-    (NotOneOf (foldr Set.insert Set.empty as) (NotAsIn Set.empty))
+  anyToken = RegExam passExam
+  token a = RegExam (OneOf (Set.singleton a))
+  oneOf as = RegExam (OneOf (Set.fromList (toList as)))
+  notOneOf as =
+    RegExam (NotOneOf (Set.fromList (toList as)) (NotAsIn Set.empty))
   asIn cat = RegExam (NotOneOf Set.empty (AsIn cat))
-  notAsIn cat = RegExam
-    (NotOneOf Set.empty (NotAsIn (Set.singleton cat)))
+  notAsIn cat = RegExam (NotOneOf Set.empty (NotAsIn (Set.singleton cat)))
+instance Categorized token => TokenAlgebra token (token -> Bool) where
+  tokenClass (TokenClass exam) x = case exam of
+    OneOf xs -> Set.member x xs
+    NotOneOf xs (AsIn y) ->
+      Set.notMember x xs && categorize x == y
+    NotOneOf xs (NotAsIn ys) ->
+      Set.notMember x xs && Set.notMember (categorize x) ys
+    Alternate exam1 exam2 ->
+      tokenClass exam1 x || tokenClass exam2 x
+instance Categorized token => TokenAlgebra token (RegEx token) where
+  tokenClass (TokenClass exam) = case exam of
+    OneOf as -> RegExam (OneOf as)
+    NotOneOf as catTest -> RegExam (NotOneOf as catTest)
+    Alternate exam1 exam2 ->
+      RegExam (Alternate (tokenClass exam1) (tokenClass exam2))
+instance Categorized token => Monoid (RegEx token) where
+  mempty = Epsilon
 instance Categorized token => Semigroup (RegEx token) where
-  Terminal [] <> rex = rex
-  rex <> Terminal [] = rex
-  RegExam Fail <> _ = zeroK
-  _ <> RegExam Fail = zeroK
-  Terminal str0 <> Terminal str1 = Terminal (str0 <> str1)
-  KleeneStar rex0 <> rex1
-    | rex0 == rex1 = plusK rex0
-  rex0 <> KleeneStar rex1
-    | rex0 == rex1 = plusK rex1
+  Epsilon <> rex = rex
+  rex <> Epsilon = rex
+  RegExam exam <> _ | isFailExam exam = zeroK
+  _ <> RegExam exam | isFailExam exam = zeroK
+  KleeneStar rex0 <> rex1 | rex0 == rex1 = plusK rex0
+  rex0 <> KleeneStar rex1 | rex0 == rex1 = plusK rex1
   rex0 <> rex1 = Sequence rex0 rex1
-instance Categorized token => Monoid (RegEx token) where
-  mempty = Terminal []
 instance Categorized token => KleeneStarAlgebra (RegEx token) where
-  zeroK = RegExam Fail
-  optK (RegExam Fail) = mempty
-  optK (Terminal []) = mempty
+  zeroK = RegExam failExam
+  optK (RegExam exam) | isFailExam exam = mempty
+  optK Epsilon = mempty
   optK (KleenePlus rex) = starK rex
   optK rex = KleeneOpt rex
-  starK (RegExam Fail) = mempty
-  starK (Terminal []) = mempty
+  starK (RegExam exam) | isFailExam exam = mempty
+  starK Epsilon = mempty
   starK rex = KleeneStar rex
-  plusK (RegExam Fail) = zeroK
-  plusK (Terminal []) = mempty
+  plusK (RegExam exam) | isFailExam exam = zeroK
+  plusK Epsilon = mempty
   plusK rex = KleenePlus rex
-  KleenePlus rex >|< Terminal [] = starK rex
-  Terminal [] >|< KleenePlus rex = starK rex
-  rex >|< Terminal [] = optK rex
-  Terminal [] >|< rex = optK rex
-  rex >|< RegExam Fail = rex
-  RegExam Fail >|< rex = rex
+  KleenePlus rex >|< Epsilon = starK rex
+  Epsilon >|< KleenePlus rex = starK rex
+  rex >|< Epsilon = optK rex
+  Epsilon >|< rex = optK rex
+  rex >|< RegExam exam | isFailExam exam = rex
+  RegExam exam >|< rex | isFailExam exam = rex
+  rex0 >|< rex1 | Just tokenOr <- maybeOr = tokenClass tokenOr
+    where
+      toTokenClass (RegExam exam) =
+        TokenClass <$> traverse toTokenClass exam
+      toTokenClass _ = Nothing
+      maybeOr = (>||<) <$> toTokenClass rex0 <*> toTokenClass rex1
   rex0 >|< rex1 | rex0 == rex1 = rex0
   rex0 >|< rex1 = RegExam (Alternate rex0 rex1)
-instance Categorized token
-  => Tokenized token (RegExam token alg) where
-  anyToken = Pass
+instance Categorized token => Tokenized token (RegExam token alg) where
+  anyToken = passExam
   token a = OneOf (Set.singleton a)
-  oneOf as | null as = Fail
+  oneOf as | null as = failExam
   oneOf as = OneOf (Set.fromList (toList as))
-  notOneOf as | null as = Pass
+  notOneOf as | null as = passExam
   notOneOf as =
     NotOneOf (Set.fromList (toList as)) (NotAsIn Set.empty)
   asIn cat = NotOneOf Set.empty (AsIn cat)
-  notAsIn cat =
-    NotOneOf Set.empty (NotAsIn (Set.singleton cat))
+  notAsIn cat = NotOneOf Set.empty (NotAsIn (Set.singleton cat))
+instance Categorized token
+  => BooleanAlgebra (RegExam token (TokenClass token)) where
+  fromBool False = failExam
+  fromBool True = passExam
+  notB exam | isFailExam exam = passExam
+  notB exam | isPassExam exam = failExam
+  notB (Alternate (TokenClass x) (TokenClass y)) = notB x >&&< notB y
+  notB (OneOf xs) = notOneOf xs
+  notB (NotOneOf xs (AsIn y)) = oneOf xs >||< notAsIn y
+  notB (NotOneOf xs (NotAsIn ys)) = oneOf xs >||< anyB asIn ys
+  _ >&&< exam | isFailExam exam = failExam
+  exam >&&< _ | isFailExam exam = failExam
+  x >&&< exam | isPassExam exam = x
+  exam >&&< z | isPassExam exam = z
+  x >&&< Alternate (TokenClass y) (TokenClass z) = (x >&&< y) >||< (x >&&< z)
+  Alternate (TokenClass x) (TokenClass y) >&&< z = (x >&&< z) >||< (y >&&< z)
+  OneOf xs >&&< OneOf ys = OneOf (Set.intersection xs ys)
+  OneOf xs >&&< NotOneOf ys (AsIn z) = OneOf
+    (Set.filter (\x -> categorize x == z) (Set.difference xs ys))
+  NotOneOf xs (AsIn y) >&&< OneOf zs = OneOf
+    (Set.filter (\z -> categorize z == y) (Set.difference zs xs))
+  OneOf xs >&&< NotOneOf ys (NotAsIn zs) = OneOf
+    (Set.filter (\x -> categorize x `notElem` zs) (Set.difference xs ys))
+  NotOneOf xs (NotAsIn ys) >&&< OneOf zs = OneOf
+    (Set.filter (\z -> categorize z `notElem` ys) (Set.difference zs xs))
+  NotOneOf xs (AsIn y) >&&< NotOneOf ws (AsIn z) =
+    if y /= z then failExam else NotOneOf
+      (Set.filter (\x -> categorize x == y) (Set.union xs ws)) (AsIn y)
+  NotOneOf xs (AsIn y) >&&< NotOneOf ws (NotAsIn zs) =
+    if y `elem` zs then failExam else NotOneOf
+      (Set.filter (\x -> categorize x == y) (Set.union xs ws)) (AsIn y)
+  NotOneOf xs (NotAsIn ys) >&&< NotOneOf ws (AsIn z) =
+    if z `elem` ys then failExam else NotOneOf
+      (Set.filter (\x -> categorize x == z) (Set.union xs ws)) (AsIn z)
+  NotOneOf xs (NotAsIn ys) >&&< NotOneOf ws (NotAsIn zs) =
+    let
+      xws = Set.union xs ws
+      yzs = Set.union ys zs
+    in
+      NotOneOf
+        (Set.filter (\x -> categorize x `notElem` yzs) xws)
+        (NotAsIn yzs)
+  x >||< exam | isFailExam exam = x
+  exam >||< y | isFailExam exam = y
+  _ >||< exam | isPassExam exam = passExam
+  exam >||< _ | isPassExam exam = passExam
+  x >||< Alternate y z = Alternate (TokenClass x) (TokenClass (Alternate y z))
+  Alternate x y >||< z = Alternate (TokenClass (Alternate x y)) (TokenClass z)
+  OneOf xs >||< OneOf ys = oneOf (Set.union xs ys)
+  OneOf xs >||< NotOneOf ys z =
+    Alternate (TokenClass (OneOf xs)) (TokenClass (NotOneOf ys z))
+  NotOneOf xs y >||< OneOf zs =
+    Alternate (TokenClass (NotOneOf xs y)) (TokenClass (OneOf zs))
+  NotOneOf xs (NotAsIn ys) >||< NotOneOf ws (NotAsIn zs) =
+    notOneOf (Set.intersection xs ws) >&&< allB notAsIn (Set.intersection ys zs)
+  NotOneOf xs (AsIn y) >||< NotOneOf ws (AsIn z) =
+    if y == z then NotOneOf (Set.intersection xs ws) (AsIn y)
+    else Alternate
+      (TokenClass (NotOneOf xs (AsIn y)))
+      (TokenClass (NotOneOf ws (AsIn z)))
+  NotOneOf xs (NotAsIn ys) >||< NotOneOf ws (AsIn z) = Alternate
+    (TokenClass (NotOneOf xs (NotAsIn ys)))
+    (TokenClass (NotOneOf ws (AsIn z)))
+  NotOneOf xs (AsIn y) >||< NotOneOf ws (NotAsIn zs) = Alternate
+    (TokenClass (NotOneOf xs (AsIn y)))
+    (TokenClass (NotOneOf ws (NotAsIn zs)))
 deriving stock instance
   (Categorized token, Read token, Read alg, Read (Categorize token))
     => Read (RegExam token alg)
@@ -177,10 +300,8 @@ deriving stock instance
 deriving stock instance Functor (RegExam token)
 deriving stock instance Foldable (RegExam token)
 deriving stock instance Traversable (RegExam token)
-deriving stock instance (Categorized token, Eq alg)
-  => Eq (RegExam token alg)
-deriving stock instance (Categorized token, Ord alg)
-  => Ord (RegExam token alg)
+deriving stock instance (Categorized token, Eq alg) => Eq (RegExam token alg)
+deriving stock instance (Categorized token, Ord alg) => Ord (RegExam token alg)
 deriving stock instance Categorized token => Eq (CategoryTest token)
 deriving stock instance Categorized token => Ord (CategoryTest token)
 deriving stock instance
@@ -192,40 +313,34 @@ deriving stock instance
 instance (Categorized token, HasTrie token)
   => HasTrie (RegEx token) where
     data (RegEx token :->: b) = RegExTrie
-      { terminalTrie :: [token] :->: b
+      { epsilonTrie :: b
       , nonTerminalTrie :: String :->: b
       , sequenceTrie :: (RegEx token, RegEx token) :->: b
       , alternateTrie :: (RegEx token, RegEx token) :->: b
       , kleeneStarTrie :: RegEx token :->: b
       , kleeneOptTrie :: RegEx token :->: b
       , kleenePlusTrie :: RegEx token :->: b
-      , failTrie :: b
-      , passTrie :: b
       , oneOfTrie :: [token] :->: b
       , notOneOfTrie :: ([token], Either Int [Int]) :->: b
       }
     trie f = RegExTrie
-      { terminalTrie = trie (f . terminal)
+      { epsilonTrie = f mempty
       , nonTerminalTrie = trie (f . nonTerminal)
       , sequenceTrie = trie (f . uncurry (<>))
       , alternateTrie = trie (f . uncurry (>|<))
       , kleeneStarTrie = trie (f . starK)
       , kleeneOptTrie = trie (f . optK)
       , kleenePlusTrie = trie (f . plusK)
-      , failTrie = f zeroK
-      , passTrie = f anyToken
       , oneOfTrie = trie (f . oneOf)
       , notOneOfTrie = trie (f . testNotOneOf)
       }
     untrie rex = \case
-      Terminal word -> untrie (terminalTrie rex) word
+      Epsilon -> epsilonTrie rex
       NonTerminal name -> untrie (nonTerminalTrie rex) name
       Sequence x1 x2 -> untrie (sequenceTrie rex) (x1,x2)
       KleeneStar x -> untrie (kleeneStarTrie rex) x
       KleenePlus x -> untrie (kleenePlusTrie rex) x
       KleeneOpt x -> untrie (kleeneOptTrie rex) x
-      RegExam Fail -> failTrie rex
-      RegExam Pass -> passTrie rex
       RegExam (OneOf chars) -> untrie (oneOfTrie rex) (Set.toList chars)
       RegExam (NotOneOf chars (AsIn cat)) ->
         untrie (notOneOfTrie rex) (Set.toList chars, Left (fromEnum cat))
@@ -234,20 +349,19 @@ instance (Categorized token, HasTrie token)
           (Set.toList chars, Right (Set.toList (Set.map fromEnum cats)))
       RegExam (Alternate x1 x2) -> untrie (alternateTrie rex) (x1,x2)
     enumerate rex = mconcat
-      [ first' Terminal <$> enumerate (terminalTrie rex)
+      [ [(Epsilon, epsilonTrie rex)]
       , first' NonTerminal <$> enumerate (nonTerminalTrie rex)
       , first' (uncurry Sequence) <$> enumerate (sequenceTrie rex)
       , first' (RegExam . uncurry Alternate) <$> enumerate (alternateTrie rex)
       , first' KleeneStar <$> enumerate (kleeneStarTrie rex)
       , first' KleeneOpt <$> enumerate (kleeneOptTrie rex)
       , first' KleenePlus <$> enumerate (kleenePlusTrie rex)
-      , [(RegExam Fail, failTrie rex)]
-      , [(RegExam Pass, passTrie rex)]
       , first' (RegExam . OneOf . Set.fromList) <$> enumerate (oneOfTrie rex)
       , first' testNotOneOf <$> enumerate (notOneOfTrie rex)
       ]
 testNotOneOf
   :: Categorized token
   => ([token], Either Int [Int]) -> RegEx token
-testNotOneOf (chars, catTest) = RegExam $
-  NotOneOf (Set.fromList chars) (either (AsIn . toEnum) (NotAsIn . Set.map toEnum . Set.fromList) catTest)
+testNotOneOf (chars, catTest) = RegExam $ NotOneOf
+  (Set.fromList chars)
+  (either (AsIn . toEnum) (NotAsIn . Set.map toEnum . Set.fromList) catTest)
diff --git a/src/Data/Profunctor/Grammar.hs b/src/Data/Profunctor/Grammar.hs
index aca3466..3ca3372 100644
--- a/src/Data/Profunctor/Grammar.hs
+++ b/src/Data/Profunctor/Grammar.hs
@@ -26,7 +26,6 @@ import Control.Category
 import Control.Lens
 import Control.Lens.Extras
 import Control.Lens.Grammar.BackusNaur
-import Control.Lens.Grammar.Boole
 import Control.Lens.Grammar.Kleene
 import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
diff --git a/test/Examples/Json.hs b/test/Examples/Json.hs
index 79cc5f9..c001085 100644
--- a/test/Examples/Json.hs
+++ b/test/Examples/Json.hs
@@ -9,6 +9,7 @@ import Control.Lens
 import Control.Lens.Grammar
 import Control.Lens.Grammar.BackusNaur
 import Control.Lens.Grammar.Boole
+import Control.Lens.Grammar.Kleene
 import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
 import Control.Lens.PartialIso
diff --git a/test/Examples/RegString.hs b/test/Examples/RegString.hs
index 3e6a23e..0443947 100644
--- a/test/Examples/RegString.hs
+++ b/test/Examples/RegString.hs
@@ -13,7 +13,8 @@ regexExamples =
   [ (terminal "abc123etc.", "abc123etc.")
   , (terminal "x" <> terminal "y", "xy")
   , (zeroK, "[]")
-  , (terminal "x" >|< terminal "y", "x|y")
+  , (terminal "xy" >|< terminal "z", "xy|z")
+  , (token 'x' >|< token 'y', "[xy]")
   , (optK (terminal "x"), "x?")
   , (starK (terminal "x"), "x*")
   , (plusK (terminal "x"), "x+")
diff --git a/test/Examples/SExpr.hs b/test/Examples/SExpr.hs
index 84ebe5b..84e900e 100644
--- a/test/Examples/SExpr.hs
+++ b/test/Examples/SExpr.hs
@@ -7,7 +7,7 @@ module Examples.SExpr
 import Control.Lens hiding (List)
 import Control.Lens.Grammar
 import Control.Lens.Grammar.BackusNaur
-import Control.Lens.Grammar.Boole
+import Control.Lens.Grammar.Kleene
 import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
 import Control.Lens.PartialIso hiding (List)

From dc2b61db708ad4bf22af107fc49ffb4b3bbb4aac Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 24 Mar 2026 15:41:41 -0700
Subject: [PATCH 037/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 62fc078..b6c0e18 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -21,7 +21,6 @@ import Control.Applicative
 import Data.Function
 import Control.Lens
 import Control.Lens.Grammar.BackusNaur
-import Control.Lens.Grammar.Boole
 import Control.Lens.PartialIso
 import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
@@ -89,7 +88,7 @@ satisfyParsector
      , Item s ~ a
      , Categorized a
      )
-  => TokenTest a
+  => TokenClass a
   -> Parsector s a a
 satisfyParsector test = Parsector $ \args ->
   let

From 96c9d09c509eae74cc6e324ccf6d136f1dbac1f8 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 25 Mar 2026 16:54:16 -0700
Subject: [PATCH 038/103] fix mplus bug

---
 src/Data/Profunctor/Grammar/Parsector.hs | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index b6c0e18..ac1ead1 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -158,12 +158,16 @@ instance Categorized (Item s) => Monad (Parsector s a) where
         }
     }
 instance Categorized (Item s) => MonadPlus (Parsector s a) where
-  Parsector p `mplus` Parsector q = Parsector $ \args -> p args
-    { emptyErr = \err -> q args
-        { emptyOk = \b st' err' -> emptyOk args b st' (err <> err')
-        , emptyErr = \err' -> emptyErr args (err <> err')
-        }
-    }
+  m `mplus` n = Parsector $ \args ->
+    let
+      eok = emptyOk args
+      eerr = emptyErr args
+      meerr err =
+        let
+          neok y s' err' = eok y s' (err <> err')
+          neerr err' = eerr (err <> err')
+        in runParsector n args { emptyOk = neok, emptyErr = neerr }
+    in runParsector m args { emptyErr = meerr }
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
 instance Categorized (Item s) => MonadTry (Parsector s a) where

From 477c9de240f0476e3e2e1e2fcf8fb9fbf7e33964 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 25 Mar 2026 18:01:01 -0700
Subject: [PATCH 039/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 19 +++++++------------
 1 file changed, 7 insertions(+), 12 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index ac1ead1..82469aa 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -141,7 +141,12 @@ instance Categorized (Item s) => Alternative (Parsector s a) where
     { expectOffset = streamOffset args
     , expectPattern = zeroK
     }
-  p <|> q = try p `mplus` q
+  p <|> q = Parsector $ \args -> runParsector p args
+    { emptyErr = \err -> runParsector q args
+        { emptyOk = \syn str err' -> emptyOk args syn str (err <> err')
+        , emptyErr = \err' -> emptyErr args (err <> err')
+        } 
+    }
 instance Categorized (Item s) => Monad (Parsector s a) where
   p >>= k = Parsector $ \args -> runParsector p args
     { consumedOk = \b st' err -> runParsector (k b) args
@@ -157,17 +162,7 @@ instance Categorized (Item s) => Monad (Parsector s a) where
         , emptyErr = \err' -> emptyErr args (err <> err')
         }
     }
-instance Categorized (Item s) => MonadPlus (Parsector s a) where
-  m `mplus` n = Parsector $ \args ->
-    let
-      eok = emptyOk args
-      eerr = emptyErr args
-      meerr err =
-        let
-          neok y s' err' = eok y s' (err <> err')
-          neerr err' = eerr (err <> err')
-        in runParsector n args { emptyOk = neok, emptyErr = neerr }
-    in runParsector m args { emptyErr = meerr }
+instance Categorized (Item s) => MonadPlus (Parsector s a)
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
 instance Categorized (Item s) => MonadTry (Parsector s a) where

From 5b6b54ac7ccb91d1cb50d07f85ddf3bbe779ecd1 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 25 Mar 2026 18:37:13 -0700
Subject: [PATCH 040/103] broken tests

---
 src/Control/Lens/Grammar.hs              |  4 ++--
 src/Data/Profunctor/Grammar/Parsector.hs | 25 +++++++++++++-----------
 test/Main.hs                             |  6 ++++++
 3 files changed, 22 insertions(+), 13 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 6160baf..4479a2c 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -794,11 +794,11 @@ returning either a `Expect` error or the parsed value
 and remaining input.
 -}
 parsecG
-  :: (Cons string string token token, Snoc string string token token)
+  :: (AsEmpty string, Cons string string token token, Snoc string string token token)
   => (Item string ~ token, Categorized token)
   => CtxGrammar token a
   -> string {- ^ input -}
-  -> Either (Expect string, string) (a, string)
+  -> Either (Expect string, string) a
 parsecG parsector = parsecP parsector
 
 {- | `unparsecG` generates a Parsec-style unparser from a `CtxGrammar`,
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 82469aa..e8a6c9c 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -38,7 +38,7 @@ newtype Parsector s a b = Parsector
 
 data StateCallbacks s a b x = StateCallbacks
   { streamInput :: s
-  , streamOffset :: !Word
+  , streamOffset :: Word
   , syntaxInput :: Maybe a
   , consumedOk :: b -> s -> Expect s -> x
   , consumedErr :: Expect s -> x
@@ -59,14 +59,16 @@ deriving instance Categorized (Item s) => Eq (Expect s)
 deriving instance Categorized (Item s) => Ord (Expect s)
 
 -- | Run a `Parsector` as a parser, consuming tokens from the input.
-parsecP :: Parsector s a b -> s -> Either (Expect s, s) (b, s)
+parsecP :: AsEmpty s => Parsector s a b -> s -> Either (Expect s, s) b
 parsecP (Parsector p) s = p StateCallbacks
   { streamInput = s
   , streamOffset = 0
   , syntaxInput = Nothing
-  , consumedOk = \b st _ -> Right (b, st)
+  , consumedOk = \b st err ->
+      if isn't _Empty st then Left (err, st) else Right b
   , consumedErr = \err -> Left (err, s)
-  , emptyOk = \b st _ -> Right (b, st)
+  , emptyOk = \b st err ->
+      if isn't _Empty st then Left (err, st) else Right b
   , emptyErr = \err -> Left (err, s)
   }
 
@@ -141,12 +143,7 @@ instance Categorized (Item s) => Alternative (Parsector s a) where
     { expectOffset = streamOffset args
     , expectPattern = zeroK
     }
-  p <|> q = Parsector $ \args -> runParsector p args
-    { emptyErr = \err -> runParsector q args
-        { emptyOk = \syn str err' -> emptyOk args syn str (err <> err')
-        , emptyErr = \err' -> emptyErr args (err <> err')
-        } 
-    }
+  p <|> q = try p `mplus` q
 instance Categorized (Item s) => Monad (Parsector s a) where
   p >>= k = Parsector $ \args -> runParsector p args
     { consumedOk = \b st' err -> runParsector (k b) args
@@ -162,7 +159,13 @@ instance Categorized (Item s) => Monad (Parsector s a) where
         , emptyErr = \err' -> emptyErr args (err <> err')
         }
     }
-instance Categorized (Item s) => MonadPlus (Parsector s a)
+instance Categorized (Item s) => MonadPlus (Parsector s a) where
+  p `mplus` q = Parsector $ \args -> runParsector p args
+    { emptyErr = \err -> runParsector q args
+        { emptyOk = \syn str err' -> emptyOk args syn str (err <> err')
+        , emptyErr = \err' -> emptyErr args (err <> err')
+        } 
+    }
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
 instance Categorized (Item s) => MonadTry (Parsector s a) where
diff --git a/test/Main.hs b/test/Main.hs
index 2b7079b..c2a78f9 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -96,3 +96,9 @@ testCtxGrammarExample grammar (expectedSyntax, expectedString) = do
   it ("should print to " <> expectedString <> " correctly") $ do
     let actualString = ($ "") <$> printG grammar expectedSyntax
     actualString `shouldBe` Just expectedString
+  it ("should parsec from " <> expectedString <> " correctly") $ do
+    let actualSyntax = parsecG grammar expectedString
+    actualSyntax `shouldBe` Right expectedSyntax
+  it ("should unparsec to " <> expectedString <> " correctly") $ do
+    let actualString = unparsecG grammar expectedSyntax ""
+    actualString `shouldBe` Right expectedString

From aae46073e1d0efdee2225fa50562a9735565d3fc Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 26 Mar 2026 19:16:28 -0700
Subject: [PATCH 041/103] changes and stuff

---
 src/Control/Lens/Grammar.hs              |   4 +-
 src/Control/Lens/Grammar/Kleene.hs       |   6 ++
 src/Data/Profunctor/Grammar/Parsector.hs | 117 +++++++++++------------
 test/Main.hs                             |   2 +-
 4 files changed, 63 insertions(+), 66 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 4479a2c..6160baf 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -794,11 +794,11 @@ returning either a `Expect` error or the parsed value
 and remaining input.
 -}
 parsecG
-  :: (AsEmpty string, Cons string string token token, Snoc string string token token)
+  :: (Cons string string token token, Snoc string string token token)
   => (Item string ~ token, Categorized token)
   => CtxGrammar token a
   -> string {- ^ input -}
-  -> Either (Expect string, string) a
+  -> Either (Expect string, string) (a, string)
 parsecG parsector = parsecP parsector
 
 {- | `unparsecG` generates a Parsec-style unparser from a `CtxGrammar`,
diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index 9837f43..147a678 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -152,6 +152,12 @@ deriving newtype instance Categorized token => Eq (TokenClass token)
 deriving newtype instance Categorized token => Ord (TokenClass token)
 deriving newtype instance Categorized token => Tokenized token (TokenClass token)
 deriving newtype instance Categorized token => BooleanAlgebra (TokenClass token)
+instance Categorized token
+  => TokenAlgebra token (TokenClass token) where
+  tokenClass = id
+instance Categorized token
+  => TokenAlgebra token (RegExam token (TokenClass token)) where
+  tokenClass (TokenClass exam) = exam
 instance Categorized token => TerminalSymbol token (RegEx token) where
   terminal = foldl (\acc t -> acc <> token t) mempty
 instance NonTerminalSymbol (RegEx token) where
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index e8a6c9c..50c9d57 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -37,9 +37,9 @@ newtype Parsector s a b = Parsector
   { runParsector :: forall x. StateCallbacks s a b x -> x }
 
 data StateCallbacks s a b x = StateCallbacks
-  { streamInput :: s
-  , streamOffset :: Word
-  , syntaxInput :: Maybe a
+  { stateStream :: s
+  , stateOffset :: Word
+  , stateSyntax :: Maybe a
   , consumedOk :: b -> s -> Expect s -> x
   , consumedErr :: Expect s -> x
   , emptyOk :: b -> s -> Expect s -> x
@@ -59,56 +59,29 @@ deriving instance Categorized (Item s) => Eq (Expect s)
 deriving instance Categorized (Item s) => Ord (Expect s)
 
 -- | Run a `Parsector` as a parser, consuming tokens from the input.
-parsecP :: AsEmpty s => Parsector s a b -> s -> Either (Expect s, s) b
+parsecP :: Parsector s a b -> s -> Either (Expect s, s) (b, s)
 parsecP (Parsector p) s = p StateCallbacks
-  { streamInput = s
-  , streamOffset = 0
-  , syntaxInput = Nothing
-  , consumedOk = \b st err ->
-      if isn't _Empty st then Left (err, st) else Right b
+  { stateStream = s
+  , stateOffset = 0
+  , stateSyntax = Nothing
+  , consumedOk = \b st _ -> Right (b, st)
   , consumedErr = \err -> Left (err, s)
-  , emptyOk = \b st err ->
-      if isn't _Empty st then Left (err, st) else Right b
+  , emptyOk = \b st _ -> Right (b, st)
   , emptyErr = \err -> Left (err, s)
   }
 
 -- | Run a `Parsector` as an unparser, snocing tokens onto an empty input.
 unparsecP :: Parsector s a b -> a -> s -> Either (Expect s, s) s
 unparsecP (Parsector p) a s = snd <$> p StateCallbacks
-  { streamInput = s
-  , streamOffset = 0
-  , syntaxInput = Just a
+  { stateStream = s
+  , stateOffset = 0
+  , stateSyntax = Just a
   , consumedOk = \b st _ -> Right (b, st)
   , consumedErr = \err -> Left (err, s)
   , emptyOk = \b st _ -> Right (b, st)
   , emptyErr = \err -> Left (err, s)
   }
 
-satisfyParsector
-  :: ( Cons s s a a
-     , Snoc s s a a
-     , Item s ~ a
-     , Categorized a
-     )
-  => TokenClass a
-  -> Parsector s a a
-satisfyParsector test = Parsector $ \args ->
-  let
-    st = streamInput args
-    off = streamOffset args
-    failExp = Expect off (tokenClass test)
-    succExp = Expect (off + 1) zeroK
-  in
-    case syntaxInput args of
-      Just tok
-        | tokenClass test tok -> consumedOk args tok (snoc st tok) succExp
-        | otherwise -> consumedErr args failExp
-      Nothing -> case uncons st of
-        Nothing -> emptyErr args failExp
-        Just (tok, rest)
-          | tokenClass test tok -> consumedOk args tok rest succExp
-          | otherwise -> emptyErr args failExp
-
 -- Parsector instances
 instance Categorized (Item s) => Semigroup (Expect s) where
   e1 <> e2 = case compare (expectOffset e1) (expectOffset e2) of
@@ -125,7 +98,7 @@ instance Categorized (Item s) => Monoid (Expect s) where
     }
 instance Profunctor (Parsector s) where
   dimap f g p = Parsector $ \args -> runParsector p args
-    { syntaxInput = fmap f (syntaxInput args)
+    { stateSyntax = fmap f (stateSyntax args)
     , consumedOk = consumedOk args . g
     , emptyOk = emptyOk args . g
     }
@@ -133,28 +106,28 @@ instance Functor (Parsector s a) where
   fmap = rmap
 instance Categorized (Item s) => Applicative (Parsector s a) where
   pure b = Parsector $ \args ->
-    emptyOk args b (streamInput args) Expect
-      { expectOffset = streamOffset args
+    emptyOk args b (stateStream args) Expect
+      { expectOffset = stateOffset args
       , expectPattern = zeroK
       }
   (<*>) = ap
 instance Categorized (Item s) => Alternative (Parsector s a) where
   empty = Parsector $ \args -> emptyErr args Expect
-    { expectOffset = streamOffset args
+    { expectOffset = stateOffset args
     , expectPattern = zeroK
     }
   p <|> q = try p `mplus` q
 instance Categorized (Item s) => Monad (Parsector s a) where
   p >>= k = Parsector $ \args -> runParsector p args
     { consumedOk = \b st' err -> runParsector (k b) args
-        { streamInput = st'
-        , streamOffset = expectOffset err
+        { stateStream = st'
+        , stateOffset = expectOffset err
         , emptyOk = \x st'' err' -> consumedOk args x st'' (err <> err')
         , emptyErr = \err' -> consumedErr args (err <> err')
         }
     , emptyOk = \b st' err -> runParsector (k b) args
-        { streamInput = st'
-        , streamOffset = expectOffset err
+        { stateStream = st'
+        , stateOffset = expectOffset err
         , emptyOk = \x st'' err' -> emptyOk args x st'' (err <> err')
         , emptyErr = \err' -> emptyErr args (err <> err')
         }
@@ -164,7 +137,7 @@ instance Categorized (Item s) => MonadPlus (Parsector s a) where
     { emptyErr = \err -> runParsector q args
         { emptyOk = \syn str err' -> emptyOk args syn str (err <> err')
         , emptyErr = \err' -> emptyErr args (err <> err')
-        } 
+        }
     }
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
@@ -175,24 +148,24 @@ instance Categorized (Item s) => Filterable (Parsector s a) where
   mapMaybe = dimapMaybe Just
 instance Categorized (Item s) => Alternator (Parsector s) where
   alternate (Left p) = Parsector $ \args ->
-    case syntaxInput args of
+    case stateSyntax args of
       Just (Right _) -> emptyErr args Expect
-        { expectOffset = streamOffset args
+        { expectOffset = stateOffset args
         , expectPattern = zeroK
         }
       mEAC -> runParsector p args
-        { syntaxInput = mEAC >>= either Just (const Nothing)
+        { stateSyntax = mEAC >>= either Just (const Nothing)
         , consumedOk = \b st' err -> consumedOk args (Left b) st' err
         , emptyOk = \b st' err -> emptyOk args (Left b) st' err
         }
   alternate (Right p) = Parsector $ \args ->
-    case syntaxInput args of
+    case stateSyntax args of
       Just (Left _) -> emptyErr args Expect
-        { expectOffset = streamOffset args
+        { expectOffset = stateOffset args
         , expectPattern = zeroK
         }
       mEAC -> runParsector p args
-        { syntaxInput = mEAC >>= either (const Nothing) Just
+        { stateSyntax = mEAC >>= either (const Nothing) Just
         , consumedOk = \d st' err -> consumedOk args (Right d) st' err
         , emptyOk = \d st' err -> emptyOk args (Right d) st' err
         }
@@ -205,7 +178,7 @@ instance Categorized (Item s) => Filtrator (Parsector s) where
   filtrate (Parsector p) =
     ( Parsector $ \args ->
         p args
-          { syntaxInput = Left <$> syntaxInput args
+          { stateSyntax = Left <$> stateSyntax args
           , consumedOk = \ebd st' err -> case ebd of
               Left b -> consumedOk args b st' err
               Right _ -> consumedErr args err
@@ -215,7 +188,7 @@ instance Categorized (Item s) => Filtrator (Parsector s) where
           }
     , Parsector $ \args ->
         p args
-          { syntaxInput = Right <$> syntaxInput args
+          { stateSyntax = Right <$> stateSyntax args
           , consumedOk = \ebd st' err -> case ebd of
               Right d -> consumedOk args d st' err
               Left _ -> consumedErr args err
@@ -230,7 +203,25 @@ instance Categorized (Item s) => Cochoice (Parsector s) where
 instance
   ( Categorized token, Item s ~ token
   , Cons s s token token, Snoc s s token token
-  ) => TokenAlgebra token (Parsector s token token)
+  ) => TokenAlgebra token (Parsector s token token) where
+    tokenClass test = Parsector $ \args ->
+      let
+        str = stateStream args
+        off = stateOffset args
+        failExp = Expect off (tokenClass test)
+        succExp = Expect (off + 1) zeroK
+      in
+        case stateSyntax args of
+          Just tok
+            | tokenClass test tok ->
+                consumedOk args tok (snoc str tok) succExp
+            | otherwise -> emptyErr args failExp
+          Nothing -> case uncons str of
+            Nothing -> emptyErr args failExp
+            Just (tok, rest)
+              | tokenClass test tok ->
+                  consumedOk args tok rest succExp
+              | otherwise -> emptyErr args failExp
 instance
   ( Categorized token, Item s ~ token
   , Cons s s token token, Snoc s s token token
@@ -239,12 +230,12 @@ instance
   ( Categorized token, Item s ~ token
   , Cons s s token token, Snoc s s token token
   ) => Tokenized token (Parsector s token token) where
-  anyToken = satisfyParsector anyToken
-  token t = satisfyParsector (token t)
-  oneOf ts = satisfyParsector (oneOf ts)
-  notOneOf ts = satisfyParsector (notOneOf ts)
-  asIn cat = satisfyParsector (asIn cat)
-  notAsIn cat = satisfyParsector (notAsIn cat)
+  anyToken = tokenClass anyToken
+  token t = tokenClass (token t)
+  oneOf ts = tokenClass (oneOf ts)
+  notOneOf ts = tokenClass (notOneOf ts)
+  asIn cat = tokenClass (asIn cat)
+  notAsIn cat = tokenClass (notAsIn cat)
 instance Categorized (Item s)
   => BackusNaurForm (Parsector s a b) where
   rule name (Parsector p) = Parsector $ \args -> p args
diff --git a/test/Main.hs b/test/Main.hs
index c2a78f9..9693fc4 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -98,7 +98,7 @@ testCtxGrammarExample grammar (expectedSyntax, expectedString) = do
     actualString `shouldBe` Just expectedString
   it ("should parsec from " <> expectedString <> " correctly") $ do
     let actualSyntax = parsecG grammar expectedString
-    actualSyntax `shouldBe` Right expectedSyntax
+    actualSyntax `shouldBe` Right (expectedSyntax, "")
   it ("should unparsec to " <> expectedString <> " correctly") $ do
     let actualString = unparsecG grammar expectedSyntax ""
     actualString `shouldBe` Right expectedString

From d4947bf5a9047c3bbad5827735f382521c0cd6bc Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sun, 29 Mar 2026 11:39:06 -0700
Subject: [PATCH 042/103] pureP

onlyOne
option ~> optionP
---
 src/Control/Lens/Grammar.hs        | 15 +++++-----
 src/Data/Profunctor/Distributor.hs | 11 +++++---
 src/Data/Profunctor/Monoidal.hs    | 44 ++++++++++++++++++++++--------
 test/Examples/SemVer.hs            |  9 +++---
 4 files changed, 53 insertions(+), 26 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 6160baf..4e4feee 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -50,7 +50,6 @@ import Data.Profunctor.Monadic
 import Data.Profunctor.Monoidal
 import Data.Profunctor.Grammar
 import Data.Profunctor.Grammar.Parsector
-import qualified Data.Set as Set
 import Data.String
 import GHC.Exts
 import Prelude hiding (filter)
@@ -102,8 +101,8 @@ semverGrammar = _SemVer
   >?  numberG
   >*< terminal "." >* numberG
   >*< terminal "." >* numberG
-  >*< option [] (terminal "-" >* identifiersG)
-  >*< option [] (terminal "+" >* identifiersG)
+  >*< optionP _Empty (terminal "-" >* identifiersG)
+  >*< optionP _Empty (terminal "+" >* identifiersG)
   where
     numberG = iso show read >~ someP (asIn @Char DecimalNumber)
     identifiersG = several1 (sepBy (terminal ".")) (someP charG)
@@ -126,15 +125,17 @@ combinators like `<|>` work both `Functor`ially and `Profunctor`ially.
 +------------+---------------+
 | `<$>`      | `>?`          |
 +------------+---------------+
+| `pure`     | `pureP`       |
++------------+---------------+
 | `*>`       | `>*`          |
 +------------+---------------+
 | `<*`       | `*<`          |
 +------------+---------------+
 | `<*>`      | `>*<`         |
 +------------+---------------+
-| `<|>`      | `<|>`         |
+| `empty     | `empty`       |
 +------------+---------------+
-| `option`   | `option`      |
+| `<|>`      | `<|>`         |
 +------------+---------------+
 | `choice`   | `choice`      |
 +------------+---------------+
@@ -605,14 +606,14 @@ regexGrammar = _RegString >~ ruleRec "regex" altG
       ]
 
     classOneOfG = rule "class-one-of" $ choice
-      [ iso toList fromList >~ charG >:< asEmpty
+      [ onlyOne charG
       , terminal "[" >* several noSep charG *< terminal "]"
       ]
 
     classNotOneOfG = rule "class-not-one-of" $ choice
       [ asEmpty >*< classCatG
       , terminal "[^" >* several noSep charG >*<
-          option (NotAsIn Set.empty) classCatG *< terminal "]"
+          optionP (_NotAsIn . _Empty) classCatG *< terminal "]"
       ]
 
 nonterminalG :: Grammar Char String
diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index 681723b..d710ed8 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -15,7 +15,7 @@ module Data.Profunctor.Distributor
   , Alternator (..)
   , malternate
   , choice
-  , option
+  , optionP
     -- * SepBy
   , SepBy (..)
   , sepBy
@@ -369,8 +369,11 @@ choice :: (Foldable f, Alternative p) => f (p a) -> p a
 choice = foldl' (<|>) empty
 
 -- | Perform an `Alternative` action or return a default value.
-option :: Alternative p => a {- ^ default value -} -> p a -> p a
-option a p = p <|> pure a
+optionP
+  :: Alternator p
+  => APrism a b () () -- ^ default value
+  -> p a b -> p a b
+optionP def p = p <|> pureP def
 
 instance (Alternator p, Applicative f)
   => Alternator (WrappedPafb f p) where
@@ -451,7 +454,7 @@ chain
   -> APrism a b () () -- ^ nilary constructor pattern
   -> SepBy (p () ()) -> p a b -> p a b
 chain association pat2 pat0 (SepBy beg end sep) p =
-  beg >* (pat0 >? oneP <|> chain1 association pat2 (sepBy sep) p) *< end
+  beg >* optionP pat0 (chain1 association pat2 (sepBy sep) p) *< end
 
 {- | Associate a binary constructor pattern to sequence one or more times. -}
 chain1
diff --git a/src/Data/Profunctor/Monoidal.hs b/src/Data/Profunctor/Monoidal.hs
index 7c6d163..6319a83 100644
--- a/src/Data/Profunctor/Monoidal.hs
+++ b/src/Data/Profunctor/Monoidal.hs
@@ -16,7 +16,7 @@ module Data.Profunctor.Monoidal
   , oneP, (>*<), (>*), (*<)
   , dimap2, foreverP, ditraverse
     -- * Monoidal & Choice
-  , replicateP, (>:<), asEmpty
+  , pureP, asEmpty, (>:<), replicateP, onlyOne
   , meander, eotFunList
   ) where
 
@@ -40,6 +40,7 @@ import Data.Profunctor.Cayley
 import Data.Profunctor.Composition
 import Data.Profunctor.Monad
 import Data.Profunctor.Yoneda
+import GHC.IsList
 
 -- Monoidal --
 
@@ -100,20 +101,11 @@ dimap2
   -> p a b -> p c d -> p s t
 dimap2 f g h p q = liftA2 h (lmap f p) (lmap g q)
 
-{- | `foreverP` repeats an action indefinitely;
+{- | `foreverP` repeats an action a countable infinity of times;
 analagous to `Control.Monad.forever`, extending it to `Monoidal`. -}
 foreverP :: Monoidal p => p () c -> p a b
 foreverP a = let a' = a >* a' in a'
 
-{- | A `Monoidal` & `Choice` nil operator. -}
-asEmpty :: (AsEmpty s, Monoidal p, Choice p) => p s s
-asEmpty = _Empty >? oneP
-
-{- | A `Monoidal` & `Choice` cons operator. -}
-(>:<) :: (Cons s t a b, Monoidal p, Choice p) => p a b -> p s t -> p s t
-x >:< xs = _Cons >? x >*< xs
-infixr 5 >:<
-
 {- | Thanks to Fy on Monoidal Café Discord.
 
 A `Traversable` & `Data.Distributive.Distributive` type
@@ -126,6 +118,36 @@ ditraverse
   => p a b -> p (t a) (t b)
 ditraverse p = traverse (\f -> lmap f p) (distribute id)
 
+{- | Lift a single bidirectional element
+into a `Monoidal` & `Choice` structure.
+Bidirectionality is encoded by `APrism`.
+Singularity is encoded by the unit type @()@.
+Bidirectional elements can be generated from
+nilary constructors of algebraic datatypes using `makeNestedPrisms`,
+or from terms of a type with an `Eq` instance using `only`,
+or for nil elements using `_Empty`.
+-}
+pureP
+  :: (Monoidal p, Choice p)
+  => APrism a b () () -- ^ bidirectional element
+  -> p a b
+pureP pattern = pattern >? oneP
+
+{- | A `Monoidal` & `Choice` nil element. -}
+asEmpty :: (AsEmpty s, Monoidal p, Choice p) => p s s
+asEmpty = pureP _Empty
+
+{- | A `Monoidal` & `Choice` cons operator. -}
+(>:<) :: (Cons s t a b, Monoidal p, Choice p) => p a b -> p s t -> p s t
+x >:< xs = _Cons >? x >*< xs
+infixr 5 >:<
+
+{- | Use when `IsList` with `onlyOne` `Item`. -}
+onlyOne
+  :: (Monoidal p, Choice p, IsList s)
+  => p (Item s) (Item s) -> p s s
+onlyOne p = iso toList (fromListN 1) >? p >:< asEmpty
+
 {- | `replicateP` is analagous to `Control.Monad.replicateM`,
 for `Monoidal` & `Choice` `Profunctor`s. When the number
 of repetitions is less than or equal to 0, it returns `asEmpty`.
diff --git a/test/Examples/SemVer.hs b/test/Examples/SemVer.hs
index ffc5792..73a9cd8 100644
--- a/test/Examples/SemVer.hs
+++ b/test/Examples/SemVer.hs
@@ -6,6 +6,7 @@ module Examples.SemVer
   ) where
 
 import Control.Applicative
+import Control.Lens
 import Control.Lens.Grammar
 import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
@@ -42,8 +43,8 @@ semverGrammar = _SemVer
   >?  numberG
   >*< terminal "." >* numberG
   >*< terminal "." >* numberG
-  >*< option [] (terminal "-" >* identifiersG)
-  >*< option [] (terminal "+" >* identifiersG)
+  >*< optionP _Empty (terminal "-" >* identifiersG)
+  >*< optionP _Empty (terminal "+" >* identifiersG)
   where
     numberG = iso show read >~ someP (asIn @Char DecimalNumber)
     identifiersG = several1 (sepBy (terminal ".")) (someP charG)
@@ -65,8 +66,8 @@ semverCtxGrammar = _SemVer >? P.do
   _ <- numberG
   _ <- terminal "." >* numberG
   _ <- terminal "." >* numberG
-  _ <- option [] (terminal "-" >* identifiersG)
-  option [] (terminal "+" >* identifiersG)
+  _ <- optionP _Empty (terminal "-" >* identifiersG)
+  optionP _Empty (terminal "+" >* identifiersG)
 
 semverExamples :: [(SemVer, String)]
 semverExamples =

From 19b4de6bf4f940006ebce828a3ad6991b9da0a53 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sun, 29 Mar 2026 14:47:22 -0700
Subject: [PATCH 043/103] ambulate

and cleaning
---
 src/Control/Monad/Try.hs                 | 24 ----------------------
 src/Data/Profunctor/Distributor.hs       | 22 +++++++++++++++++---
 src/Data/Profunctor/Filtrator.hs         | 12 +++++++----
 src/Data/Profunctor/Grammar.hs           |  2 +-
 src/Data/Profunctor/Grammar/Parsector.hs |  2 +-
 src/Data/Profunctor/Monadic.hs           | 26 +++++++++++++++++++-----
 src/Data/Profunctor/Monoidal.hs          | 17 +++++++++-------
 7 files changed, 60 insertions(+), 45 deletions(-)
 delete mode 100644 src/Control/Monad/Try.hs

diff --git a/src/Control/Monad/Try.hs b/src/Control/Monad/Try.hs
deleted file mode 100644
index d1661c9..0000000
--- a/src/Control/Monad/Try.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module Control.Monad.Try
-  ( MonadTry (..)
-  , fail
-  , mzero
-  , mplus
-  , mchoice
-  ) where
-
-import Control.Monad
-import Data.Foldable
-
-{- |
-
-prop> x <|> y = try x `mplus` y
-prop> fail msg <|> x = x = x <|> fail msg
-
--}
-class (MonadFail m, MonadPlus m) => MonadTry m where
-  try :: m a -> m a
-  default try :: m a -> m a
-  try = id
-
-mchoice :: (Foldable f, MonadPlus p) => f (p a) -> p a
-mchoice = foldl' mplus mzero
diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index d710ed8..1f5db6d 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -25,6 +25,7 @@ module Data.Profunctor.Distributor
   , chain
   , chain1
   , intercalateP
+  , ambulate
     -- * Homogeneous
   , Homogeneous (..)
   ) where
@@ -33,6 +34,7 @@ import Control.Applicative hiding (WrappedArrow)
 import Control.Applicative qualified as Ap (WrappedArrow)
 import Control.Arrow
 import Control.Lens hiding (chosen)
+import Control.Lens.Internal.Context
 import Control.Lens.Internal.Profunctor
 import Control.Lens.PartialIso
 import Control.Monad
@@ -352,11 +354,11 @@ class (Choice p, Distributor p, forall x. Alternative (p x))
     someP :: p a b -> p [a] [b]
     someP x = x >:< manyP x
 
--- | `malternate` gives a default `alternate` when `Monadic`.
+-- | `malternate` gives an equivalent to `alternate` when `Monadic`.
 --
 -- prop> alternate = malternate
 malternate
-  :: (Monadic p, Choice p, forall x. Alternative (p x))
+  :: (Monadic p, Alternator p)
   => Either (p a b) (p c d) -- ^ `Left` or `Right` alternates
   -> p (Either a c) (Either b d)
 malternate =
@@ -468,7 +470,7 @@ chain1 association pat (SepBy beg end sep) = leftOrRight chainl1 chainr1
     chainl1 p = difoldl pat >? beg >* p >*< manyP (sep >* p) *< end
     chainr1 p = difoldr pat >? beg >* manyP (p *< sep) >*< p *< end
 
-{- | `intercalateP` adds a `SepBy` to `replicateP`. -}
+{- | Add a `SepBy` to `replicateP` using `intercalateP`. -}
 intercalateP
   :: (Monoidal p, Choice p, AsEmpty s, Cons s s a a)
   => Int {- ^ number of repetitions -}
@@ -477,3 +479,17 @@ intercalateP n (SepBy beg end _) _ | n <= 0 =
   beg >* asEmpty *< end
 intercalateP n (SepBy beg end comma) p =
   beg >* p >:< replicateP (n-1) (comma >* p) *< end
+
+{- | Add a `SepBy` to `meander` using `ambulate`. -}
+ambulate
+  :: (Monoidal p, Choice p)
+  => ATraversal s t a b -> SepBy (p () ()) -> p a b -> p s t
+ambulate f (SepBy sep beg end) p = dimap (f sell) iextract $
+  beg >* ambulating (sepBy sep) {endBy = end} p
+  where
+    ambulating
+      :: (Monoidal q, Choice q)
+      => SepBy (q () ())
+      -> q u v -> q (Bazaar (->) u w x) (Bazaar (->) v w x)
+    ambulating (SepBy sep' _ end') q =
+      eotFunList >~ right' (q >*< sep' >* ambulating (sepBy sep') q *< end')
diff --git a/src/Data/Profunctor/Filtrator.hs b/src/Data/Profunctor/Filtrator.hs
index 5a2fa55..d086bd3 100644
--- a/src/Data/Profunctor/Filtrator.hs
+++ b/src/Data/Profunctor/Filtrator.hs
@@ -20,6 +20,7 @@ import Control.Lens.PartialIso
 import Control.Lens.Internal.Profunctor
 import Control.Monad
 import Data.Profunctor
+import Data.Profunctor.Distributor
 import Data.Profunctor.Monad
 import Data.Profunctor.Monadic (Monadic)
 import Data.Profunctor.Yoneda
@@ -27,7 +28,8 @@ import Witherable
 
 {- | The `Filtrator` class extends `Cochoice`,
 as well as `Filterable`, adding the `filtrate` method,
-which is an oplax monoidal structure morphism dual to `>+<`.
+which is an oplax monoidal structure morphism dual to
+`>+<`.
 
 prop> filtrate . uncurry (>+<) = id
 prop> uncurry (>+<) . filtrate = id
@@ -40,7 +42,8 @@ class (Cochoice p, forall x. Filterable (p x))
     prop> unright = snd . filtrate
 
     `filtrate` is a distant relative to `Data.Either.partitionEithers`.
-    `filtrate` can be given a default value for `Monadic` `Alternator`s via `mfiltrate`.
+    `filtrate` can be given a default value for `Monadic`
+    `Alternator`s via `mfiltrate`.
 
     prop> filtrate = mfiltrate
 
@@ -58,11 +61,12 @@ class (Cochoice p, forall x. Filterable (p x))
       &&&
       dimapMaybe (Just . Right) (either (const Nothing) Just)
 
--- | `Filtrator` has a default definition for `Monadic` `Alternative`s.
+-- | Similar to `malternate`, a `Monadic` `Alternator` has
+-- an equivalent to `filtrate`, given by `mfiltrate`.
 --
 -- prop> filtrate = mfiltrate
 mfiltrate
-  :: (Monadic p, forall x. Alternative (p x))
+  :: (Monadic p, Alternator p)
   => p (Either a c) (Either b d) -- ^ partition `Either`
   -> (p a b, p c d)
 mfiltrate =
diff --git a/src/Data/Profunctor/Grammar.hs b/src/Data/Profunctor/Grammar.hs
index f38520e..051c892 100644
--- a/src/Data/Profunctor/Grammar.hs
+++ b/src/Data/Profunctor/Grammar.hs
@@ -30,13 +30,13 @@ import Control.Lens.Grammar.Kleene
 import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
 import Control.Monad
-import Control.Monad.Try
 import Data.Coerce
 import Data.Monoid
 import Data.Profunctor
 import Data.Profunctor.Distributor
 import Data.Profunctor.Filtrator
 import Data.Profunctor.Monoidal
+import Data.Profunctor.Monadic (MonadTry (..))
 import Data.Void
 import Prelude hiding (id, (.))
 import GHC.Exts
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 50c9d57..3c4037a 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -25,11 +25,11 @@ import Control.Lens.PartialIso
 import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
 import Control.Monad
-import Control.Monad.Try
 import Control.Lens.Grammar.Kleene
 import Data.Profunctor
 import Data.Profunctor.Distributor
 import Data.Profunctor.Filtrator
+import Data.Profunctor.Monadic (MonadTry (..))
 import GHC.Exts
 import Witherable
 
diff --git a/src/Data/Profunctor/Monadic.hs b/src/Data/Profunctor/Monadic.hs
index e00755a..02000ce 100644
--- a/src/Data/Profunctor/Monadic.hs
+++ b/src/Data/Profunctor/Monadic.hs
@@ -25,16 +25,16 @@ module Data.Profunctor.Monadic
   , (>>=)
   , (>>)
   , return
+    -- * MonadicTry
   , MonadicTry
-  , fail
-  , try
-  , mzero
-  , mplus
+  , MonadTry (..)
+  , MonadFail (..)
+  , MonadPlus (..)
   , mchoice
   ) where
 
 import Control.Monad hiding ((>>=), (>>))
-import Control.Monad.Try
+import Data.Foldable
 import Data.Profunctor
 import Prelude hiding ((>>=), (>>))
 
@@ -58,4 +58,20 @@ p >>= f = do
 infixl 1 >>
 x >> y = do _ <- lmap (const ()) x; y
 
+{- | A `Profunctor` which is also a `MonadTry`. -}
 type MonadicTry p = (Profunctor p, forall x. MonadTry (p x))
+
+{- |
+
+prop> x <|> y = try x `mplus` y
+prop> fail msg `mplus` x = x = x `mplus` fail msg
+
+-}
+class (MonadFail m, MonadPlus m) => MonadTry m where
+  try :: m a -> m a
+  default try :: m a -> m a
+  try = id
+
+-- | Combines all `MonadPlus` choices in the specified list.
+mchoice :: (Foldable f, MonadPlus p) => f (p a) -> p a
+mchoice = foldl' mplus mzero
diff --git a/src/Data/Profunctor/Monoidal.hs b/src/Data/Profunctor/Monoidal.hs
index 6319a83..f8b1617 100644
--- a/src/Data/Profunctor/Monoidal.hs
+++ b/src/Data/Profunctor/Monoidal.hs
@@ -95,9 +95,9 @@ infixl 6 *<
 analagous to `liftA2`. -}
 dimap2
   :: Monoidal p
-  => (s -> a)
-  -> (s -> c)
-  -> (b -> d -> t)
+  => (s -> a) -- ^ first projection, e.g. `fst`
+  -> (s -> c) -- ^ second projection, e.g. `snd`
+  -> (b -> d -> t) -- ^ pairing function, e.g. @(,)@
   -> p a b -> p c d -> p s t
 dimap2 f g h p q = liftA2 h (lmap f p) (lmap g q)
 
@@ -110,8 +110,9 @@ foreverP a = let a' = a >* a' in a'
 
 A `Traversable` & `Data.Distributive.Distributive` type
 is a homogeneous countable product.
-That means it is a static length container, so unlike `replicateP`,
-`ditraverse` does not need an `Int` argument.
+That means it is a static countable-length container,
+so unlike `replicateP`, `ditraverse` doesn't need
+an additional argument for number of repetitions.
 -}
 ditraverse
   :: (Traversable t, Distributive t, Monoidal p)
@@ -124,8 +125,10 @@ Bidirectionality is encoded by `APrism`.
 Singularity is encoded by the unit type @()@.
 Bidirectional elements can be generated from
 nilary constructors of algebraic datatypes using `makeNestedPrisms`,
-or from terms of a type with an `Eq` instance using `only`,
-or for nil elements using `_Empty`.
+from terms of a type with an `Eq` instance using `only`,
+for nil elements using `_Empty`,
+or from any composition of `Control.Lens.Prism.Prism`s terminating
+with a bidirectional element.
 -}
 pureP
   :: (Monoidal p, Choice p)

From 3b44283116289d1e2dc4129ccef679dce7d081bb Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sun, 29 Mar 2026 15:32:17 -0700
Subject: [PATCH 044/103] docs

& Chain test
---
 distributors.cabal                         |  2 +-
 src/Control/Lens/Internal/NestedPrismTH.hs | 18 +++++-----
 src/Data/Profunctor/Monoidal.hs            |  2 +-
 test/Examples/Chain.hs                     | 42 ++++++++++++++++++++++
 4 files changed, 54 insertions(+), 10 deletions(-)
 create mode 100644 test/Examples/Chain.hs

diff --git a/distributors.cabal b/distributors.cabal
index fe94eb2..b71e24b 100644
--- a/distributors.cabal
+++ b/distributors.cabal
@@ -41,7 +41,6 @@ library
       Control.Lens.Monocle
       Control.Lens.PartialIso
       Control.Lens.Wither
-      Control.Monad.Try
       Data.Profunctor.Distributor
       Data.Profunctor.Filtrator
       Data.Profunctor.Grammar
@@ -118,6 +117,7 @@ test-suite test
   main-is: Main.hs
   other-modules:
       Examples.Arithmetic
+      Examples.Chain
       Examples.Json
       Examples.Lambda
       Examples.LenVec
diff --git a/src/Control/Lens/Internal/NestedPrismTH.hs b/src/Control/Lens/Internal/NestedPrismTH.hs
index f501976..3debb1b 100644
--- a/src/Control/Lens/Internal/NestedPrismTH.hs
+++ b/src/Control/Lens/Internal/NestedPrismTH.hs
@@ -51,21 +51,23 @@ import Prelude
 -- /e.g./
 --
 -- @
--- data FooBarBazBux a
---   = Foo Int
---   | Bar a
+-- data FooBar a
+--   = Foo a
+--   | Bar Int
 --   | Baz Int Char
---   | Bux Double String Bool
--- makePrisms ''FooBarBazBux
+--   | Buzz Double String Bool
+--   | Boop
+-- makeNestedPrisms ''FooBar
 -- @
 --
 -- will create
 --
 -- @
--- _Foo :: Prism' (FooBarBaz a) Int
--- _Bar :: Prism (FooBarBaz a) (FooBarBaz b) a b
+-- _Foo :: Prism (FooBarBaz a) (FooBarBaz b) a b
+-- _Bar :: Prism' (FooBarBaz a) Int
 -- _Baz :: Prism' (FooBarBaz a) (Int, Char)
--- _Bux :: Prism' (FooBarBaz a) (Double, (String, Bool))
+-- _Buzz :: Prism' (FooBarBaz a) (Double, (String, Bool))
+-- _Boop :: Prism' (FooBarBaz a) ()
 -- @
 makeNestedPrisms :: Name -> DecsQ
 makeNestedPrisms typeName =
diff --git a/src/Data/Profunctor/Monoidal.hs b/src/Data/Profunctor/Monoidal.hs
index f8b1617..4ec89cc 100644
--- a/src/Data/Profunctor/Monoidal.hs
+++ b/src/Data/Profunctor/Monoidal.hs
@@ -126,7 +126,7 @@ Singularity is encoded by the unit type @()@.
 Bidirectional elements can be generated from
 nilary constructors of algebraic datatypes using `makeNestedPrisms`,
 from terms of a type with an `Eq` instance using `only`,
-for nil elements using `_Empty`,
+from nil elements using `_Empty`,
 or from any composition of `Control.Lens.Prism.Prism`s terminating
 with a bidirectional element.
 -}
diff --git a/test/Examples/Chain.hs b/test/Examples/Chain.hs
new file mode 100644
index 0000000..a074222
--- /dev/null
+++ b/test/Examples/Chain.hs
@@ -0,0 +1,42 @@
+module Examples.Chain
+  ( Chain (..)
+  , chainGrammar
+  , chainExamples
+  ) where
+
+import Control.Applicative
+import Control.Lens
+import Control.Lens.Grammar
+import Control.Lens.Grammar.BackusNaur
+import Control.Lens.Grammar.Symbol
+import Control.Lens.Grammar.Token
+import Control.Lens.PartialIso
+import Data.Profunctor.Distributor
+import Data.Profunctor.Monoidal
+
+data Chain
+  = Emp
+  | Char Char
+  | Seq Chain Chain
+  deriving stock (Eq, Ord, Show, Read)
+
+makePrisms ''Chain
+
+chainGrammar :: CtxGrammar Char Chain
+chainGrammar = ruleRec "chain" seqG
+  where
+    seqG chn = rule "seq" $
+      chain1 Left _Seq noSep (atomG chn)
+    atomG chn = rule "atom" $
+      _Char >? charG <|> terminal "(" >* chn *< terminal ")"
+    charG = notOneOf "()\\"
+      <|> terminal "\\" >* oneOf "()\\"
+
+chainExamples :: [(Chain, String)]
+chainExamples =
+  [ (Char 'x', "x")
+  , (Seq (Char '1') (Char '2'), "12")
+  , (Seq (Seq (Char 'x') (Char 'y')) (Char 'z'), "xyz")
+  , (Seq (Char 'x') (Seq (Char 'y') (Char 'z')), "x(yz)")
+  , (Emp, "")
+  ]

From c49fd6e5f5f5746cdf0a1f160c11d667776aa847 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sun, 29 Mar 2026 17:42:35 -0700
Subject: [PATCH 045/103] Update Monoidal.hs

---
 src/Data/Profunctor/Monoidal.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Data/Profunctor/Monoidal.hs b/src/Data/Profunctor/Monoidal.hs
index 4ec89cc..615bdc1 100644
--- a/src/Data/Profunctor/Monoidal.hs
+++ b/src/Data/Profunctor/Monoidal.hs
@@ -127,8 +127,8 @@ Bidirectional elements can be generated from
 nilary constructors of algebraic datatypes using `makeNestedPrisms`,
 from terms of a type with an `Eq` instance using `only`,
 from nil elements using `_Empty`,
-or from any composition of `Control.Lens.Prism.Prism`s terminating
-with a bidirectional element.
+or from any `.`-composition of `Control.Lens.Prism.Prism`s
+terminating with a bidirectional element.
 -}
 pureP
   :: (Monoidal p, Choice p)
@@ -136,11 +136,11 @@ pureP
   -> p a b
 pureP pattern = pattern >? oneP
 
-{- | A `Monoidal` & `Choice` nil element. -}
+{- | A `Monoidal` & `Choice` nil combinator. -}
 asEmpty :: (AsEmpty s, Monoidal p, Choice p) => p s s
 asEmpty = pureP _Empty
 
-{- | A `Monoidal` & `Choice` cons operator. -}
+{- | A `Monoidal` & `Choice` cons combinator. -}
 (>:<) :: (Cons s t a b, Monoidal p, Choice p) => p a b -> p s t -> p s t
 x >:< xs = _Cons >? x >*< xs
 infixr 5 >:<

From 323d26fb0b647b8549a303e07b49d9f6b3ff30c2 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 30 Mar 2026 00:42:24 -0700
Subject: [PATCH 046/103] Update Distributor.hs

---
 src/Data/Profunctor/Distributor.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index 1f5db6d..dc4a8e3 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -370,12 +370,13 @@ malternate =
 choice :: (Foldable f, Alternative p) => f (p a) -> p a
 choice = foldl' (<|>) empty
 
--- | Perform an `Alternative` action or return a default value.
+-- | Return a default bidirectional element
+-- or perform an `Alternative` action.
 optionP
   :: Alternator p
-  => APrism a b () () -- ^ default value
+  => APrism a b () () -- ^ default bidirection element
   -> p a b -> p a b
-optionP def p = p <|> pureP def
+optionP def p = pureP def <|> p
 
 instance (Alternator p, Applicative f)
   => Alternator (WrappedPafb f p) where

From fe7eb481a755d5da95bc290eb30d49e5139b9af8 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 30 Mar 2026 00:42:51 -0700
Subject: [PATCH 047/103] stuuuuf

---
 distributors.cabal                        |   1 +
 src/Data/Profunctor/Grammar/Parsector.hs  |  41 ++--
 src/Data/Profunctor/Grammar/Parsector2.hs | 258 ++++++++++++++++++++++
 test/Examples/Chain.hs                    |   4 +-
 test/Examples/RegString.hs                |   7 +-
 test/Main.hs                              |   8 +-
 6 files changed, 290 insertions(+), 29 deletions(-)
 create mode 100644 src/Data/Profunctor/Grammar/Parsector2.hs

diff --git a/distributors.cabal b/distributors.cabal
index b71e24b..8c74519 100644
--- a/distributors.cabal
+++ b/distributors.cabal
@@ -45,6 +45,7 @@ library
       Data.Profunctor.Filtrator
       Data.Profunctor.Grammar
       Data.Profunctor.Grammar.Parsector
+      Data.Profunctor.Grammar.Parsector2
       Data.Profunctor.Monadic
       Data.Profunctor.Monoidal
   other-modules:
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 3c4037a..92ee230 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -116,27 +116,31 @@ instance Categorized (Item s) => Alternative (Parsector s a) where
     { expectOffset = stateOffset args
     , expectPattern = zeroK
     }
-  p <|> q = try p `mplus` q
+  p <|> q = mplus (try p) q
 instance Categorized (Item s) => Monad (Parsector s a) where
-  p >>= k = Parsector $ \args -> runParsector p args
-    { consumedOk = \b st' err -> runParsector (k b) args
-        { stateStream = st'
-        , stateOffset = expectOffset err
-        , emptyOk = \x st'' err' -> consumedOk args x st'' (err <> err')
-        , emptyErr = \err' -> consumedErr args (err <> err')
+  p >>= f = Parsector $ \args -> runParsector p args
+    { emptyOk = \x input msg1 -> runParsector (f x) args
+        { stateStream = input
+        , stateOffset = expectOffset msg1
+        , emptyOk = \x' input' msg' -> emptyOk args x' input' msg'
+        , emptyErr = \msg' -> emptyErr args msg'
         }
-    , emptyOk = \b st' err -> runParsector (k b) args
-        { stateStream = st'
-        , stateOffset = expectOffset err
-        , emptyOk = \x st'' err' -> emptyOk args x st'' (err <> err')
-        , emptyErr = \err' -> emptyErr args (err <> err')
+    , consumedOk = \x input msg1 -> runParsector (f x) args
+        { stateStream = input
+        , stateOffset = expectOffset msg1
+        , emptyOk = \x' input' msg' -> consumedOk args x' input' msg'
+        , emptyErr = \msg' -> consumedErr args msg'
         }
     }
 instance Categorized (Item s) => MonadPlus (Parsector s a) where
-  p `mplus` q = Parsector $ \args -> runParsector p args
-    { emptyErr = \err -> runParsector q args
-        { emptyOk = \syn str err' -> emptyOk args syn str (err <> err')
-        , emptyErr = \err' -> emptyErr args (err <> err')
+  mplus p q = Parsector $ \args -> runParsector p args
+    { emptyErr = \msg1 -> runParsector q args
+        { emptyErr = \msg2 -> emptyErr args (msg1 <> msg2)
+        , emptyOk = \x inp msg2 -> emptyOk args x inp (msg1 <> msg2)
+        }
+    , emptyOk = \x inp msg1 -> runParsector q args
+        { emptyErr = \msg2 -> emptyOk args x inp (msg1 <> msg2)
+        , emptyOk = \_ _ msg2 -> emptyOk args x inp (msg1 <> msg2)
         }
     }
 instance Categorized (Item s) => MonadFail (Parsector s a) where
@@ -172,8 +176,7 @@ instance Categorized (Item s) => Alternator (Parsector s) where
 instance Categorized (Item s) => Choice (Parsector s) where
   left' = alternate . Left
   right' = alternate . Right
-instance Categorized (Item s) => Distributor (Parsector s) where
-  x >+< y = alternate (Right y) <|> alternate (Left x)
+instance Categorized (Item s) => Distributor (Parsector s)
 instance Categorized (Item s) => Filtrator (Parsector s) where
   filtrate (Parsector p) =
     ( Parsector $ \args ->
@@ -209,7 +212,7 @@ instance
         str = stateStream args
         off = stateOffset args
         failExp = Expect off (tokenClass test)
-        succExp = Expect (off + 1) zeroK
+        succExp = Expect off zeroK
       in
         case stateSyntax args of
           Just tok
diff --git a/src/Data/Profunctor/Grammar/Parsector2.hs b/src/Data/Profunctor/Grammar/Parsector2.hs
new file mode 100644
index 0000000..35a2b8f
--- /dev/null
+++ b/src/Data/Profunctor/Grammar/Parsector2.hs
@@ -0,0 +1,258 @@
+{-|
+Module      : Data.Profunctor.Grammar.Parsector
+Description : Parsec-style invertible parser profunctor
+Copyright   : (C) 2026 - Eitan Chatav
+License     : BSD-style (see the file LICENSE)
+Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
+Stability   : provisional
+Portability : non-portable
+-}
+
+module Data.Profunctor.Grammar.Parsector2
+  ( -- * Parsector
+    Parsector (..)
+  , Reply (..)
+  , parsecP
+  , unparsecP
+  ) where
+
+import Control.Applicative
+import Control.Category
+import Data.Function hiding (id, (.))
+import Control.Lens
+import Control.Lens.Grammar.BackusNaur
+-- import Control.Lens.PartialIso
+-- import Control.Lens.Grammar.Symbol
+import Control.Lens.Grammar.Token
+import Control.Monad
+import Control.Lens.Grammar.Kleene
+-- import Data.Profunctor
+-- import Data.Profunctor.Distributor
+-- import Data.Profunctor.Filtrator
+import Data.Profunctor.Monadic (MonadTry (..))
+import GHC.Exts
+import Prelude hiding (id, (.))
+-- import Witherable
+
+newtype Parsector s a b = Parsector
+  { runParsector :: forall x. (Reply s b -> x) -> Reply s a -> x }
+
+data Reply s a = Reply
+  { parsecOffset :: Word
+  , parsecExpect :: Bnf (RegEx (Item s))
+  , parsecStream :: s -- ^ input stream
+  , parsecResult :: Maybe a
+  } deriving Functor
+
+parsecP
+  :: Categorized (Item s)
+  => Parsector s a b -> s -> Reply s b
+parsecP (Parsector p) s = p id (Reply 0 zeroK s Nothing)
+
+unparsecP
+  :: Categorized (Item s)
+  => Parsector s a b -> a -> s -> Reply s b
+unparsecP (Parsector p) a s = p id (Reply 0 zeroK s (Just a))
+
+-- Parsector instances
+instance Profunctor (Parsector s) where
+  dimap f g (Parsector p) = Parsector $
+    dimap (lmap (fmap g)) (lmap (fmap f)) p
+instance Functor (Parsector s a) where
+  fmap = rmap
+instance
+  ( Categorized token, Item s ~ token
+  , Cons s s token token, Snoc s s token token
+  ) => Tokenized token (Parsector s token token) where
+  anyToken = tokenClass anyToken
+  token t = tokenClass (token t)
+  oneOf ts = tokenClass (oneOf ts)
+  notOneOf ts = tokenClass (notOneOf ts)
+  asIn cat = tokenClass (asIn cat)
+  notAsIn cat = tokenClass (notAsIn cat)
+instance
+  ( Categorized token, Item s ~ token
+  , Cons s s token token, Snoc s s token token
+  ) => TokenAlgebra token (Parsector s token token) where
+    tokenClass test = Parsector $ \callbacks reply ->
+      let
+        stream = parsecStream reply
+        result = parsecResult reply
+        offset = parsecOffset reply
+        callbackOk tok str = callbacks Reply
+          { parsecStream = str
+          , parsecOffset = offset + 1
+          , parsecExpect = zeroK
+          , parsecResult = Just tok
+          }
+        callbackErr = callbacks reply
+          { parsecExpect = tokenClass test
+          , parsecResult = Nothing
+          }
+      in
+        case result of
+          Just tok
+            | tokenClass test tok -> callbackOk tok (snoc stream tok)
+            | otherwise -> callbackErr
+          Nothing -> case uncons stream of
+            Just (tok, rest)
+              | tokenClass test tok -> callbackOk tok rest
+              | otherwise -> callbackErr
+            Nothing -> callbackErr
+instance Categorized (Item s)
+  => BackusNaurForm (Parsector s a b) where
+  rule name p = Parsector $ \callbacks reply0 ->
+    flip (runParsector p) reply0 $ \reply1 ->
+      case parsecResult reply1 of
+        Nothing -> callbacks reply1
+          {parsecExpect = rule name (parsecExpect reply1)}
+        Just _ -> callbacks reply1
+  ruleRec name f = rule name (fix f)
+instance Categorized (Item s) => Applicative (Parsector s a) where
+  pure b = Parsector $ \callbacks reply ->
+    callbacks reply
+      { parsecExpect = zeroK
+      , parsecResult = Just b
+      }
+  (<*>) = ap
+instance Categorized (Item s) => Monad (Parsector s a) where
+  return = pure
+  p >>= f = Parsector $ \callbacks reply ->
+    flip (runParsector p) reply $ \reply0 ->
+      case parsecResult reply0 of
+        Nothing -> callbacks reply0 {parsecResult = Nothing}
+        Just b -> runParsector (f b) callbacks reply0
+          {parsecResult = parsecResult reply}
+instance Categorized (Item s) => Alternative (Parsector s a) where
+  empty = Parsector $ \callbacks reply ->
+    callbacks reply
+      { parsecExpect = zeroK
+      , parsecResult = Nothing
+      }
+  p <|> q = Parsector $ \callbacks reply ->
+    flip (runParsector p) reply $ \reply0 ->
+    flip (runParsector q) reply $ \reply1 ->
+      case (parsecResult reply0, parsecResult reply1) of
+        (Just _, Nothing) -> callbacks reply0
+        (Nothing, Just _) -> callbacks reply1
+        -- longest passing match
+        (Just _, Just _) ->
+          if ((>=) `on` parsecOffset) reply0 reply1
+          then callbacks reply0
+          else callbacks reply1
+        -- longest failing match
+        (Nothing, Nothing) ->
+          case (compare `on` parsecOffset) reply0 reply1 of
+            GT -> callbacks reply0
+            EQ -> callbacks reply0
+              {parsecExpect = ((>|<) `on` parsecExpect) reply0 reply1}
+            LT -> callbacks reply1
+instance Categorized (Item s) => MonadPlus (Parsector s a)
+instance Categorized (Item s) => MonadFail (Parsector s a) where
+  fail msg = rule msg empty
+instance Categorized (Item s) => MonadTry (Parsector s a) where
+  try = undefined -- TODO isempty === offset == 0
+instance Category (Parsector s) where
+  id = Parsector ($)
+  Parsector q . Parsector p = Parsector (p . q)
+-- instance Categorized (Item s) => Filterable (Parsector s a) where
+--   mapMaybe = dimapMaybe Just
+-- instance Categorized (Item s) => Alternator (Parsector s) where
+--   alternate (Left p) = Parsector $ \args ->
+--     case stateSyntax args of
+--       Just (Right _) -> emptyErr args Expect
+--         { expectOffset = stateOffset args
+--         , expectPattern = zeroK
+--         }
+--       mEAC -> runParsector p args
+--         { stateSyntax = mEAC >>= either Just (const Nothing)
+--         , callbackOk = \b st' err -> callbackOk args (Left b) st' err
+--         , emptyOk = \b st' err -> emptyOk args (Left b) st' err
+--         }
+--   alternate (Right p) = Parsector $ \args ->
+--     case stateSyntax args of
+--       Just (Left _) -> emptyErr args Expect
+--         { expectOffset = stateOffset args
+--         , expectPattern = zeroK
+--         }
+--       mEAC -> runParsector p args
+--         { stateSyntax = mEAC >>= either (const Nothing) Just
+--         , callbackOk = \d st' err -> callbackOk args (Right d) st' err
+--         , emptyOk = \d st' err -> emptyOk args (Right d) st' err
+--         }
+-- instance Categorized (Item s) => Choice (Parsector s) where
+--   left' = alternate . Left
+--   right' = alternate . Right
+-- instance Categorized (Item s) => Distributor (Parsector s)
+-- instance Categorized (Item s) => Filtrator (Parsector s) where
+--   filtrate (Parsector p) =
+--     ( Parsector $ \args ->
+--         p args
+--           { stateSyntax = Left <$> stateSyntax args
+--           , callbackOk = \ebd st' err -> case ebd of
+--               Left b -> callbackOk args b st' err
+--               Right _ -> callbackErr args err
+--           , emptyOk = \ebd st' err -> case ebd of
+--               Left b -> emptyOk args b st' err
+--               Right _ -> emptyErr args err
+--           }
+--     , Parsector $ \args ->
+--         p args
+--           { stateSyntax = Right <$> stateSyntax args
+--           , callbackOk = \ebd st' err -> case ebd of
+--               Right d -> callbackOk args d st' err
+--               Left _ -> callbackErr args err
+--           , emptyOk = \ebd st' err -> case ebd of
+--               Right d -> emptyOk args d st' err
+--               Left _ -> emptyErr args err
+--           }
+--     )
+-- instance Categorized (Item s) => Cochoice (Parsector s) where
+--   unleft = fst . filtrate
+--   unright = snd . filtrate
+-- instance
+--   ( Categorized token, Item s ~ token
+--   , Cons s s token token, Snoc s s token token
+--   ) => TokenAlgebra token (Parsector s token token) where
+--     tokenClass test = Parsector $ \args ->
+--       let
+--         str = stateStream args
+--         off = stateOffset args
+--         failExp = Expect off (tokenClass test)
+--         succExp = Expect off zeroK
+--       in
+--         case stateSyntax args of
+--           Just tok
+--             | tokenClass test tok ->
+--                 callbackOk args tok (snoc str tok) succExp
+--             | otherwise -> emptyErr args failExp
+--           Nothing -> case uncons str of
+--             Nothing -> emptyErr args failExp
+--             Just (tok, rest)
+--               | tokenClass test tok ->
+--                   callbackOk args tok rest succExp
+--               | otherwise -> emptyErr args failExp
+-- instance
+--   ( Categorized token, Item s ~ token
+--   , Cons s s token token, Snoc s s token token
+--   ) => TerminalSymbol token (Parsector s () ())
+-- instance
+--   ( Categorized token, Item s ~ token
+--   , Cons s s token token, Snoc s s token token
+--   ) => Tokenized token (Parsector s token token) where
+--   anyToken = tokenClass anyToken
+--   token t = tokenClass (token t)
+--   oneOf ts = tokenClass (oneOf ts)
+--   notOneOf ts = tokenClass (notOneOf ts)
+--   asIn cat = tokenClass (asIn cat)
+--   notAsIn cat = tokenClass (notAsIn cat)
+-- instance Categorized (Item s)
+--   => BackusNaurForm (Parsector s a b) where
+--   rule name (Parsector p) = Parsector $ \args -> p args
+--     { emptyOk = \b st' -> emptyOk args b st' . label
+--     , emptyErr = emptyErr args . label
+--     }
+--     where
+--       label fl = fl
+--         { expectPattern = rule name (expectPattern fl)}
+--   ruleRec name f = rule name (fix f)
diff --git a/test/Examples/Chain.hs b/test/Examples/Chain.hs
index a074222..420e4ed 100644
--- a/test/Examples/Chain.hs
+++ b/test/Examples/Chain.hs
@@ -26,7 +26,7 @@ chainGrammar :: CtxGrammar Char Chain
 chainGrammar = ruleRec "chain" seqG
   where
     seqG chn = rule "seq" $
-      chain1 Left _Seq noSep (atomG chn)
+      chain Left _Seq _Emp noSep (atomG chn)
     atomG chn = rule "atom" $
       _Char >? charG <|> terminal "(" >* chn *< terminal ")"
     charG = notOneOf "()\\"
@@ -38,5 +38,5 @@ chainExamples =
   , (Seq (Char '1') (Char '2'), "12")
   , (Seq (Seq (Char 'x') (Char 'y')) (Char 'z'), "xyz")
   , (Seq (Char 'x') (Seq (Char 'y') (Char 'z')), "x(yz)")
-  , (Emp, "")
+  -- , (Emp, "")
   ]
diff --git a/test/Examples/RegString.hs b/test/Examples/RegString.hs
index 0443947..ce63d6f 100644
--- a/test/Examples/RegString.hs
+++ b/test/Examples/RegString.hs
@@ -24,19 +24,16 @@ regexExamples =
   , (asIn UppercaseLetter, "\\p{Lu}")
   , (notAsIn LowercaseLetter, "\\P{Ll}")
   , (nonTerminal "rule-name", "\\q{rule-name}")
-  , (terminal "", "")
+  -- , (terminal "", "")
   , (optK (terminal "abc"), "(abc)?")
   , (optK (terminal "abc") <> nonTerminal "xyz", "(abc)?\\q{xyz}")
 
   -- Boolean OR (>||<) operations
   , (tokenClass (oneOf "abc" >||< oneOf "xyz"), "[abcxyz]")
-  , (tokenClass (notOneOf "abc" >||< notOneOf "xyz"), "[^]")
   , (tokenClass (oneOf "abc" >||< notOneOf "xyz"), "[abc]|[^xyz]")
   , (tokenClass (notOneOf "abc" >||< oneOf "xyz"), "[^abc]|[xyz]")
   , (tokenClass (asIn UppercaseLetter >||< asIn LowercaseLetter), "\\p{Lu}|\\p{Ll}")
-  , (tokenClass (notAsIn Control >||< notAsIn Space), "[^]")
   , (tokenClass (oneOf "abc" >||< asIn DecimalNumber), "[abc]|\\p{Nd}")
-  , (tokenClass (notOneOf "xyz" >||< notAsIn UppercaseLetter), "[^]")
 
   -- Boolean AND (>&&<) operations
   , (tokenClass (oneOf "abcdef" >&&< oneOf "def123"), "[def]")
@@ -46,7 +43,7 @@ regexExamples =
   , (tokenClass (notOneOf "abc" >&&< notAsIn Control), "[^abc\\P{Cc}]")
   , (tokenClass (asIn UppercaseLetter >&&< notOneOf "XYZ"), "[^XYZ\\p{Lu}]")
   , (tokenClass (notAsIn Control >&&< notAsIn Space), "\\P{Zs|Cc}")
-  , (tokenClass (oneOf "0123456789" >&&< asIn DecimalNumber), "[0123456789]")
+  , (tokenClass (oneOf "0123456789xyz" >&&< asIn DecimalNumber), "[0123456789]")
 
   -- Boolean NOT (notB) operations
   , (tokenClass (notB (oneOf "abc")), "[^abc]")
diff --git a/test/Main.hs b/test/Main.hs
index 9693fc4..a3dcb06 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -7,17 +7,17 @@ import Control.Lens.Grammar.BackusNaur
 import Test.DocTest
 import Test.Hspec
 
-import Examples.RegString
 import Examples.Arithmetic
+import Examples.Chain
 import Examples.Json
-import Examples.SExpr
 import Examples.Lambda
 import Examples.LenVec
+import Examples.RegString
 import Examples.SemVer
+import Examples.SExpr
 
 main :: IO ()
 main = do
-  doctests
   hspec $ do
     describe "regexGrammar" $ for_ regexExamples $ testGrammarExample regexGrammar
     describe "semverGrammar" $ for_ semverExamples $ testCtxGrammarExample semverGrammar
@@ -27,6 +27,8 @@ main = do
     describe "sexprGrammar" $ for_ sexprExamples $ testCtxGrammarExample sexprGrammar
     describe "lambdaGrammar" $ for_ lambdaExamples $ testCtxGrammarExample lambdaGrammar
     describe "lenvecGrammar" $ for_ lenvecExamples $ testCtxGrammarExample lenvecGrammar
+    describe "chainGrammar" $ for_ chainExamples $ testCtxGrammarExample chainGrammar
+  doctests
 
 doctests :: IO ()
 doctests = do

From 315604b1b047c4152084144a2394708fab7f5672 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 30 Mar 2026 16:41:49 -0700
Subject: [PATCH 048/103] parsector 2

---
 distributors.cabal                        |   1 -
 src/Control/Lens/Grammar.hs               |   6 +-
 src/Data/Profunctor/Grammar/Parsector.hs  | 395 +++++++++++-----------
 src/Data/Profunctor/Grammar/Parsector2.hs | 258 --------------
 test/Main.hs                              |  21 +-
 5 files changed, 219 insertions(+), 462 deletions(-)
 delete mode 100644 src/Data/Profunctor/Grammar/Parsector2.hs

diff --git a/distributors.cabal b/distributors.cabal
index 8c74519..b71e24b 100644
--- a/distributors.cabal
+++ b/distributors.cabal
@@ -45,7 +45,6 @@ library
       Data.Profunctor.Filtrator
       Data.Profunctor.Grammar
       Data.Profunctor.Grammar.Parsector
-      Data.Profunctor.Grammar.Parsector2
       Data.Profunctor.Monadic
       Data.Profunctor.Monoidal
   other-modules:
diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 4e4feee..efe5718 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -339,7 +339,7 @@ type CtxGrammar token a = forall p.
   , forall x. BackusNaurForm (p x x)
   , Alternator p
   , Filtrator p
-  , MonadicTry p
+  , Monadic p
   ) => p a a
 
 {- |
@@ -799,7 +799,7 @@ parsecG
   => (Item string ~ token, Categorized token)
   => CtxGrammar token a
   -> string {- ^ input -}
-  -> Either (Expect string, string) (a, string)
+  -> Reply string a
 parsecG parsector = parsecP parsector
 
 {- | `unparsecG` generates a Parsec-style unparser from a `CtxGrammar`,
@@ -811,7 +811,7 @@ unparsecG
   => CtxGrammar token a
   -> a {- ^ syntax -}
   -> string {- ^ input -}
-  -> Either (Expect string, string) string
+  -> Reply string a
 unparsecG parsector = unparsecP parsector
 
 {- | `putStringLn` is a utility that generalizes `putStrLn`
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 92ee230..9faa745 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -11,14 +11,15 @@ Portability : non-portable
 module Data.Profunctor.Grammar.Parsector
   ( -- * Parsector
     Parsector (..)
-  , StateCallbacks (..)
-  , Expect (..)
+  , Reply (..)
   , parsecP
   , unparsecP
   ) where
 
 import Control.Applicative
-import Data.Function
+import Control.Arrow
+import Control.Category
+import Data.Function hiding (id, (.))
 import Control.Lens
 import Control.Lens.Grammar.BackusNaur
 import Control.Lens.PartialIso
@@ -30,222 +31,230 @@ import Data.Profunctor
 import Data.Profunctor.Distributor
 import Data.Profunctor.Filtrator
 import Data.Profunctor.Monadic (MonadTry (..))
+import Data.Profunctor.Monoidal
 import GHC.Exts
+import Prelude hiding (id, (.))
 import Witherable
 
 newtype Parsector s a b = Parsector
-  { runParsector :: forall x. StateCallbacks s a b x -> x }
+  { runParsector :: forall x. (Reply s b -> x) -> Reply s a -> x }
 
-data StateCallbacks s a b x = StateCallbacks
-  { stateStream :: s
-  , stateOffset :: Word
-  , stateSyntax :: Maybe a
-  , consumedOk :: b -> s -> Expect s -> x
-  , consumedErr :: Expect s -> x
-  , emptyOk :: b -> s -> Expect s -> x
-  , emptyErr :: Expect s -> x
-  }
-
-data Expect s = Expect
-  { expectOffset :: Word
-  , expectPattern :: Bnf (RegEx (Item s)) -- ^ first set grammar
-  }
-deriving instance
+data Reply s a = Reply
+  { parsecOffset :: Word
+  , parsecResult :: Either (Bnf (RegEx (Item s))) a
+  , parsecStream :: s -- ^ input stream
+  } deriving (Functor, Foldable, Traversable)
+deriving stock instance
+  ( Categorized (Item s)
+  , Show (Item s), Show (Categorize (Item s))
+  , Show a, Show s
+  ) => Show (Reply s a)
+deriving stock instance
+  ( Categorized (Item s)
+  , Read (Item s), Read (Categorize (Item s))
+  , Read a, Read s
+  ) => Read (Reply s a)
+deriving stock instance
   ( Categorized (Item s)
-  , Show (Item s)
-  , Show (Categorize (Item s))
-  ) => Show (Expect s)
-deriving instance Categorized (Item s) => Eq (Expect s)
-deriving instance Categorized (Item s) => Ord (Expect s)
+  , Eq a, Eq s
+  ) => Eq (Reply s a)
+deriving stock instance
+  ( Categorized (Item s)
+  , Ord a, Ord s
+  ) => Ord (Reply s a)
 
--- | Run a `Parsector` as a parser, consuming tokens from the input.
-parsecP :: Parsector s a b -> s -> Either (Expect s, s) (b, s)
-parsecP (Parsector p) s = p StateCallbacks
-  { stateStream = s
-  , stateOffset = 0
-  , stateSyntax = Nothing
-  , consumedOk = \b st _ -> Right (b, st)
-  , consumedErr = \err -> Left (err, s)
-  , emptyOk = \b st _ -> Right (b, st)
-  , emptyErr = \err -> Left (err, s)
-  }
+parsecP :: Categorized (Item s) => Parsector s a b -> s -> Reply s b
+parsecP p s = runParsector p id (Reply 0 (Left zeroK) s)
 
--- | Run a `Parsector` as an unparser, snocing tokens onto an empty input.
-unparsecP :: Parsector s a b -> a -> s -> Either (Expect s, s) s
-unparsecP (Parsector p) a s = snd <$> p StateCallbacks
-  { stateStream = s
-  , stateOffset = 0
-  , stateSyntax = Just a
-  , consumedOk = \b st _ -> Right (b, st)
-  , consumedErr = \err -> Left (err, s)
-  , emptyOk = \b st _ -> Right (b, st)
-  , emptyErr = \err -> Left (err, s)
-  }
+unparsecP :: Parsector s a b -> a -> s -> Reply s b
+unparsecP p a s = runParsector p id (Reply 0 (Right a) s)
 
 -- Parsector instances
-instance Categorized (Item s) => Semigroup (Expect s) where
-  e1 <> e2 = case compare (expectOffset e1) (expectOffset e2) of
-    GT -> e1
-    LT -> e2
-    EQ -> Expect
-      { expectOffset = expectOffset e1
-      , expectPattern = expectPattern e1 >|< expectPattern e2
-      }
-instance Categorized (Item s) => Monoid (Expect s) where
-  mempty = Expect
-    { expectOffset = 0
-    , expectPattern = zeroK
-    }
-instance Profunctor (Parsector s) where
-  dimap f g p = Parsector $ \args -> runParsector p args
-    { stateSyntax = fmap f (stateSyntax args)
-    , consumedOk = consumedOk args . g
-    , emptyOk = emptyOk args . g
-    }
+instance
+  ( Categorized token, Item s ~ token
+  , Cons s s token token, Snoc s s token token
+  ) => Tokenized token (Parsector s token token) where
+  anyToken = tokenClass anyToken
+  token t = tokenClass (token t)
+  oneOf ts = tokenClass (oneOf ts)
+  notOneOf ts = tokenClass (notOneOf ts)
+  asIn cat = tokenClass (asIn cat)
+  notAsIn cat = tokenClass (notAsIn cat)
+instance
+  ( Categorized token, Item s ~ token
+  , Cons s s token token, Snoc s s token token
+  ) => TokenAlgebra token (Parsector s token token) where
+    tokenClass test = Parsector $ \callback query ->
+      let
+        stream = parsecStream query
+        result = parsecResult query
+        offset = parsecOffset query
+        replyOk tok str = Reply
+          { parsecStream = str
+          , parsecOffset = offset + 1
+          , parsecResult = Right tok
+          }
+        replyErr = query
+          { parsecResult = Left (tokenClass test) }
+      in
+        callback $ case result of
+          Right tok
+            | tokenClass test tok -> replyOk tok (snoc stream tok)
+            | otherwise -> replyErr
+          Left _ -> case uncons stream of
+            Just (tok, rest)
+              | tokenClass test tok -> replyOk tok rest
+              | otherwise -> replyErr
+            Nothing -> replyErr
+instance Categorized (Item s)
+  => BackusNaurForm (Parsector s a b) where
+  rule name p = Parsector $ \callback query ->
+    flip (runParsector p) query $ \reply -> callback $
+      case parsecResult reply of
+        Left expect -> reply
+          {parsecResult = Left (rule name expect)}
+        Right _ -> reply
+  ruleRec name f = rule name (fix f)
+instance
+  ( Categorized token, Item s ~ token
+  , Cons s s token token, Snoc s s token token
+  ) => TerminalSymbol token (Parsector s () ())
 instance Functor (Parsector s a) where
   fmap = rmap
 instance Categorized (Item s) => Applicative (Parsector s a) where
-  pure b = Parsector $ \args ->
-    emptyOk args b (stateStream args) Expect
-      { expectOffset = stateOffset args
-      , expectPattern = zeroK
-      }
+  pure b = Parsector $ \callback query ->
+    callback query { parsecResult = Right b }
   (<*>) = ap
-instance Categorized (Item s) => Alternative (Parsector s a) where
-  empty = Parsector $ \args -> emptyErr args Expect
-    { expectOffset = stateOffset args
-    , expectPattern = zeroK
-    }
-  p <|> q = mplus (try p) q
 instance Categorized (Item s) => Monad (Parsector s a) where
-  p >>= f = Parsector $ \args -> runParsector p args
-    { emptyOk = \x input msg1 -> runParsector (f x) args
-        { stateStream = input
-        , stateOffset = expectOffset msg1
-        , emptyOk = \x' input' msg' -> emptyOk args x' input' msg'
-        , emptyErr = \msg' -> emptyErr args msg'
-        }
-    , consumedOk = \x input msg1 -> runParsector (f x) args
-        { stateStream = input
-        , stateOffset = expectOffset msg1
-        , emptyOk = \x' input' msg' -> consumedOk args x' input' msg'
-        , emptyErr = \msg' -> consumedErr args msg'
-        }
-    }
-instance Categorized (Item s) => MonadPlus (Parsector s a) where
-  mplus p q = Parsector $ \args -> runParsector p args
-    { emptyErr = \msg1 -> runParsector q args
-        { emptyErr = \msg2 -> emptyErr args (msg1 <> msg2)
-        , emptyOk = \x inp msg2 -> emptyOk args x inp (msg1 <> msg2)
-        }
-    , emptyOk = \x inp msg1 -> runParsector q args
-        { emptyErr = \msg2 -> emptyOk args x inp (msg1 <> msg2)
-        , emptyOk = \_ _ msg2 -> emptyOk args x inp (msg1 <> msg2)
-        }
-    }
+  return = pure
+  p >>= f = Parsector $ \callback query ->
+    flip (runParsector p) query $ \reply ->
+      case parsecResult reply of
+        Left expect -> callback reply {parsecResult = Left expect}
+        Right b -> runParsector (f b) callback reply
+          {parsecResult = parsecResult query}
+instance Categorized (Item s) => Alternative (Parsector s a) where
+  -- | Always fail, consuming no input and expecting nothing.
+  empty = Parsector $ \callback query ->
+    callback query { parsecResult = Left zeroK }
+  p <|> q = Parsector $ \callback query ->
+    -- Run p on the original input.
+    flip (runParsector p) query $ \replyP ->
+    -- In unparse mode the query already carries a value (Right _).
+    -- If p succeeded, commit immediately without running q:
+    -- this prevents infinite loops in recursive grammars where
+    -- unguarded branches would otherwise keep re-entering p.
+    case (parsecResult query, parsecResult replyP) of
+      (Right _, Right _) -> callback replyP
+      _ ->
+        -- In parse mode (or when p failed), run q on the same input.
+        flip (runParsector q) query $ \replyQ ->
+          case (parsecResult replyP, parsecResult replyQ) of
+            -- Only one branch succeeded: take it.
+            (Right _, Left _) -> callback replyP
+            (Left _, Right _) -> callback replyQ
+            -- Both succeeded: take the longest match.
+            (Right _, Right _) ->
+              if parsecOffset replyP >= parsecOffset replyQ
+              then callback replyP
+              else callback replyQ
+            -- Both failed: report the furthest failure,
+            -- merging expected tokens on a tie.
+            (Left expectP, Left expectQ) ->
+              case compare (parsecOffset replyP) (parsecOffset replyQ) of
+                GT -> callback replyP
+                EQ -> callback replyP
+                  { parsecResult = Left (expectP >|< expectQ) }
+                LT -> callback replyQ
+instance Categorized (Item s) => MonadPlus (Parsector s a)
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
 instance Categorized (Item s) => MonadTry (Parsector s a) where
-  try (Parsector p) = Parsector $ \args ->
-    p args { consumedErr = emptyErr args }
+  try p = Parsector $ \callback query ->
+    flip (runParsector p) query $ \reply ->
+      case parsecResult reply of
+        Right _ -> callback reply
+        Left _  -> callback query { parsecResult = Left zeroK }
 instance Categorized (Item s) => Filterable (Parsector s a) where
   mapMaybe = dimapMaybe Just
-instance Categorized (Item s) => Alternator (Parsector s) where
-  alternate (Left p) = Parsector $ \args ->
-    case stateSyntax args of
-      Just (Right _) -> emptyErr args Expect
-        { expectOffset = stateOffset args
-        , expectPattern = zeroK
-        }
-      mEAC -> runParsector p args
-        { stateSyntax = mEAC >>= either Just (const Nothing)
-        , consumedOk = \b st' err -> consumedOk args (Left b) st' err
-        , emptyOk = \b st' err -> emptyOk args (Left b) st' err
-        }
-  alternate (Right p) = Parsector $ \args ->
-    case stateSyntax args of
-      Just (Left _) -> emptyErr args Expect
-        { expectOffset = stateOffset args
-        , expectPattern = zeroK
+instance Category (Parsector s) where
+  id = Parsector id
+  Parsector q . Parsector p = Parsector (p . q)
+instance Categorized (Item s) => Arrow (Parsector s) where
+  arr f = Parsector $ \callback reply -> callback (f <$> reply)
+  (***) = (>*<)
+  first = first'
+  second = second'
+instance Categorized (Item s) => ArrowZero (Parsector s) where
+  zeroArrow = empty
+instance Categorized (Item s) => ArrowPlus (Parsector s) where
+  (<+>) = (<|>)
+instance Categorized (Item s) => ArrowChoice (Parsector s) where
+  (+++) = (>+<)
+  left = left'
+  right = right'
+instance Profunctor (Parsector s) where
+  dimap f g (Parsector p) = Parsector $
+    dimap (lmap (fmap g)) (lmap (fmap f)) p
+instance Strong (Parsector s) where
+  first' p = Parsector $ \callback reply0 ->
+    flip (runParsector p) (fst <$> reply0) $ \reply1 ->
+      callback reply1
+        { parsecResult = (,)
+            <$> parsecResult reply1
+            <*> (snd <$> parsecResult reply0)
         }
-      mEAC -> runParsector p args
-        { stateSyntax = mEAC >>= either (const Nothing) Just
-        , consumedOk = \d st' err -> consumedOk args (Right d) st' err
-        , emptyOk = \d st' err -> emptyOk args (Right d) st' err
+  second' p = Parsector $ \callback reply0 ->
+    flip (runParsector p) (snd <$> reply0) $ \reply1 ->
+      callback reply1
+        { parsecResult = (,)
+            <$> (fst <$> parsecResult reply0)
+            <*> parsecResult reply1
         }
 instance Categorized (Item s) => Choice (Parsector s) where
   left' = alternate . Left
   right' = alternate . Right
 instance Categorized (Item s) => Distributor (Parsector s)
-instance Categorized (Item s) => Filtrator (Parsector s) where
-  filtrate (Parsector p) =
-    ( Parsector $ \args ->
-        p args
-          { stateSyntax = Left <$> stateSyntax args
-          , consumedOk = \ebd st' err -> case ebd of
-              Left b -> consumedOk args b st' err
-              Right _ -> consumedErr args err
-          , emptyOk = \ebd st' err -> case ebd of
-              Left b -> emptyOk args b st' err
-              Right _ -> emptyErr args err
-          }
-    , Parsector $ \args ->
-        p args
-          { stateSyntax = Right <$> stateSyntax args
-          , consumedOk = \ebd st' err -> case ebd of
-              Right d -> consumedOk args d st' err
-              Left _ -> consumedErr args err
-          , emptyOk = \ebd st' err -> case ebd of
-              Right d -> emptyOk args d st' err
-              Left _ -> emptyErr args err
-          }
-    )
+instance Categorized (Item s) => Alternator (Parsector s) where
+  alternate (Left p) = Parsector $ \callback reply0 ->
+    let
+      replyOk = reply0
+        { parsecResult = parsecResult reply0 >>= either Right (const (Left zeroK))
+        }
+      replyErr = reply0
+        { parsecResult = Left zeroK }
+    in
+      case (parsecResult reply0, parsecResult replyOk) of
+        (Right _, Left _) -> callback replyErr
+        _ -> flip (runParsector p) replyOk $ \reply2 ->
+          callback reply2
+            { parsecResult = Left <$> parsecResult reply2 }
+  alternate (Right p) = Parsector $ \callback reply ->
+    let
+      replyOk = reply
+        { parsecResult = parsecResult reply >>= either (const (Left zeroK)) Right
+        }
+      replyErr = reply
+        { parsecResult = Left zeroK }
+    in
+      case (parsecResult reply, parsecResult replyOk) of
+        (Right _, Left _) -> callback replyErr
+        _ -> flip (runParsector p) replyOk $ \reply2 ->
+          callback reply2
+            { parsecResult = Right <$> parsecResult reply2 }
 instance Categorized (Item s) => Cochoice (Parsector s) where
   unleft = fst . filtrate
   unright = snd . filtrate
-instance
-  ( Categorized token, Item s ~ token
-  , Cons s s token token, Snoc s s token token
-  ) => TokenAlgebra token (Parsector s token token) where
-    tokenClass test = Parsector $ \args ->
-      let
-        str = stateStream args
-        off = stateOffset args
-        failExp = Expect off (tokenClass test)
-        succExp = Expect off zeroK
-      in
-        case stateSyntax args of
-          Just tok
-            | tokenClass test tok ->
-                consumedOk args tok (snoc str tok) succExp
-            | otherwise -> emptyErr args failExp
-          Nothing -> case uncons str of
-            Nothing -> emptyErr args failExp
-            Just (tok, rest)
-              | tokenClass test tok ->
-                  consumedOk args tok rest succExp
-              | otherwise -> emptyErr args failExp
-instance
-  ( Categorized token, Item s ~ token
-  , Cons s s token token, Snoc s s token token
-  ) => TerminalSymbol token (Parsector s () ())
-instance
-  ( Categorized token, Item s ~ token
-  , Cons s s token token, Snoc s s token token
-  ) => Tokenized token (Parsector s token token) where
-  anyToken = tokenClass anyToken
-  token t = tokenClass (token t)
-  oneOf ts = tokenClass (oneOf ts)
-  notOneOf ts = tokenClass (notOneOf ts)
-  asIn cat = tokenClass (asIn cat)
-  notAsIn cat = tokenClass (notAsIn cat)
-instance Categorized (Item s)
-  => BackusNaurForm (Parsector s a b) where
-  rule name (Parsector p) = Parsector $ \args -> p args
-    { emptyOk = \b st' -> emptyOk args b st' . label
-    , emptyErr = emptyErr args . label
-    }
-    where
-      label fl = fl
-        { expectPattern = rule name (expectPattern fl)}
-  ruleRec name f = rule name (fix f)
+instance Categorized (Item s) => Filtrator (Parsector s) where
+  filtrate p =
+    ( Parsector $ \callback reply0 ->
+        flip (runParsector p) (Left <$> reply0) $ \reply1 ->
+          callback reply1
+            { parsecResult = parsecResult reply1 >>= either Right (const (Left zeroK))
+            }
+    , Parsector $ \callback reply0 ->
+        flip (runParsector p) (Right <$> reply0) $ \reply1 ->
+          callback reply1
+            { parsecResult = parsecResult reply1 >>= either (const (Left zeroK)) Right
+            }
+    )
diff --git a/src/Data/Profunctor/Grammar/Parsector2.hs b/src/Data/Profunctor/Grammar/Parsector2.hs
deleted file mode 100644
index 35a2b8f..0000000
--- a/src/Data/Profunctor/Grammar/Parsector2.hs
+++ /dev/null
@@ -1,258 +0,0 @@
-{-|
-Module      : Data.Profunctor.Grammar.Parsector
-Description : Parsec-style invertible parser profunctor
-Copyright   : (C) 2026 - Eitan Chatav
-License     : BSD-style (see the file LICENSE)
-Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
-Stability   : provisional
-Portability : non-portable
--}
-
-module Data.Profunctor.Grammar.Parsector2
-  ( -- * Parsector
-    Parsector (..)
-  , Reply (..)
-  , parsecP
-  , unparsecP
-  ) where
-
-import Control.Applicative
-import Control.Category
-import Data.Function hiding (id, (.))
-import Control.Lens
-import Control.Lens.Grammar.BackusNaur
--- import Control.Lens.PartialIso
--- import Control.Lens.Grammar.Symbol
-import Control.Lens.Grammar.Token
-import Control.Monad
-import Control.Lens.Grammar.Kleene
--- import Data.Profunctor
--- import Data.Profunctor.Distributor
--- import Data.Profunctor.Filtrator
-import Data.Profunctor.Monadic (MonadTry (..))
-import GHC.Exts
-import Prelude hiding (id, (.))
--- import Witherable
-
-newtype Parsector s a b = Parsector
-  { runParsector :: forall x. (Reply s b -> x) -> Reply s a -> x }
-
-data Reply s a = Reply
-  { parsecOffset :: Word
-  , parsecExpect :: Bnf (RegEx (Item s))
-  , parsecStream :: s -- ^ input stream
-  , parsecResult :: Maybe a
-  } deriving Functor
-
-parsecP
-  :: Categorized (Item s)
-  => Parsector s a b -> s -> Reply s b
-parsecP (Parsector p) s = p id (Reply 0 zeroK s Nothing)
-
-unparsecP
-  :: Categorized (Item s)
-  => Parsector s a b -> a -> s -> Reply s b
-unparsecP (Parsector p) a s = p id (Reply 0 zeroK s (Just a))
-
--- Parsector instances
-instance Profunctor (Parsector s) where
-  dimap f g (Parsector p) = Parsector $
-    dimap (lmap (fmap g)) (lmap (fmap f)) p
-instance Functor (Parsector s a) where
-  fmap = rmap
-instance
-  ( Categorized token, Item s ~ token
-  , Cons s s token token, Snoc s s token token
-  ) => Tokenized token (Parsector s token token) where
-  anyToken = tokenClass anyToken
-  token t = tokenClass (token t)
-  oneOf ts = tokenClass (oneOf ts)
-  notOneOf ts = tokenClass (notOneOf ts)
-  asIn cat = tokenClass (asIn cat)
-  notAsIn cat = tokenClass (notAsIn cat)
-instance
-  ( Categorized token, Item s ~ token
-  , Cons s s token token, Snoc s s token token
-  ) => TokenAlgebra token (Parsector s token token) where
-    tokenClass test = Parsector $ \callbacks reply ->
-      let
-        stream = parsecStream reply
-        result = parsecResult reply
-        offset = parsecOffset reply
-        callbackOk tok str = callbacks Reply
-          { parsecStream = str
-          , parsecOffset = offset + 1
-          , parsecExpect = zeroK
-          , parsecResult = Just tok
-          }
-        callbackErr = callbacks reply
-          { parsecExpect = tokenClass test
-          , parsecResult = Nothing
-          }
-      in
-        case result of
-          Just tok
-            | tokenClass test tok -> callbackOk tok (snoc stream tok)
-            | otherwise -> callbackErr
-          Nothing -> case uncons stream of
-            Just (tok, rest)
-              | tokenClass test tok -> callbackOk tok rest
-              | otherwise -> callbackErr
-            Nothing -> callbackErr
-instance Categorized (Item s)
-  => BackusNaurForm (Parsector s a b) where
-  rule name p = Parsector $ \callbacks reply0 ->
-    flip (runParsector p) reply0 $ \reply1 ->
-      case parsecResult reply1 of
-        Nothing -> callbacks reply1
-          {parsecExpect = rule name (parsecExpect reply1)}
-        Just _ -> callbacks reply1
-  ruleRec name f = rule name (fix f)
-instance Categorized (Item s) => Applicative (Parsector s a) where
-  pure b = Parsector $ \callbacks reply ->
-    callbacks reply
-      { parsecExpect = zeroK
-      , parsecResult = Just b
-      }
-  (<*>) = ap
-instance Categorized (Item s) => Monad (Parsector s a) where
-  return = pure
-  p >>= f = Parsector $ \callbacks reply ->
-    flip (runParsector p) reply $ \reply0 ->
-      case parsecResult reply0 of
-        Nothing -> callbacks reply0 {parsecResult = Nothing}
-        Just b -> runParsector (f b) callbacks reply0
-          {parsecResult = parsecResult reply}
-instance Categorized (Item s) => Alternative (Parsector s a) where
-  empty = Parsector $ \callbacks reply ->
-    callbacks reply
-      { parsecExpect = zeroK
-      , parsecResult = Nothing
-      }
-  p <|> q = Parsector $ \callbacks reply ->
-    flip (runParsector p) reply $ \reply0 ->
-    flip (runParsector q) reply $ \reply1 ->
-      case (parsecResult reply0, parsecResult reply1) of
-        (Just _, Nothing) -> callbacks reply0
-        (Nothing, Just _) -> callbacks reply1
-        -- longest passing match
-        (Just _, Just _) ->
-          if ((>=) `on` parsecOffset) reply0 reply1
-          then callbacks reply0
-          else callbacks reply1
-        -- longest failing match
-        (Nothing, Nothing) ->
-          case (compare `on` parsecOffset) reply0 reply1 of
-            GT -> callbacks reply0
-            EQ -> callbacks reply0
-              {parsecExpect = ((>|<) `on` parsecExpect) reply0 reply1}
-            LT -> callbacks reply1
-instance Categorized (Item s) => MonadPlus (Parsector s a)
-instance Categorized (Item s) => MonadFail (Parsector s a) where
-  fail msg = rule msg empty
-instance Categorized (Item s) => MonadTry (Parsector s a) where
-  try = undefined -- TODO isempty === offset == 0
-instance Category (Parsector s) where
-  id = Parsector ($)
-  Parsector q . Parsector p = Parsector (p . q)
--- instance Categorized (Item s) => Filterable (Parsector s a) where
---   mapMaybe = dimapMaybe Just
--- instance Categorized (Item s) => Alternator (Parsector s) where
---   alternate (Left p) = Parsector $ \args ->
---     case stateSyntax args of
---       Just (Right _) -> emptyErr args Expect
---         { expectOffset = stateOffset args
---         , expectPattern = zeroK
---         }
---       mEAC -> runParsector p args
---         { stateSyntax = mEAC >>= either Just (const Nothing)
---         , callbackOk = \b st' err -> callbackOk args (Left b) st' err
---         , emptyOk = \b st' err -> emptyOk args (Left b) st' err
---         }
---   alternate (Right p) = Parsector $ \args ->
---     case stateSyntax args of
---       Just (Left _) -> emptyErr args Expect
---         { expectOffset = stateOffset args
---         , expectPattern = zeroK
---         }
---       mEAC -> runParsector p args
---         { stateSyntax = mEAC >>= either (const Nothing) Just
---         , callbackOk = \d st' err -> callbackOk args (Right d) st' err
---         , emptyOk = \d st' err -> emptyOk args (Right d) st' err
---         }
--- instance Categorized (Item s) => Choice (Parsector s) where
---   left' = alternate . Left
---   right' = alternate . Right
--- instance Categorized (Item s) => Distributor (Parsector s)
--- instance Categorized (Item s) => Filtrator (Parsector s) where
---   filtrate (Parsector p) =
---     ( Parsector $ \args ->
---         p args
---           { stateSyntax = Left <$> stateSyntax args
---           , callbackOk = \ebd st' err -> case ebd of
---               Left b -> callbackOk args b st' err
---               Right _ -> callbackErr args err
---           , emptyOk = \ebd st' err -> case ebd of
---               Left b -> emptyOk args b st' err
---               Right _ -> emptyErr args err
---           }
---     , Parsector $ \args ->
---         p args
---           { stateSyntax = Right <$> stateSyntax args
---           , callbackOk = \ebd st' err -> case ebd of
---               Right d -> callbackOk args d st' err
---               Left _ -> callbackErr args err
---           , emptyOk = \ebd st' err -> case ebd of
---               Right d -> emptyOk args d st' err
---               Left _ -> emptyErr args err
---           }
---     )
--- instance Categorized (Item s) => Cochoice (Parsector s) where
---   unleft = fst . filtrate
---   unright = snd . filtrate
--- instance
---   ( Categorized token, Item s ~ token
---   , Cons s s token token, Snoc s s token token
---   ) => TokenAlgebra token (Parsector s token token) where
---     tokenClass test = Parsector $ \args ->
---       let
---         str = stateStream args
---         off = stateOffset args
---         failExp = Expect off (tokenClass test)
---         succExp = Expect off zeroK
---       in
---         case stateSyntax args of
---           Just tok
---             | tokenClass test tok ->
---                 callbackOk args tok (snoc str tok) succExp
---             | otherwise -> emptyErr args failExp
---           Nothing -> case uncons str of
---             Nothing -> emptyErr args failExp
---             Just (tok, rest)
---               | tokenClass test tok ->
---                   callbackOk args tok rest succExp
---               | otherwise -> emptyErr args failExp
--- instance
---   ( Categorized token, Item s ~ token
---   , Cons s s token token, Snoc s s token token
---   ) => TerminalSymbol token (Parsector s () ())
--- instance
---   ( Categorized token, Item s ~ token
---   , Cons s s token token, Snoc s s token token
---   ) => Tokenized token (Parsector s token token) where
---   anyToken = tokenClass anyToken
---   token t = tokenClass (token t)
---   oneOf ts = tokenClass (oneOf ts)
---   notOneOf ts = tokenClass (notOneOf ts)
---   asIn cat = tokenClass (asIn cat)
---   notAsIn cat = tokenClass (notAsIn cat)
--- instance Categorized (Item s)
---   => BackusNaurForm (Parsector s a b) where
---   rule name (Parsector p) = Parsector $ \args -> p args
---     { emptyOk = \b st' -> emptyOk args b st' . label
---     , emptyErr = emptyErr args . label
---     }
---     where
---       label fl = fl
---         { expectPattern = rule name (expectPattern fl)}
---   ruleRec name f = rule name (fix f)
diff --git a/test/Main.hs b/test/Main.hs
index a3dcb06..23aa34d 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -4,6 +4,9 @@ import Data.Foldable hiding (toList)
 import Data.Maybe (listToMaybe)
 import Control.Lens.Grammar
 import Control.Lens.Grammar.BackusNaur
+import Control.Lens.Grammar.Kleene
+import Data.List (genericLength)
+import Data.Profunctor.Grammar.Parsector
 import Test.DocTest
 import Test.Hspec
 
@@ -89,18 +92,22 @@ testGrammarExample grammar (expectedSyntax, expectedString) = do
 
 testCtxGrammarExample :: (Show a, Eq a) => CtxGrammar Char a -> (a, String) -> Spec
 testCtxGrammarExample grammar (expectedSyntax, expectedString) = do
-  it ("should parse from " <> expectedString <> " correctly") $ do
+  it ("should parseG from " <> expectedString <> " correctly") $ do
     let actualSyntax = [parsed | (parsed, "") <- parseG grammar expectedString]
     listToMaybe actualSyntax `shouldBe` Just expectedSyntax
-  it ("should unparse to " <> expectedString <> " correctly") $ do
+  it ("should unparseG to " <> expectedString <> " correctly") $ do
     let actualString = unparseG grammar expectedSyntax ""
     actualString `shouldBe` Just expectedString
-  it ("should print to " <> expectedString <> " correctly") $ do
+  it ("should printG to " <> expectedString <> " correctly") $ do
     let actualString = ($ "") <$> printG grammar expectedSyntax
     actualString `shouldBe` Just expectedString
-  it ("should parsec from " <> expectedString <> " correctly") $ do
+  it ("should parsecG from " <> expectedString <> " correctly") $ do
     let actualSyntax = parsecG grammar expectedString
-    actualSyntax `shouldBe` Right (expectedSyntax, "")
-  it ("should unparsec to " <> expectedString <> " correctly") $ do
+    let expectedLength = genericLength expectedString
+    actualSyntax `shouldBe`
+      (Reply expectedLength zeroK (Just expectedSyntax) "")
+  it ("should unparsecG to " <> expectedString <> " correctly") $ do
     let actualString = unparsecG grammar expectedSyntax ""
-    actualString `shouldBe` Right expectedString
+    let expectedLength = genericLength expectedString
+    actualString `shouldBe`
+      (Reply expectedLength zeroK (Just expectedSyntax) expectedString)

From fd5b2b379c060c5fd67e9eeff4f36e11376bfb33 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 30 Mar 2026 18:48:26 -0700
Subject: [PATCH 049/103] tests

---
 test/Examples/Chain.hs     | 2 +-
 test/Examples/RegString.hs | 2 +-
 test/Main.hs               | 8 +++-----
 3 files changed, 5 insertions(+), 7 deletions(-)

diff --git a/test/Examples/Chain.hs b/test/Examples/Chain.hs
index 420e4ed..a7d1fcb 100644
--- a/test/Examples/Chain.hs
+++ b/test/Examples/Chain.hs
@@ -38,5 +38,5 @@ chainExamples =
   , (Seq (Char '1') (Char '2'), "12")
   , (Seq (Seq (Char 'x') (Char 'y')) (Char 'z'), "xyz")
   , (Seq (Char 'x') (Seq (Char 'y') (Char 'z')), "x(yz)")
-  -- , (Emp, "")
+  , (Emp, "")
   ]
diff --git a/test/Examples/RegString.hs b/test/Examples/RegString.hs
index ce63d6f..1221a93 100644
--- a/test/Examples/RegString.hs
+++ b/test/Examples/RegString.hs
@@ -24,7 +24,7 @@ regexExamples =
   , (asIn UppercaseLetter, "\\p{Lu}")
   , (notAsIn LowercaseLetter, "\\P{Ll}")
   , (nonTerminal "rule-name", "\\q{rule-name}")
-  -- , (terminal "", "")
+  , (terminal "", "")
   , (optK (terminal "abc"), "(abc)?")
   , (optK (terminal "abc") <> nonTerminal "xyz", "(abc)?\\q{xyz}")
 
diff --git a/test/Main.hs b/test/Main.hs
index 23aa34d..3dcb560 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,10 +1,8 @@
 module Main (main) where
 
 import Data.Foldable hiding (toList)
-import Data.Maybe (listToMaybe)
 import Control.Lens.Grammar
 import Control.Lens.Grammar.BackusNaur
-import Control.Lens.Grammar.Kleene
 import Data.List (genericLength)
 import Data.Profunctor.Grammar.Parsector
 import Test.DocTest
@@ -94,7 +92,7 @@ testCtxGrammarExample :: (Show a, Eq a) => CtxGrammar Char a -> (a, String) -> S
 testCtxGrammarExample grammar (expectedSyntax, expectedString) = do
   it ("should parseG from " <> expectedString <> " correctly") $ do
     let actualSyntax = [parsed | (parsed, "") <- parseG grammar expectedString]
-    listToMaybe actualSyntax `shouldBe` Just expectedSyntax
+    actualSyntax `shouldBe` [expectedSyntax]
   it ("should unparseG to " <> expectedString <> " correctly") $ do
     let actualString = unparseG grammar expectedSyntax ""
     actualString `shouldBe` Just expectedString
@@ -105,9 +103,9 @@ testCtxGrammarExample grammar (expectedSyntax, expectedString) = do
     let actualSyntax = parsecG grammar expectedString
     let expectedLength = genericLength expectedString
     actualSyntax `shouldBe`
-      (Reply expectedLength zeroK (Just expectedSyntax) "")
+      (Reply expectedLength (Right expectedSyntax) "")
   it ("should unparsecG to " <> expectedString <> " correctly") $ do
     let actualString = unparsecG grammar expectedSyntax ""
     let expectedLength = genericLength expectedString
     actualString `shouldBe`
-      (Reply expectedLength zeroK (Just expectedSyntax) expectedString)
+      (Reply expectedLength (Right expectedSyntax) expectedString)

From 3ff16f487df2698b8b94873ae55dbda8e1e8e5a4 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 30 Mar 2026 19:43:05 -0700
Subject: [PATCH 050/103] Update Symbol.hs

---
 src/Control/Lens/Grammar/Symbol.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Control/Lens/Grammar/Symbol.hs b/src/Control/Lens/Grammar/Symbol.hs
index 4f69e98..d5ab6b3 100644
--- a/src/Control/Lens/Grammar/Symbol.hs
+++ b/src/Control/Lens/Grammar/Symbol.hs
@@ -26,7 +26,7 @@ class TerminalSymbol token s | s -> token where
   default terminal
     :: (p () () ~ s, Tokenized token (p token token), Monoidal p, Cochoice p)
     => [token] -> s
-  terminal = foldr (\a p -> only a ?< anyToken *> p) oneP
+  terminal = foldr (\a p -> only a ?< token a *> p) oneP
 
 -- | A `nonTerminal` symbol in a grammar.
 class NonTerminalSymbol s where

From 56af49b22253da62ae0677c3ecfc448316bc0189 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 30 Mar 2026 19:43:09 -0700
Subject: [PATCH 051/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 115 ++++++++++++-----------
 1 file changed, 60 insertions(+), 55 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 9faa745..e834ffd 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -139,42 +139,39 @@ instance Categorized (Item s) => Alternative (Parsector s a) where
     callback query { parsecResult = Left zeroK }
   p <|> q = Parsector $ \callback query ->
     -- Run p on the original input.
-    flip (runParsector p) query $ \replyP ->
-    -- In unparse mode the query already carries a value (Right _).
-    -- If p succeeded, commit immediately without running q:
-    -- this prevents infinite loops in recursive grammars where
-    -- unguarded branches would otherwise keep re-entering p.
-    case (parsecResult query, parsecResult replyP) of
-      (Right _, Right _) -> callback replyP
-      _ ->
+    flip (runParsector p) query $ \replyP -> callback $
+      case (parsecResult query, parsecResult replyP) of
+        -- In unparse mode the query already carries a value (Right _).
+        -- If p succeeded, commit immediately without running q.
+        (Right _, Right _) -> replyP
         -- In parse mode (or when p failed), run q on the same input.
-        flip (runParsector q) query $ \replyQ ->
-          case (parsecResult replyP, parsecResult replyQ) of
-            -- Only one branch succeeded: take it.
-            (Right _, Left _) -> callback replyP
-            (Left _, Right _) -> callback replyQ
-            -- Both succeeded: take the longest match.
-            (Right _, Right _) ->
-              if parsecOffset replyP >= parsecOffset replyQ
-              then callback replyP
-              else callback replyQ
-            -- Both failed: report the furthest failure,
-            -- merging expected tokens on a tie.
-            (Left expectP, Left expectQ) ->
-              case compare (parsecOffset replyP) (parsecOffset replyQ) of
-                GT -> callback replyP
-                EQ -> callback replyP
-                  { parsecResult = Left (expectP >|< expectQ) }
-                LT -> callback replyQ
+        __________________ ->
+          flip (runParsector q) query $ \replyQ ->
+            case (parsecResult replyP, parsecResult replyQ) of
+              -- Only one branch succeeded: take it.
+              (Right _, Left _) -> replyP
+              (Left _, Right _) -> replyQ
+              -- Both succeeded: take the longest match.
+              (Right _, Right _) ->
+                if parsecOffset replyP >= parsecOffset replyQ
+                then replyP
+                else replyQ
+              -- Both failed: report the furthest failure,
+              -- merging expected tokens on a tie.
+              (Left expectP, Left expectQ) ->
+                case compare (parsecOffset replyP) (parsecOffset replyQ) of
+                  GT -> replyP
+                  EQ -> replyP { parsecResult = Left (expectP >|< expectQ) }
+                  LT -> replyQ
 instance Categorized (Item s) => MonadPlus (Parsector s a)
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
 instance Categorized (Item s) => MonadTry (Parsector s a) where
   try p = Parsector $ \callback query ->
-    flip (runParsector p) query $ \reply ->
+    flip (runParsector p) query $ \reply -> callback $
       case parsecResult reply of
-        Right _ -> callback reply
-        Left _  -> callback query { parsecResult = Left zeroK }
+        Right _ -> reply
+        Left _ -> query { parsecResult = Left zeroK }
 instance Categorized (Item s) => Filterable (Parsector s a) where
   mapMaybe = dimapMaybe Just
 instance Category (Parsector s) where
@@ -216,45 +213,53 @@ instance Categorized (Item s) => Choice (Parsector s) where
   right' = alternate . Right
 instance Categorized (Item s) => Distributor (Parsector s)
 instance Categorized (Item s) => Alternator (Parsector s) where
-  alternate (Left p) = Parsector $ \callback reply0 ->
+  alternate (Left p) = Parsector $ \callback query -> callback $
     let
-      replyOk = reply0
-        { parsecResult = parsecResult reply0 >>= either Right (const (Left zeroK))
+      replyOk = query
+        { parsecResult = do
+            result <- parsecResult query
+            either Right (const (Left zeroK)) result
         }
-      replyErr = reply0
+      replyErr = query
         { parsecResult = Left zeroK }
     in
-      case (parsecResult reply0, parsecResult replyOk) of
-        (Right _, Left _) -> callback replyErr
-        _ -> flip (runParsector p) replyOk $ \reply2 ->
-          callback reply2
-            { parsecResult = Left <$> parsecResult reply2 }
-  alternate (Right p) = Parsector $ \callback reply ->
+      case (parsecResult query, parsecResult replyOk) of
+        (Right _, Left _) -> replyErr
+        _________________ ->
+          flip (runParsector p) replyOk $ \reply -> reply
+            { parsecResult = Left <$> parsecResult reply }
+  alternate (Right p) = Parsector $ \callback query -> callback $
     let
-      replyOk = reply
-        { parsecResult = parsecResult reply >>= either (const (Left zeroK)) Right
+      replyOk = query
+        { parsecResult = do
+            result <- parsecResult query
+            either (const (Left zeroK)) Right result
         }
-      replyErr = reply
+      replyErr = query
         { parsecResult = Left zeroK }
     in
-      case (parsecResult reply, parsecResult replyOk) of
-        (Right _, Left _) -> callback replyErr
-        _ -> flip (runParsector p) replyOk $ \reply2 ->
-          callback reply2
-            { parsecResult = Right <$> parsecResult reply2 }
+      case (parsecResult query, parsecResult replyOk) of
+        (Right _, Left _) -> replyErr
+        _________________ ->
+          flip (runParsector p) replyOk $ \reply -> reply
+            { parsecResult = Right <$> parsecResult reply }
 instance Categorized (Item s) => Cochoice (Parsector s) where
   unleft = fst . filtrate
   unright = snd . filtrate
 instance Categorized (Item s) => Filtrator (Parsector s) where
   filtrate p =
-    ( Parsector $ \callback reply0 ->
-        flip (runParsector p) (Left <$> reply0) $ \reply1 ->
-          callback reply1
-            { parsecResult = parsecResult reply1 >>= either Right (const (Left zeroK))
+    ( Parsector $ \callback query ->
+        flip (runParsector p) (Left <$> query) $ \reply ->
+          callback reply
+            { parsecResult = do
+                result <- parsecResult reply
+                either Right (const (Left zeroK)) result
             }
-    , Parsector $ \callback reply0 ->
-        flip (runParsector p) (Right <$> reply0) $ \reply1 ->
-          callback reply1
-            { parsecResult = parsecResult reply1 >>= either (const (Left zeroK)) Right
+    , Parsector $ \callback query ->
+        flip (runParsector p) (Right <$> query) $ \reply ->
+          callback reply
+            { parsecResult = do
+                result <- parsecResult reply
+                either (const (Left zeroK)) Right result
             }
     )

From 93b491fc35ba5dff4055f59b1ba8cd185794f1c5 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 31 Mar 2026 12:01:08 -0700
Subject: [PATCH 052/103] Update Monadic.hs

---
 src/Data/Profunctor/Monadic.hs | 7 +------
 1 file changed, 1 insertion(+), 6 deletions(-)

diff --git a/src/Data/Profunctor/Monadic.hs b/src/Data/Profunctor/Monadic.hs
index 02000ce..a3097e4 100644
--- a/src/Data/Profunctor/Monadic.hs
+++ b/src/Data/Profunctor/Monadic.hs
@@ -61,12 +61,7 @@ x >> y = do _ <- lmap (const ()) x; y
 {- | A `Profunctor` which is also a `MonadTry`. -}
 type MonadicTry p = (Profunctor p, forall x. MonadTry (p x))
 
-{- |
-
-prop> x <|> y = try x `mplus` y
-prop> fail msg `mplus` x = x = x `mplus` fail msg
-
--}
+{- | `MonadTry`. -}
 class (MonadFail m, MonadPlus m) => MonadTry m where
   try :: m a -> m a
   default try :: m a -> m a

From e6760ef6fa328d35774266a6bf4fb46a99a912a5 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 31 Mar 2026 12:14:52 -0700
Subject: [PATCH 053/103] Update Monadic.hs

---
 src/Data/Profunctor/Monadic.hs | 5 -----
 1 file changed, 5 deletions(-)

diff --git a/src/Data/Profunctor/Monadic.hs b/src/Data/Profunctor/Monadic.hs
index a3097e4..1bb9427 100644
--- a/src/Data/Profunctor/Monadic.hs
+++ b/src/Data/Profunctor/Monadic.hs
@@ -30,7 +30,6 @@ module Data.Profunctor.Monadic
   , MonadTry (..)
   , MonadFail (..)
   , MonadPlus (..)
-  , mchoice
   ) where
 
 import Control.Monad hiding ((>>=), (>>))
@@ -66,7 +65,3 @@ class (MonadFail m, MonadPlus m) => MonadTry m where
   try :: m a -> m a
   default try :: m a -> m a
   try = id
-
--- | Combines all `MonadPlus` choices in the specified list.
-mchoice :: (Foldable f, MonadPlus p) => f (p a) -> p a
-mchoice = foldl' mplus mzero

From 8a49fd9acc9525d050a5b8e8f4f6d0807dd2d105 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 31 Mar 2026 12:16:27 -0700
Subject: [PATCH 054/103] Update Monadic.hs

---
 src/Data/Profunctor/Monadic.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Data/Profunctor/Monadic.hs b/src/Data/Profunctor/Monadic.hs
index 1bb9427..d5eda8f 100644
--- a/src/Data/Profunctor/Monadic.hs
+++ b/src/Data/Profunctor/Monadic.hs
@@ -16,7 +16,8 @@ This module can provide qualified do-notation for `Monadic` profunctors.
 >>> import qualified Data.Profunctor.Monadic as P
 
 See "Control.Lens.Grammar#t:CtxGrammar" for
-an example of how to use "bonding" notation.
+an example of how to use qualified do-notation
+with pattern bonding.
 -}
 
 module Data.Profunctor.Monadic

From e3f76244f831f9e31e8ea523440d80f5f1260877 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 31 Mar 2026 12:16:59 -0700
Subject: [PATCH 055/103] Update Monadic.hs

---
 src/Data/Profunctor/Monadic.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/Data/Profunctor/Monadic.hs b/src/Data/Profunctor/Monadic.hs
index d5eda8f..2b5af00 100644
--- a/src/Data/Profunctor/Monadic.hs
+++ b/src/Data/Profunctor/Monadic.hs
@@ -34,7 +34,6 @@ module Data.Profunctor.Monadic
   ) where
 
 import Control.Monad hiding ((>>=), (>>))
-import Data.Foldable
 import Data.Profunctor
 import Prelude hiding ((>>=), (>>))
 

From 4ad2e038eb0336e5fcf87a5e252fe686385a8653 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 31 Mar 2026 13:31:21 -0700
Subject: [PATCH 056/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index efe5718..e9fa23a 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -790,10 +790,7 @@ unparseG
   -> m string
 unparseG parsor = unparseP parsor
 
-{- | `parsecG` generates a Parsec-style parser from a `CtxGrammar`,
-returning either a `Expect` error or the parsed value
-and remaining input.
--}
+{- | `parsecG` generates a Parsec-style parser from a `CtxGrammar`. -}
 parsecG
   :: (Cons string string token token, Snoc string string token token)
   => (Item string ~ token, Categorized token)
@@ -802,9 +799,7 @@ parsecG
   -> Reply string a
 parsecG parsector = parsecP parsector
 
-{- | `unparsecG` generates a Parsec-style unparser from a `CtxGrammar`,
-returning either a `Expect` error or the output string.
--}
+{- | `unparsecG` generates a Parsec-style unparser from a `CtxGrammar`. -}
 unparsecG
   :: (Cons string string token token, Snoc string string token token)
   => (Item string ~ token, Categorized token)

From 6932afb7cc8ac4be35ff267d4f6a33d787e3a3c6 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 1 Apr 2026 05:53:14 -0700
Subject: [PATCH 057/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index e9fa23a..e7a16ce 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -492,9 +492,9 @@ But they also support `BackusNaurForm` `rule`s and `ruleRec`s.
 >>> putStringLn (rule "baz" (bnf >|< terminal "baz"))
 {start} = \q{baz}
 {baz} = foo|bar|baz
->>> putStringLn (ruleRec "∞" (\x -> x) :: RegBnf)
-{start} = \q{∞}
-{∞} = \q{∞}
+>>> putStringLn (ruleRec "∞-loop" (\x -> x) :: RegBnf)
+{start} = \q{∞-loop}
+{∞-loop} = \q{∞-loop}
 -}
 newtype RegBnf = RegBnf {runRegBnf :: Bnf RegString}
   deriving newtype

From 468db8be2bee7387b91d27bf9c3f834cf0f34cbe Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 1 Apr 2026 05:53:32 -0700
Subject: [PATCH 058/103] Update BackusNaur.hs

---
 src/Control/Lens/Grammar/BackusNaur.hs | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/src/Control/Lens/Grammar/BackusNaur.hs b/src/Control/Lens/Grammar/BackusNaur.hs
index b3c7d5d..9ab3de3 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -39,14 +39,12 @@ import Data.Set (Set)
 {- | `BackusNaurForm` grammar combinators formalize
 `rule` abstraction and general recursion. Context-free
 `Control.Lens.Grammar.Grammar`s support the `BackusNaurForm` interface.
+
+prop> rule name bnf = ruleRec name (\_ -> bnf)
 -}
 class BackusNaurForm bnf where
 
-  {- | For a `BackusNaurForm` parser instance,
-  `rule` can be used to detail parse errors.
-
-  prop> rule name bnf = ruleRec name (\_ -> bnf)
-  -}
+  {- | Rule abstraction. -}
   rule :: String -> bnf -> bnf
   rule _ = id
 

From 8dc103f476db2a69111556f96c7c0bc51990e7cc Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 1 Apr 2026 05:53:50 -0700
Subject: [PATCH 059/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 64 +++++++++++++++---------
 1 file changed, 40 insertions(+), 24 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index e834ffd..681954b 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -22,11 +22,12 @@ import Control.Category
 import Data.Function hiding (id, (.))
 import Control.Lens
 import Control.Lens.Grammar.BackusNaur
-import Control.Lens.PartialIso
+import Control.Lens.Grammar.Boole
+import Control.Lens.Grammar.Kleene
 import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
+import Control.Lens.PartialIso
 import Control.Monad
-import Control.Lens.Grammar.Kleene
 import Data.Profunctor
 import Data.Profunctor.Distributor
 import Data.Profunctor.Filtrator
@@ -36,13 +37,34 @@ import GHC.Exts
 import Prelude hiding (id, (.))
 import Witherable
 
+{- | `Parsector` is an invertible parser which can be used
+to parse with `parsecP` or print with `unparsecP`,
+yielding a `Reply`, with detailed errors and offset tracking.
+
+In print mode, `Parsector` yields the left-most
+success among alternatives, regardless of length.
+In parse mode, it yields the longest
+success among alternatives, biased to the left on ties.
+In either mode, it yields the longest
+failure among alternatives, with errors merged on ties.
+-}
 newtype Parsector s a b = Parsector
   { runParsector :: forall x. (Reply s b -> x) -> Reply s a -> x }
 
+{- | `Reply` is the return type for `parsecP` & `unparsecP`.
+It's the fundamental building block of `Parsector`.
+-}
 data Reply s a = Reply
-  { parsecOffset :: Word
-  , parsecResult :: Either (Bnf (RegEx (Item s))) a
-  , parsecStream :: s -- ^ input stream
+  { parsecOffset :: !Word
+    -- ^ number of tokens either parsed or printed
+  , parsecResult :: Either (TokenClass (Item s)) a
+    {- ^ As an input `parsecResult` represents either parse mode,
+    or print mode with an input syntax value.
+    As an output `parsecResult` represents either failure
+    with the expected `TokenClass`,
+    or success with an output syntax value.
+    -}
+  , parsecStream :: s -- ^ both input and output stream
   } deriving (Functor, Foldable, Traversable)
 deriving stock instance
   ( Categorized (Item s)
@@ -63,9 +85,11 @@ deriving stock instance
   , Ord a, Ord s
   ) => Ord (Reply s a)
 
+-- | `Parsector` is parsed using `parsecP`.
 parsecP :: Categorized (Item s) => Parsector s a b -> s -> Reply s b
-parsecP p s = runParsector p id (Reply 0 (Left zeroK) s)
+parsecP p s = runParsector p id (Reply 0 (Left (fromBool False)) s)
 
+-- | `Parsector` is printed using `unparsecP`.
 unparsecP :: Parsector s a b -> a -> s -> Reply s b
 unparsecP p a s = runParsector p id (Reply 0 (Right a) s)
 
@@ -106,15 +130,7 @@ instance
               | tokenClass test tok -> replyOk tok rest
               | otherwise -> replyErr
             Nothing -> replyErr
-instance Categorized (Item s)
-  => BackusNaurForm (Parsector s a b) where
-  rule name p = Parsector $ \callback query ->
-    flip (runParsector p) query $ \reply -> callback $
-      case parsecResult reply of
-        Left expect -> reply
-          {parsecResult = Left (rule name expect)}
-        Right _ -> reply
-  ruleRec name f = rule name (fix f)
+instance BackusNaurForm (Parsector s a b)
 instance
   ( Categorized token, Item s ~ token
   , Cons s s token token, Snoc s s token token
@@ -136,7 +152,7 @@ instance Categorized (Item s) => Monad (Parsector s a) where
 instance Categorized (Item s) => Alternative (Parsector s a) where
   -- | Always fail, consuming no input and expecting nothing.
   empty = Parsector $ \callback query ->
-    callback query { parsecResult = Left zeroK }
+    callback query { parsecResult = Left (fromBool False) }
   p <|> q = Parsector $ \callback query ->
     -- Run p on the original input.
     flip (runParsector p) query $ \replyP -> callback $
@@ -161,7 +177,7 @@ instance Categorized (Item s) => Alternative (Parsector s a) where
               (Left expectP, Left expectQ) ->
                 case compare (parsecOffset replyP) (parsecOffset replyQ) of
                   GT -> replyP
-                  EQ -> replyP { parsecResult = Left (expectP >|< expectQ) }
+                  EQ -> replyP { parsecResult = Left (expectP >||< expectQ) }
                   LT -> replyQ
 instance Categorized (Item s) => MonadPlus (Parsector s a)
 instance Categorized (Item s) => MonadFail (Parsector s a) where
@@ -171,7 +187,7 @@ instance Categorized (Item s) => MonadTry (Parsector s a) where
     flip (runParsector p) query $ \reply -> callback $
       case parsecResult reply of
         Right _ -> reply
-        Left _ -> query { parsecResult = Left zeroK }
+        Left _ -> query { parsecResult = Left (fromBool False) }
 instance Categorized (Item s) => Filterable (Parsector s a) where
   mapMaybe = dimapMaybe Just
 instance Category (Parsector s) where
@@ -218,10 +234,10 @@ instance Categorized (Item s) => Alternator (Parsector s) where
       replyOk = query
         { parsecResult = do
             result <- parsecResult query
-            either Right (const (Left zeroK)) result
+            either Right (const (Left (fromBool False))) result
         }
       replyErr = query
-        { parsecResult = Left zeroK }
+        { parsecResult = Left (fromBool False) }
     in
       case (parsecResult query, parsecResult replyOk) of
         (Right _, Left _) -> replyErr
@@ -233,10 +249,10 @@ instance Categorized (Item s) => Alternator (Parsector s) where
       replyOk = query
         { parsecResult = do
             result <- parsecResult query
-            either (const (Left zeroK)) Right result
+            either (const (Left (fromBool False))) Right result
         }
       replyErr = query
-        { parsecResult = Left zeroK }
+        { parsecResult = Left (fromBool False) }
     in
       case (parsecResult query, parsecResult replyOk) of
         (Right _, Left _) -> replyErr
@@ -253,13 +269,13 @@ instance Categorized (Item s) => Filtrator (Parsector s) where
           callback reply
             { parsecResult = do
                 result <- parsecResult reply
-                either Right (const (Left zeroK)) result
+                either Right (const (Left (fromBool False))) result
             }
     , Parsector $ \callback query ->
         flip (runParsector p) (Right <$> query) $ \reply ->
           callback reply
             { parsecResult = do
                 result <- parsecResult reply
-                either (const (Left zeroK)) Right result
+                either (const (Left (fromBool False))) Right result
             }
     )

From 1841a1924eedd9a25b71dd00b5c2844d05b196de Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 1 Apr 2026 05:57:27 -0700
Subject: [PATCH 060/103] trueB & falseB

---
 src/Control/Lens/Grammar/Boole.hs        | 27 +++++++++++++++---------
 src/Control/Lens/Grammar/Kleene.hs       |  4 ++--
 src/Data/Profunctor/Grammar/Parsector.hs | 18 ++++++++--------
 test/Examples/RegString.hs               |  6 +++---
 4 files changed, 31 insertions(+), 24 deletions(-)

diff --git a/src/Control/Lens/Grammar/Boole.hs b/src/Control/Lens/Grammar/Boole.hs
index c272fcd..5b6409d 100644
--- a/src/Control/Lens/Grammar/Boole.hs
+++ b/src/Control/Lens/Grammar/Boole.hs
@@ -42,34 +42,41 @@ class BooleanAlgebra b where
     :: (b ~ f bool, BooleanAlgebra bool, Functor f) => b -> b
   notB = fmap notB
 
-  -- | inclusion
-  fromBool :: Bool -> b
-  default fromBool
-    :: (b ~ f bool, BooleanAlgebra bool, Applicative f) => Bool -> b
-  fromBool = pure . fromBool
+  -- | true
+  trueB :: b
+  default trueB
+    :: (b ~ f bool, BooleanAlgebra bool, Applicative f) => b
+  trueB = pure trueB
+
+  -- | false
+  falseB :: b
+  default falseB
+    :: (b ~ f bool, BooleanAlgebra bool, Applicative f) => b
+  falseB = pure falseB
 
 -- | cumulative conjunction
 andB :: (Foldable f, BooleanAlgebra b) => f b -> b
-andB = foldl' (>&&<) (fromBool True)
+andB = foldl' (>&&<) trueB
 
 -- | cumulative disjunction
 orB :: (Foldable f, BooleanAlgebra b) => f b -> b
-orB = foldl' (>||<) (fromBool False)
+orB = foldl' (>||<) falseB
 
 -- | universal
 allB :: (Foldable f, BooleanAlgebra b) => (a -> b) -> f a -> b
-allB f = foldl' (\b a -> b >&&< f a) (fromBool True)
+allB f = foldl' (\b a -> b >&&< f a) trueB
 
 -- | existential
 anyB :: (Foldable f, BooleanAlgebra b) => (a -> b) -> f a -> b
-anyB f = foldl' (\b a -> b >||< f a) (fromBool False)
+anyB f = foldl' (\b a -> b >||< f a) falseB
 
 --instances
 instance BooleanAlgebra (x -> Bool)
 instance (Applicative f, BooleanAlgebra bool)
   => BooleanAlgebra (Ap f bool)
 instance BooleanAlgebra Bool where
-  fromBool = id
+  falseB = False
+  trueB = True
   notB = not
   (>&&<) = (&&)
   (>||<) = (||)
diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index 147a678..9c868f0 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -233,8 +233,8 @@ instance Categorized token => Tokenized token (RegExam token alg) where
   notAsIn cat = NotOneOf Set.empty (NotAsIn (Set.singleton cat))
 instance Categorized token
   => BooleanAlgebra (RegExam token (TokenClass token)) where
-  fromBool False = failExam
-  fromBool True = passExam
+  falseB = failExam
+  trueB = passExam
   notB exam | isFailExam exam = passExam
   notB exam | isPassExam exam = failExam
   notB (Alternate (TokenClass x) (TokenClass y)) = notB x >&&< notB y
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 681954b..8c34487 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -87,7 +87,7 @@ deriving stock instance
 
 -- | `Parsector` is parsed using `parsecP`.
 parsecP :: Categorized (Item s) => Parsector s a b -> s -> Reply s b
-parsecP p s = runParsector p id (Reply 0 (Left (fromBool False)) s)
+parsecP p s = runParsector p id (Reply 0 (Left falseB) s)
 
 -- | `Parsector` is printed using `unparsecP`.
 unparsecP :: Parsector s a b -> a -> s -> Reply s b
@@ -152,7 +152,7 @@ instance Categorized (Item s) => Monad (Parsector s a) where
 instance Categorized (Item s) => Alternative (Parsector s a) where
   -- | Always fail, consuming no input and expecting nothing.
   empty = Parsector $ \callback query ->
-    callback query { parsecResult = Left (fromBool False) }
+    callback query { parsecResult = Left falseB }
   p <|> q = Parsector $ \callback query ->
     -- Run p on the original input.
     flip (runParsector p) query $ \replyP -> callback $
@@ -187,7 +187,7 @@ instance Categorized (Item s) => MonadTry (Parsector s a) where
     flip (runParsector p) query $ \reply -> callback $
       case parsecResult reply of
         Right _ -> reply
-        Left _ -> query { parsecResult = Left (fromBool False) }
+        Left _ -> query { parsecResult = Left falseB }
 instance Categorized (Item s) => Filterable (Parsector s a) where
   mapMaybe = dimapMaybe Just
 instance Category (Parsector s) where
@@ -234,10 +234,10 @@ instance Categorized (Item s) => Alternator (Parsector s) where
       replyOk = query
         { parsecResult = do
             result <- parsecResult query
-            either Right (const (Left (fromBool False))) result
+            either Right (const (Left falseB)) result
         }
       replyErr = query
-        { parsecResult = Left (fromBool False) }
+        { parsecResult = Left falseB }
     in
       case (parsecResult query, parsecResult replyOk) of
         (Right _, Left _) -> replyErr
@@ -249,10 +249,10 @@ instance Categorized (Item s) => Alternator (Parsector s) where
       replyOk = query
         { parsecResult = do
             result <- parsecResult query
-            either (const (Left (fromBool False))) Right result
+            either (const (Left falseB)) Right result
         }
       replyErr = query
-        { parsecResult = Left (fromBool False) }
+        { parsecResult = Left falseB }
     in
       case (parsecResult query, parsecResult replyOk) of
         (Right _, Left _) -> replyErr
@@ -269,13 +269,13 @@ instance Categorized (Item s) => Filtrator (Parsector s) where
           callback reply
             { parsecResult = do
                 result <- parsecResult reply
-                either Right (const (Left (fromBool False))) result
+                either Right (const (Left falseB)) result
             }
     , Parsector $ \callback query ->
         flip (runParsector p) (Right <$> query) $ \reply ->
           callback reply
             { parsecResult = do
                 result <- parsecResult reply
-                either (const (Left (fromBool False))) Right result
+                either (const (Left falseB)) Right result
             }
     )
diff --git a/test/Examples/RegString.hs b/test/Examples/RegString.hs
index 1221a93..4d9f710 100644
--- a/test/Examples/RegString.hs
+++ b/test/Examples/RegString.hs
@@ -53,9 +53,9 @@ regexExamples =
   , (tokenClass (notB (notAsIn Control)), "\\p{Cc}")
   , (tokenClass (notB (notOneOf "abc" >&&< asIn LowercaseLetter)), "[abc]|\\P{Ll}")
 
-  -- fromBool operations
-  , (tokenClass (fromBool True), "[^]")
-  , (tokenClass (fromBool False), "[]")
+  -- trueB & falseB
+  , (tokenClass trueB, "[^]")
+  , (tokenClass falseB, "[]")
 
   -- Complex combinations
   , (tokenClass (notOneOf "abc" >&&< (asIn LowercaseLetter >||< asIn UppercaseLetter)), "[^abc\\p{Ll}]|\\p{Lu}")

From d396876fa9465fcfc16970110e5731204257db4a Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 7 Apr 2026 14:46:26 -0700
Subject: [PATCH 061/103] tests working

---
 src/Control/Lens/Grammar.hs              |   2 +-
 src/Control/Lens/PartialIso.hs           |  12 +-
 src/Data/Profunctor/Distributor.hs       |  39 ++----
 src/Data/Profunctor/Grammar.hs           |   5 +
 src/Data/Profunctor/Grammar/Parsector.hs | 156 ++++++++++++++---------
 src/Data/Profunctor/Monadic.hs           |  19 ++-
 test/Main.hs                             |   6 +-
 7 files changed, 137 insertions(+), 102 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index e7a16ce..106a16d 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -239,7 +239,7 @@ We can generate grammar strings, printers and parsers from @arithGrammar@.
 [Add (Add (Num 1) (Mul (Num 2) (Num 3))) (Num 4)]
 >>> unparseG arithGrammar (Add (Num 1) (Mul (Num 2) (Num 3))) "" :: Maybe String
 Just "1+2*3"
->>> do pr <- printG arithGrammar (Num 69); return (pr "") :: Maybe String
+>>> do pr <- printG arithGrammar (Num 69); pure (pr "") :: Maybe String
 Just "69"
 
 If all `rule`s are non-recursive, then a `Grammar`
diff --git a/src/Control/Lens/PartialIso.hs b/src/Control/Lens/PartialIso.hs
index 6e581ee..cace084 100644
--- a/src/Control/Lens/PartialIso.hs
+++ b/src/Control/Lens/PartialIso.hs
@@ -264,18 +264,18 @@ notNulled = partialIso nonEmp nonEmp where
   nonEmp s = if isn't _Empty s then Just s else Nothing
 
 {- | The either-of-tuples representation of `Maybe`. -}
-eotMaybe :: Iso (Maybe a) (Maybe b) (Either () a) (Either () b)
+eotMaybe :: Iso (Maybe a) (Maybe b) (Either a ()) (Either b ())
 eotMaybe = iso
-  (maybe (Left ()) Right)
-  (either (pure Nothing) Just)
+  (maybe (Right ()) Left)
+  (either Just (const Nothing))
 
 {- | The either-of-tuples representation of list-like streams. -}
 eotList
   :: (Cons s s a a, AsEmpty t, Cons t t b b)
-  => Iso s t (Either () (a,s)) (Either () (b,t))
+  => Iso s t (Either (a,s) ()) (Either (b,t) ())
 eotList = iso
-  (maybe (Left ()) Right . uncons)
-  (either (const Empty) (review _Cons))
+  (maybe (Right ()) Left . uncons)
+  (either (review _Cons) (const Empty))
 
 {- | Iterate the application of a partial isomorphism,
 useful for constructing fold/unfold isomorphisms. -}
diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index dc4a8e3..f5431b6 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -15,7 +15,6 @@ module Data.Profunctor.Distributor
   , Alternator (..)
   , malternate
   , choice
-  , optionP
     -- * SepBy
   , SepBy (..)
   , sepBy
@@ -25,7 +24,6 @@ module Data.Profunctor.Distributor
   , chain
   , chain1
   , intercalateP
-  , ambulate
     -- * Homogeneous
   , Homogeneous (..)
   ) where
@@ -34,7 +32,6 @@ import Control.Applicative hiding (WrappedArrow)
 import Control.Applicative qualified as Ap (WrappedArrow)
 import Control.Arrow
 import Control.Lens hiding (chosen)
-import Control.Lens.Internal.Context
 import Control.Lens.Internal.Profunctor
 import Control.Lens.PartialIso
 import Control.Monad
@@ -121,11 +118,11 @@ class Monoidal p => Distributor p where
 
   {- | One or none. -}
   optionalP :: p a b -> p (Maybe a) (Maybe b)
-  optionalP p = eotMaybe >~ oneP >+< p
+  optionalP p = eotMaybe >~ p >+< oneP
 
   {- | Zero or more. -}
   manyP :: p a b -> p [a] [b]
-  manyP p = eotList >~ oneP >+< p >*< manyP p
+  manyP p = eotList >~ p >*< manyP p >+< oneP
 
 instance Distributor (->) where
   zeroP = id
@@ -308,9 +305,9 @@ instance Homogeneous Maybe where
 instance Homogeneous [] where
   homogeneously = manyP
 instance Homogeneous Vector where
-  homogeneously p = eotList >~ oneP >+< p >*< homogeneously p
+  homogeneously p = eotList >~ p >*< homogeneously p >+< oneP
 instance Homogeneous Seq where
-  homogeneously p = eotList >~ oneP >+< p >*< homogeneously p
+  homogeneously p = eotList >~ p >*< homogeneously p >+< oneP
 instance Homogeneous Complex where
   homogeneously p = dimap2 realPart imagPart (:+) p p
 instance Homogeneous Tree where
@@ -354,6 +351,10 @@ class (Choice p, Distributor p, forall x. Alternative (p x))
     someP :: p a b -> p [a] [b]
     someP x = x >:< manyP x
 
+    {- | Zero or one, with a default bidirectional element for the zero case. -}
+    optionP :: APrism a b () () -> p a b -> p a b
+    optionP def p = p <|> pureP def
+
 -- | `malternate` gives an equivalent to `alternate` when `Monadic`.
 --
 -- prop> alternate = malternate
@@ -370,14 +371,6 @@ malternate =
 choice :: (Foldable f, Alternative p) => f (p a) -> p a
 choice = foldl' (<|>) empty
 
--- | Return a default bidirectional element
--- or perform an `Alternative` action.
-optionP
-  :: Alternator p
-  => APrism a b () () -- ^ default bidirection element
-  -> p a b -> p a b
-optionP def p = pureP def <|> p
-
 instance (Alternator p, Applicative f)
   => Alternator (WrappedPafb f p) where
     alternate =
@@ -437,7 +430,7 @@ several
   :: (IsList s, IsList t, Distributor p)
   => SepBy (p () ()) -> p (Item s) (Item t) -> p s t
 several (SepBy beg end sep) p = iso toList fromList . eotList >~
-  beg >* (oneP >+< p >*< manyP (sep >* p)) *< end
+  beg >* (p >*< manyP (sep >* p) >+< oneP) *< end
 
 {- |
 prop> several1 noSep = someP
@@ -480,17 +473,3 @@ intercalateP n (SepBy beg end _) _ | n <= 0 =
   beg >* asEmpty *< end
 intercalateP n (SepBy beg end comma) p =
   beg >* p >:< replicateP (n-1) (comma >* p) *< end
-
-{- | Add a `SepBy` to `meander` using `ambulate`. -}
-ambulate
-  :: (Monoidal p, Choice p)
-  => ATraversal s t a b -> SepBy (p () ()) -> p a b -> p s t
-ambulate f (SepBy sep beg end) p = dimap (f sell) iextract $
-  beg >* ambulating (sepBy sep) {endBy = end} p
-  where
-    ambulating
-      :: (Monoidal q, Choice q)
-      => SepBy (q () ())
-      -> q u v -> q (Bazaar (->) u w x) (Bazaar (->) v w x)
-    ambulating (SepBy sep' _ end') q =
-      eotFunList >~ right' (q >*< sep' >* ambulating (sepBy sep') q *< end')
diff --git a/src/Data/Profunctor/Grammar.hs b/src/Data/Profunctor/Grammar.hs
index 051c892..95cd164 100644
--- a/src/Data/Profunctor/Grammar.hs
+++ b/src/Data/Profunctor/Grammar.hs
@@ -120,6 +120,9 @@ instance (Alternative m, Monad m) => Alternator (Parsor s m) where
       Nothing -> fmap (first' Right) (p Nothing s)
       Just (Right a) -> fmap (first' Right) (p (Just a) s)
       Just (Left _) -> empty
+  optionP def p = Parsor $ \ma s -> case ma of
+    Nothing -> runParsor (p <|> pureP def) ma s
+    Just _ -> runParsor (pureP def <|> p) ma s
 instance (Alternative m, Monad m) => Category (Parsor s m) where
   id = Parsor $ \ma s -> case ma of
     Nothing -> empty
@@ -216,6 +219,7 @@ instance Alternative f => Alternator (Printor s f) where
       either (fmap (first' Left) . p) (\_ -> empty)
     Right (Printor p) -> Printor $
       either (\_ -> empty) (fmap (first' Right) . p)
+  optionP def p = pureP def <|> p
 instance Filterable f => Filtrator (Printor s f) where
   filtrate (Printor p) =
     let
@@ -311,6 +315,7 @@ instance KleeneStarAlgebra k => Distributor (Grammor k) where
 instance KleeneStarAlgebra k => Alternator (Grammor k) where
   alternate = either coerce coerce
   someP (Grammor rex) = Grammor (plusK rex)
+  optionP _ (Grammor rex) = Grammor (optK rex)
 instance Tokenized token k => Tokenized token (Grammor k a b) where
   anyToken = Grammor anyToken
   token = Grammor . token
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 8c34487..989431e 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -41,12 +41,16 @@ import Witherable
 to parse with `parsecP` or print with `unparsecP`,
 yielding a `Reply`, with detailed errors and offset tracking.
 
-In print mode, `Parsector` yields the left-most
-success among alternatives, regardless of length.
-In parse mode, it yields the longest
-success among alternatives, biased to the left on ties.
-In either mode, it yields the longest
-failure among alternatives, with errors merged on ties.
+`(<|>)` uses left-biased ordered choice in both parse and print mode:
+if the left alternative succeeds it is committed to immediately,
+regardless of mode or how much input was consumed.
+On any failure the right alternative is always tried.
+Errors at the same offset are merged.
+
+`optionP` is mode-sensitive: in parse mode it tries @p@ first
+(greedy), falling back to the default; in print mode it tries
+the default first so that a value matching the default prism
+short-circuits without entering @p@.
 -}
 newtype Parsector s a b = Parsector
   { runParsector :: forall x. (Reply s b -> x) -> Reply s a -> x }
@@ -57,7 +61,8 @@ It's the fundamental building block of `Parsector`.
 data Reply s a = Reply
   { parsecOffset :: !Word
     -- ^ number of tokens either parsed or printed
-  , parsecResult :: Either (TokenClass (Item s)) a
+  , parsecExpect :: TokenClass (Item s)
+  , parsecResult :: Maybe a
     {- ^ As an input `parsecResult` represents either parse mode,
     or print mode with an input syntax value.
     As an output `parsecResult` represents either failure
@@ -87,11 +92,11 @@ deriving stock instance
 
 -- | `Parsector` is parsed using `parsecP`.
 parsecP :: Categorized (Item s) => Parsector s a b -> s -> Reply s b
-parsecP p s = runParsector p id (Reply 0 (Left falseB) s)
+parsecP p s = runParsector p id (Reply 0 falseB Nothing s)
 
 -- | `Parsector` is printed using `unparsecP`.
-unparsecP :: Parsector s a b -> a -> s -> Reply s b
-unparsecP p a s = runParsector p id (Reply 0 (Right a) s)
+unparsecP :: Categorized (Item s) => Parsector s a b -> a -> s -> Reply s b
+unparsecP p a s = runParsector p id (Reply 0 falseB (Just a) s)
 
 -- Parsector instances
 instance
@@ -113,19 +118,21 @@ instance
         stream = parsecStream query
         result = parsecResult query
         offset = parsecOffset query
-        replyOk tok str = Reply
+        replyOk tok str = query
           { parsecStream = str
           , parsecOffset = offset + 1
-          , parsecResult = Right tok
+          , parsecResult = Just tok
           }
         replyErr = query
-          { parsecResult = Left (tokenClass test) }
+          { parsecExpect = test
+          , parsecResult = Nothing
+          }
       in
         callback $ case result of
-          Right tok
+          Just tok
             | tokenClass test tok -> replyOk tok (snoc stream tok)
             | otherwise -> replyErr
-          Left _ -> case uncons stream of
+          Nothing -> case uncons stream of
             Just (tok, rest)
               | tokenClass test tok -> replyOk tok rest
               | otherwise -> replyErr
@@ -139,55 +146,50 @@ instance Functor (Parsector s a) where
   fmap = rmap
 instance Categorized (Item s) => Applicative (Parsector s a) where
   pure b = Parsector $ \callback query ->
-    callback query { parsecResult = Right b }
+    callback query { parsecResult = Just b }
   (<*>) = ap
 instance Categorized (Item s) => Monad (Parsector s a) where
   return = pure
   p >>= f = Parsector $ \callback query ->
     flip (runParsector p) query $ \reply ->
       case parsecResult reply of
-        Left expect -> callback reply {parsecResult = Left expect}
-        Right b -> runParsector (f b) callback reply
+        Nothing -> callback reply {parsecResult = Nothing}
+        Just b -> runParsector (f b) callback reply
           {parsecResult = parsecResult query}
 instance Categorized (Item s) => Alternative (Parsector s a) where
   -- | Always fail, consuming no input and expecting nothing.
   empty = Parsector $ \callback query ->
-    callback query { parsecResult = Left falseB }
-  p <|> q = Parsector $ \callback query ->
-    -- Run p on the original input.
-    flip (runParsector p) query $ \replyP -> callback $
-      case (parsecResult query, parsecResult replyP) of
-        -- In unparse mode the query already carries a value (Right _).
-        -- If p succeeded, commit immediately without running q.
-        (Right _, Right _) -> replyP
-        -- In parse mode (or when p failed), run q on the same input.
-        __________________ ->
-          flip (runParsector q) query $ \replyQ ->
-            case (parsecResult replyP, parsecResult replyQ) of
-              -- Only one branch succeeded: take it.
-              (Right _, Left _) -> replyP
-              (Left _, Right _) -> replyQ
-              -- Both succeeded: take the longest match.
-              (Right _, Right _) ->
-                if parsecOffset replyP >= parsecOffset replyQ
-                then replyP
-                else replyQ
-              -- Both failed: report the furthest failure,
-              -- merging expected tokens on a tie.
-              (Left expectP, Left expectQ) ->
-                case compare (parsecOffset replyP) (parsecOffset replyQ) of
-                  GT -> replyP
-                  EQ -> replyP { parsecResult = Left (expectP >||< expectQ) }
-                  LT -> replyQ
-instance Categorized (Item s) => MonadPlus (Parsector s a)
+    callback query { parsecResult = Nothing }
+  p <|> q = mplus (try p) q
+instance Categorized (Item s) => MonadPlus (Parsector s a) where
+  mplus p q = Parsector $ \callback query ->
+    let
+      offset0 = parsecOffset query
+    in
+      flip (runParsector p) query $ \replyP -> callback $
+        if parsecOffset replyP == offset0
+        then case parsecResult replyP of
+          Nothing ->
+            flip (runParsector q) query $ \replyQ ->
+              if parsecOffset replyQ == offset0
+              then replyQ
+                {parsecExpect = ((>||<) `on` parsecExpect) replyP replyQ}
+              else replyQ
+          Just _ -> replyP
+        else replyP
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
 instance Categorized (Item s) => MonadTry (Parsector s a) where
   try p = Parsector $ \callback query ->
     flip (runParsector p) query $ \reply -> callback $
-      case parsecResult reply of
-        Right _ -> reply
-        Left _ -> query { parsecResult = Left falseB }
+      if parsecOffset reply > 0
+      then case parsecResult reply of
+        Nothing -> query
+          { parsecExpect = parsecExpect reply
+          , parsecResult = Nothing
+          }
+        Just _ -> reply
+      else reply
 instance Categorized (Item s) => Filterable (Parsector s a) where
   mapMaybe = dimapMaybe Just
 instance Category (Parsector s) where
@@ -227,20 +229,54 @@ instance Strong (Parsector s) where
 instance Categorized (Item s) => Choice (Parsector s) where
   left' = alternate . Left
   right' = alternate . Right
-instance Categorized (Item s) => Distributor (Parsector s)
+instance Categorized (Item s) => Distributor (Parsector s) where
+  manyP p = Parsector $ \callback query ->
+    case parsecResult query of
+      Nothing ->
+        let
+          queryP = Reply
+            { parsecOffset = parsecOffset query
+            , parsecExpect = parsecExpect query
+            , parsecResult = Nothing
+            , parsecStream = parsecStream query
+            }
+        in
+          flip (runParsector (try p)) queryP $ \replyP ->
+            case parsecResult replyP of
+              Nothing ->
+                callback Reply
+                  { parsecOffset = parsecOffset query
+                  , parsecExpect = parsecExpect query
+                  , parsecResult = Just []
+                  , parsecStream = parsecStream query
+                  }
+              Just a ->
+                let
+                  queryM = Reply
+                    { parsecOffset = parsecOffset replyP
+                    , parsecExpect = parsecExpect replyP
+                    , parsecResult = Nothing
+                    , parsecStream = parsecStream replyP
+                    }
+                in
+                  flip (runParsector (manyP p)) queryM $
+                    \replyM -> callback replyM
+                      {parsecResult = (a:) <$> parsecResult replyM}
+      Just _ ->
+        runParsector (eotList >~ p >*< manyP p >+< oneP) callback query
 instance Categorized (Item s) => Alternator (Parsector s) where
   alternate (Left p) = Parsector $ \callback query -> callback $
     let
       replyOk = query
         { parsecResult = do
             result <- parsecResult query
-            either Right (const (Left falseB)) result
+            either Just (const Nothing) result
         }
       replyErr = query
-        { parsecResult = Left falseB }
+        { parsecResult = Nothing }
     in
       case (parsecResult query, parsecResult replyOk) of
-        (Right _, Left _) -> replyErr
+        (Just _, Nothing) -> replyErr
         _________________ ->
           flip (runParsector p) replyOk $ \reply -> reply
             { parsecResult = Left <$> parsecResult reply }
@@ -249,16 +285,20 @@ instance Categorized (Item s) => Alternator (Parsector s) where
       replyOk = query
         { parsecResult = do
             result <- parsecResult query
-            either (const (Left falseB)) Right result
+            either (const Nothing) Just result
         }
       replyErr = query
-        { parsecResult = Left falseB }
+        { parsecResult = Nothing }
     in
       case (parsecResult query, parsecResult replyOk) of
-        (Right _, Left _) -> replyErr
+        (Just _, Nothing) -> replyErr
         _________________ ->
           flip (runParsector p) replyOk $ \reply -> reply
             { parsecResult = Right <$> parsecResult reply }
+  optionP def p = Parsector $ \callback query ->
+    case parsecResult query of
+      Nothing -> runParsector (p <|> pureP def) callback query
+      Just _ -> runParsector (pureP def <|> p) callback query
 instance Categorized (Item s) => Cochoice (Parsector s) where
   unleft = fst . filtrate
   unright = snd . filtrate
@@ -269,13 +309,13 @@ instance Categorized (Item s) => Filtrator (Parsector s) where
           callback reply
             { parsecResult = do
                 result <- parsecResult reply
-                either Right (const (Left falseB)) result
+                either Just (const Nothing) result
             }
     , Parsector $ \callback query ->
         flip (runParsector p) (Right <$> query) $ \reply ->
           callback reply
             { parsecResult = do
                 result <- parsecResult reply
-                either (const (Left falseB)) Right result
+                either (const Nothing) Just result
             }
     )
diff --git a/src/Data/Profunctor/Monadic.hs b/src/Data/Profunctor/Monadic.hs
index 2b5af00..1fdea85 100644
--- a/src/Data/Profunctor/Monadic.hs
+++ b/src/Data/Profunctor/Monadic.hs
@@ -33,15 +33,16 @@ module Data.Profunctor.Monadic
   , MonadPlus (..)
   ) where
 
-import Control.Monad hiding ((>>=), (>>))
-import Data.Profunctor
-import Prelude hiding ((>>=), (>>))
+import Control.Lens
+import Control.Monad hiding ((>>=), (>>), return)
+import Data.Profunctor.Monoidal
+import Prelude hiding ((>>=), (>>), return)
 
 {- | A `Profunctor` which is also a `Monad`. -}
 type Monadic p = (Profunctor p, forall x. Monad (p x))
 
 {- | The pair bonding operator @P.@`>>=` is a context-sensitive
-version of `Data.Profunctor.Monoidal.>*<`.
+version of `>*<`.
 
 prop> x >*< y = x P.>>= (\_ -> y)
 -}
@@ -50,13 +51,21 @@ infixl 1 >>=
 p >>= f = do
   b <- lmap fst p
   d <- lmap snd (f b)
-  return (b,d)
+  pure (b,d)
 
 {- | @P.@`>>` sequences actions. -}
 (>>) :: Monadic p => p () c -> p a b -> p a b
 infixl 1 >>
 x >> y = do _ <- lmap (const ()) x; y
 
+{- | @P.@`return` is a `Monadic`-restricted
+version of `pureP`.
+
+prop> pureP = P.return
+-}
+return :: (Monadic p, Choice p) => Prism a b () () -> p a b
+return = pureP
+
 {- | A `Profunctor` which is also a `MonadTry`. -}
 type MonadicTry p = (Profunctor p, forall x. MonadTry (p x))
 
diff --git a/test/Main.hs b/test/Main.hs
index 3dcb560..3f5f8e3 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -3,6 +3,7 @@ module Main (main) where
 import Data.Foldable hiding (toList)
 import Control.Lens.Grammar
 import Control.Lens.Grammar.BackusNaur
+import Control.Lens.Grammar.Boole
 import Data.List (genericLength)
 import Data.Profunctor.Grammar.Parsector
 import Test.DocTest
@@ -102,10 +103,11 @@ testCtxGrammarExample grammar (expectedSyntax, expectedString) = do
   it ("should parsecG from " <> expectedString <> " correctly") $ do
     let actualSyntax = parsecG grammar expectedString
     let expectedLength = genericLength expectedString
+    let actualExpect = parsecExpect actualSyntax
     actualSyntax `shouldBe`
-      (Reply expectedLength (Right expectedSyntax) "")
+      (Reply expectedLength actualExpect (Just expectedSyntax) "")
   it ("should unparsecG to " <> expectedString <> " correctly") $ do
     let actualString = unparsecG grammar expectedSyntax ""
     let expectedLength = genericLength expectedString
     actualString `shouldBe`
-      (Reply expectedLength (Right expectedSyntax) expectedString)
+      (Reply expectedLength falseB (Just expectedSyntax) expectedString)

From c53d8599cd59bd3ffaa1290c9d6ff663b7bd8558 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 7 Apr 2026 15:37:08 -0700
Subject: [PATCH 062/103] Epsilon ~> SeqEmpty

---
 src/Control/Lens/Grammar.hs            |  2 +-
 src/Control/Lens/Grammar/BackusNaur.hs |  4 ++--
 src/Control/Lens/Grammar/Kleene.hs     | 28 +++++++++++++-------------
 3 files changed, 17 insertions(+), 17 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index e180957..1aac0bf 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -540,7 +540,7 @@ regexGrammar = _RegString >~ ruleRec "regex" altG
       chain1 Left (_RegExam . _Alternate) (sepBy (terminal "|")) (seqG rex)
 
     seqG rex = rule "sequence" $
-      chain Left _Sequence _Epsilon noSep (exprG rex)
+      chain Left _Sequence _SeqEmpty noSep (exprG rex)
 
     exprG rex = rule "expression" $ choice
       [ _KleeneOpt >? atomG rex *< terminal "?"
diff --git a/src/Control/Lens/Grammar/BackusNaur.hs b/src/Control/Lens/Grammar/BackusNaur.hs
index b3c7d5d..0816704 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -96,7 +96,7 @@ diffB prefix (Bnf start rules) =
   where
     -- derivative wrt 1 token, memoized
     diff1B = memo2 $ \x -> \case
-      Epsilon -> zeroK
+      SeqEmpty -> zeroK
       NonTerminal nameY -> anyK (diff1B x) (rulesNamed nameY rules)
       Sequence y1 y2 ->
         if δ (Bnf y1 rules) then y1'y2 >|< y1y2' else y1'y2
@@ -121,7 +121,7 @@ diffB prefix (Bnf start rules) =
   => Bnf (RegEx token) -> Bool
 δ (Bnf start rules) = ν start where
   ν = memo $ \case
-    Epsilon -> True
+    SeqEmpty -> True
     KleeneStar _ -> True
     KleeneOpt _ -> True
     KleenePlus y -> ν y
diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index 9837f43..d96b307 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -74,9 +74,9 @@ anyK f = foldl' (\b a -> b >|< f a) zeroK
 
 -- | The `RegEx`pression type is the prototypical `KleeneStarAlgebra`.
 data RegEx token
-  = Epsilon
-  | NonTerminal String
+  = SeqEmpty
   | Sequence (RegEx token) (RegEx token)
+  | NonTerminal String
   | KleeneStar (RegEx token)
   | KleeneOpt (RegEx token)
   | KleenePlus (RegEx token)
@@ -180,10 +180,10 @@ instance Categorized token => TokenAlgebra token (RegEx token) where
     Alternate exam1 exam2 ->
       RegExam (Alternate (tokenClass exam1) (tokenClass exam2))
 instance Categorized token => Monoid (RegEx token) where
-  mempty = Epsilon
+  mempty = SeqEmpty
 instance Categorized token => Semigroup (RegEx token) where
-  Epsilon <> rex = rex
-  rex <> Epsilon = rex
+  SeqEmpty <> rex = rex
+  rex <> SeqEmpty = rex
   RegExam exam <> _ | isFailExam exam = zeroK
   _ <> RegExam exam | isFailExam exam = zeroK
   KleeneStar rex0 <> rex1 | rex0 == rex1 = plusK rex0
@@ -192,19 +192,19 @@ instance Categorized token => Semigroup (RegEx token) where
 instance Categorized token => KleeneStarAlgebra (RegEx token) where
   zeroK = RegExam failExam
   optK (RegExam exam) | isFailExam exam = mempty
-  optK Epsilon = mempty
+  optK SeqEmpty = mempty
   optK (KleenePlus rex) = starK rex
   optK rex = KleeneOpt rex
   starK (RegExam exam) | isFailExam exam = mempty
-  starK Epsilon = mempty
+  starK SeqEmpty = mempty
   starK rex = KleeneStar rex
   plusK (RegExam exam) | isFailExam exam = zeroK
-  plusK Epsilon = mempty
+  plusK SeqEmpty = mempty
   plusK rex = KleenePlus rex
-  KleenePlus rex >|< Epsilon = starK rex
-  Epsilon >|< KleenePlus rex = starK rex
-  rex >|< Epsilon = optK rex
-  Epsilon >|< rex = optK rex
+  KleenePlus rex >|< SeqEmpty = starK rex
+  SeqEmpty >|< KleenePlus rex = starK rex
+  rex >|< SeqEmpty = optK rex
+  SeqEmpty >|< rex = optK rex
   rex >|< RegExam exam | isFailExam exam = rex
   RegExam exam >|< rex | isFailExam exam = rex
   rex0 >|< rex1 | Just tokenOr <- maybeOr = tokenClass tokenOr
@@ -335,7 +335,7 @@ instance (Categorized token, HasTrie token)
       , notOneOfTrie = trie (f . testNotOneOf)
       }
     untrie rex = \case
-      Epsilon -> epsilonTrie rex
+      SeqEmpty -> epsilonTrie rex
       NonTerminal name -> untrie (nonTerminalTrie rex) name
       Sequence x1 x2 -> untrie (sequenceTrie rex) (x1,x2)
       KleeneStar x -> untrie (kleeneStarTrie rex) x
@@ -349,7 +349,7 @@ instance (Categorized token, HasTrie token)
           (Set.toList chars, Right (Set.toList (Set.map fromEnum cats)))
       RegExam (Alternate x1 x2) -> untrie (alternateTrie rex) (x1,x2)
     enumerate rex = mconcat
-      [ [(Epsilon, epsilonTrie rex)]
+      [ [(SeqEmpty, epsilonTrie rex)]
       , first' NonTerminal <$> enumerate (nonTerminalTrie rex)
       , first' (uncurry Sequence) <$> enumerate (sequenceTrie rex)
       , first' (RegExam . uncurry Alternate) <$> enumerate (alternateTrie rex)

From 27089fe531536bbd5a3720cd6910a17fa33b1e6f Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 7 Apr 2026 15:57:03 -0700
Subject: [PATCH 063/103] Control.Monad.Fail.Try

---
 distributors.cabal                       |  1 +
 src/Control/Monad/Fail/Try.hs            | 41 ++++++++++++++++++++++++
 src/Data/Profunctor/Grammar.hs           |  2 +-
 src/Data/Profunctor/Grammar/Parsector.hs |  2 +-
 src/Data/Profunctor/Monadic.hs           | 10 +-----
 5 files changed, 45 insertions(+), 11 deletions(-)
 create mode 100644 src/Control/Monad/Fail/Try.hs

diff --git a/distributors.cabal b/distributors.cabal
index b71e24b..aa89a40 100644
--- a/distributors.cabal
+++ b/distributors.cabal
@@ -41,6 +41,7 @@ library
       Control.Lens.Monocle
       Control.Lens.PartialIso
       Control.Lens.Wither
+      Control.Monad.Fail.Try
       Data.Profunctor.Distributor
       Data.Profunctor.Filtrator
       Data.Profunctor.Grammar
diff --git a/src/Control/Monad/Fail/Try.hs b/src/Control/Monad/Fail/Try.hs
new file mode 100644
index 0000000..ec04774
--- /dev/null
+++ b/src/Control/Monad/Fail/Try.hs
@@ -0,0 +1,41 @@
+{-|
+Module      : Control.Monad.Fail.Try
+Description : monads with fail and try semantics
+Copyright   : (C) 2026 - Eitan Chatav
+License     : BSD-style (see the file LICENSE)
+Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
+Stability   : provisional
+Portability : non-portable
+-}
+
+module Control.Monad.Fail.Try
+  ( MonadTry (..)
+  , MonadFail (..)
+  , MonadPlus (..)
+  ) where
+
+import Control.Monad
+
+{- | `MonadTry`.
+
+A `MonadTry` implements `fail` & `try` and
+two alternation combinators; `<|>` & `mplus`.
+
+The following invariants should hold.
+
+prop> empty = mzero
+prop> x <|> y = try x `mplus` y
+
+prop> fail msg <|> x = x = x <|> fail msg
+
+When a `MonadTry` is also a
+`Control.Lens.Grammar.BackusNaur.BackusNaurForm`,
+then the following invariant should hold.
+
+prop> fail msg = rule msg empty
+
+-}
+class (MonadFail m, MonadPlus m) => MonadTry m where
+  try :: m a -> m a
+  default try :: m a -> m a
+  try = id
diff --git a/src/Data/Profunctor/Grammar.hs b/src/Data/Profunctor/Grammar.hs
index 95cd164..7949848 100644
--- a/src/Data/Profunctor/Grammar.hs
+++ b/src/Data/Profunctor/Grammar.hs
@@ -30,13 +30,13 @@ import Control.Lens.Grammar.Kleene
 import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
 import Control.Monad
+import Control.Monad.Fail.Try
 import Data.Coerce
 import Data.Monoid
 import Data.Profunctor
 import Data.Profunctor.Distributor
 import Data.Profunctor.Filtrator
 import Data.Profunctor.Monoidal
-import Data.Profunctor.Monadic (MonadTry (..))
 import Data.Void
 import Prelude hiding (id, (.))
 import GHC.Exts
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 989431e..776ca60 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -28,10 +28,10 @@ import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
 import Control.Lens.PartialIso
 import Control.Monad
+import Control.Monad.Fail.Try
 import Data.Profunctor
 import Data.Profunctor.Distributor
 import Data.Profunctor.Filtrator
-import Data.Profunctor.Monadic (MonadTry (..))
 import Data.Profunctor.Monoidal
 import GHC.Exts
 import Prelude hiding (id, (.))
diff --git a/src/Data/Profunctor/Monadic.hs b/src/Data/Profunctor/Monadic.hs
index 1fdea85..d1a7e95 100644
--- a/src/Data/Profunctor/Monadic.hs
+++ b/src/Data/Profunctor/Monadic.hs
@@ -28,13 +28,11 @@ module Data.Profunctor.Monadic
   , return
     -- * MonadicTry
   , MonadicTry
-  , MonadTry (..)
-  , MonadFail (..)
-  , MonadPlus (..)
   ) where
 
 import Control.Lens
 import Control.Monad hiding ((>>=), (>>), return)
+import Control.Monad.Fail.Try
 import Data.Profunctor.Monoidal
 import Prelude hiding ((>>=), (>>), return)
 
@@ -68,9 +66,3 @@ return = pureP
 
 {- | A `Profunctor` which is also a `MonadTry`. -}
 type MonadicTry p = (Profunctor p, forall x. MonadTry (p x))
-
-{- | `MonadTry`. -}
-class (MonadFail m, MonadPlus m) => MonadTry m where
-  try :: m a -> m a
-  default try :: m a -> m a
-  try = id

From 8bea5db7ac5a14892c1f09a16783160eb5b6f9e8 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 7 Apr 2026 16:20:07 -0700
Subject: [PATCH 064/103] separate out modules for

Data.Profunctor.Separator
Data.Traversable.Homogeneous
---
 distributors.cabal                  |   2 +
 src/Control/Lens/Bifocal.hs         |   1 +
 src/Control/Lens/Diopter.hs         |   1 +
 src/Control/Lens/Grammar.hs         |   1 +
 src/Data/Profunctor/Distributor.hs  | 207 ----------------------------
 src/Data/Profunctor/Separator.hs    | 104 ++++++++++++++
 src/Data/Traversable/Homogeneous.hs | 140 +++++++++++++++++++
 test/Examples/Arithmetic.hs         |   1 +
 test/Examples/Chain.hs              |   2 +-
 test/Examples/Json.hs               |   1 +
 test/Examples/Lambda.hs             |   1 +
 test/Examples/LenVec.hs             |   1 +
 test/Examples/SExpr.hs              |   1 +
 test/Examples/SemVer.hs             |   1 +
 14 files changed, 256 insertions(+), 208 deletions(-)
 create mode 100644 src/Data/Profunctor/Separator.hs
 create mode 100644 src/Data/Traversable/Homogeneous.hs

diff --git a/distributors.cabal b/distributors.cabal
index aa89a40..773cdc8 100644
--- a/distributors.cabal
+++ b/distributors.cabal
@@ -48,6 +48,8 @@ library
       Data.Profunctor.Grammar.Parsector
       Data.Profunctor.Monadic
       Data.Profunctor.Monoidal
+      Data.Profunctor.Separator
+      Data.Traversable.Homogeneous
   other-modules:
       Paths_distributors
   autogen-modules:
diff --git a/src/Control/Lens/Bifocal.hs b/src/Control/Lens/Bifocal.hs
index 6a09aaf..2bf5e5e 100644
--- a/src/Control/Lens/Bifocal.hs
+++ b/src/Control/Lens/Bifocal.hs
@@ -39,6 +39,7 @@ import Control.Lens.PartialIso
 import Data.Profunctor
 import Data.Profunctor.Distributor
 import Data.Profunctor.Filtrator
+import Data.Profunctor.Separator
 import Witherable
 
 {- | `Bifocal`s are bidirectional parser optics.
diff --git a/src/Control/Lens/Diopter.hs b/src/Control/Lens/Diopter.hs
index e94584c..231209f 100644
--- a/src/Control/Lens/Diopter.hs
+++ b/src/Control/Lens/Diopter.hs
@@ -27,6 +27,7 @@ module Control.Lens.Diopter
 import Control.Lens
 import Control.Lens.Internal.Profunctor
 import Data.Profunctor.Distributor
+import Data.Traversable.Homogeneous
 import Data.Void
 import GHC.Generics
 
diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 8b904c9..8ac97e9 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -50,6 +50,7 @@ import Data.Profunctor.Monadic
 import Data.Profunctor.Monoidal
 import Data.Profunctor.Grammar
 import Data.Profunctor.Grammar.Parsector
+import Data.Profunctor.Separator
 import Data.String
 import GHC.Exts
 import Prelude hiding (filter)
diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index f5431b6..c6cc23a 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -15,17 +15,6 @@ module Data.Profunctor.Distributor
   , Alternator (..)
   , malternate
   , choice
-    -- * SepBy
-  , SepBy (..)
-  , sepBy
-  , noSep
-  , several
-  , several1
-  , chain
-  , chain1
-  , intercalateP
-    -- * Homogeneous
-  , Homogeneous (..)
   ) where
 
 import Control.Applicative hiding (WrappedArrow)
@@ -38,14 +27,9 @@ import Control.Monad
 import Data.Bifunctor.Clown
 import Data.Bifunctor.Joker
 import Data.Bifunctor.Product
-import Data.Complex
 import Data.Foldable hiding (toList)
 import Data.Functor.Adjunction
-import Data.Functor.Compose
 import Data.Functor.Contravariant.Divisible
-import qualified Data.Functor.Product as Functor
-import qualified Data.Functor.Sum as Functor
-import qualified Data.Monoid as Monoid
 import Data.Profunctor hiding (WrappedArrow)
 import Data.Profunctor qualified as Pro (WrappedArrow)
 import Data.Profunctor.Cayley
@@ -54,14 +38,7 @@ import Data.Profunctor.Monad
 import Data.Profunctor.Monadic
 import Data.Profunctor.Monoidal
 import Data.Profunctor.Yoneda
-import Data.Proxy
-import Data.Sequence (Seq)
-import Data.Tagged
-import Data.Tree (Tree (..))
-import Data.Vector (Vector)
 import Data.Void
-import GHC.Exts
-import GHC.Generics
 
 -- Distributor --
 
@@ -205,114 +182,6 @@ dialt
   -> p a b -> p c d -> p s t
 dialt f g h p q = dimap f (either g h) (p >+< q)
 
-{- | A class of `Homogeneous`
-countable sums of countable products.
--}
-class Traversable t => Homogeneous t where
-  {- | Sequences actions `homogeneously`.
-
-  prop> homogeneously @Maybe = optionalP
-  prop> homogeneously @[] = manyP
-
-  Any `Traversable` & `Data.Distributive.Distributive` countable product
-  can be given a default implementation for the `homogeneously` method.
-
-  prop> homogeneously = ditraverse
-
-  And any user-defined homogeneous algebraic datatype has
-  a default instance for `Homogeneous`, by deriving `Generic1`.
-  -}
-  homogeneously :: Distributor p => p a b -> p (t a) (t b)
-  default homogeneously
-    :: (Generic1 t, Homogeneous (Rep1 t), Distributor p)
-    => p a b -> p (t a) (t b)
-  homogeneously = dimap from1 to1 . homogeneously
-instance Homogeneous Par1 where
-  homogeneously = dimap unPar1 Par1
-instance Homogeneous Identity where
-  homogeneously = dimap runIdentity Identity
-instance Homogeneous Monoid.Dual where
-  homogeneously = dimap Monoid.getDual Monoid.Dual
-instance Homogeneous Monoid.Product where
-  homogeneously = dimap Monoid.getProduct Monoid.Product
-instance Homogeneous Monoid.Sum where
-  homogeneously = dimap Monoid.getSum Monoid.Sum
-instance Homogeneous (Tagged s) where
-  homogeneously = dimap unTagged Tagged
-instance Homogeneous U1 where
-  homogeneously _ = pure U1
-instance Homogeneous (K1 i ()) where
-  homogeneously _ = pure (K1 ())
-instance Homogeneous (Const ()) where
-  homogeneously _ = pure (Const ())
-instance Homogeneous Proxy where
-  homogeneously _ = pure Proxy
-instance (Homogeneous s, Homogeneous t)
-  => Homogeneous (s :.: t) where
-    homogeneously
-      = dimap unComp1 Comp1
-      . homogeneously . homogeneously
-instance (Homogeneous s, Homogeneous t)
-  => Homogeneous (Compose s t) where
-    homogeneously
-      = dimap getCompose Compose
-      . homogeneously . homogeneously
-instance (Homogeneous s, Homogeneous t)
-  => Homogeneous (s :*: t) where
-    homogeneously p = dimap2
-      (\(s :*: _) -> s)
-      (\(_ :*: t) -> t)
-      (:*:)
-      (homogeneously p)
-      (homogeneously p)
-instance (Homogeneous s, Homogeneous t)
-  => Homogeneous (Functor.Product s t) where
-    homogeneously p = dimap2
-      (\(Functor.Pair s _) -> s)
-      (\(Functor.Pair _ t) -> t)
-      Functor.Pair
-      (homogeneously p)
-      (homogeneously p)
-instance Homogeneous V1 where
-  homogeneously _ = dimap (\case) (\case) zeroP
-instance Homogeneous (K1 i Void) where
-  homogeneously _ = dimap unK1 K1 zeroP
-instance Homogeneous (Const Void) where
-  homogeneously _ = dimap getConst Const zeroP
-instance (Homogeneous s, Homogeneous t)
-  => Homogeneous (s :+: t) where
-    homogeneously p = dialt
-      (\case {L1 s -> Left s; R1 t -> Right t})
-      L1
-      R1
-      (homogeneously p)
-      (homogeneously p)
-instance (Homogeneous s, Homogeneous t)
-  => Homogeneous (Functor.Sum s t) where
-    homogeneously p = dialt
-      (\case {Functor.InL s -> Left s; Functor.InR t -> Right t})
-      Functor.InL
-      Functor.InR
-      (homogeneously p)
-      (homogeneously p)
-instance Homogeneous t
-  => Homogeneous (M1 i c t) where
-    homogeneously = dimap unM1 M1 . homogeneously
-instance Homogeneous f => Homogeneous (Rec1 f) where
-  homogeneously = dimap unRec1 Rec1 . homogeneously
-instance Homogeneous Maybe where
-  homogeneously = optionalP
-instance Homogeneous [] where
-  homogeneously = manyP
-instance Homogeneous Vector where
-  homogeneously p = eotList >~ p >*< homogeneously p >+< oneP
-instance Homogeneous Seq where
-  homogeneously p = eotList >~ p >*< homogeneously p >+< oneP
-instance Homogeneous Complex where
-  homogeneously p = dimap2 realPart imagPart (:+) p p
-instance Homogeneous Tree where
-  homogeneously p = dimap2 rootLabel subForest Node p (manyP (homogeneously p))
-
 -- Alternator --
 
 {- | The `Alternator` class co-extends `Choice` and `Distributor`,
@@ -397,79 +266,3 @@ instance Alternator p => Alternator (Yoneda p) where
   alternate (Left p) = proreturn (alternate (Left (proextract p)))
   alternate (Right p) = proreturn (alternate (Right (proextract p)))
   someP = proreturn . someP . proextract
-
-{- | Used to sequence multiple times,
-separated by a `separateBy`,
-begun by a `beginBy`,
-and ended by an `endBy`. -}
-data SepBy p = SepBy
-  { beginBy :: p
-  , endBy :: p
-  , separateBy :: p
-  } deriving stock
-    ( Functor, Foldable, Traversable
-    , Eq, Ord, Show, Read
-    )
-
-{- | A `SepBy` smart constructor,
-setting the `separateBy` field,
-with no beginning or ending delimitors,
-except by updating `beginBy` or `endBy` fields. -}
-sepBy :: Monoidal p => p () () -> SepBy (p () ())
-sepBy = SepBy oneP oneP
-
-{- | A `SepBy` smart constructor for no separator,
-beginning or ending delimiters. -}
-noSep :: Monoidal p => SepBy (p () ())
-noSep = sepBy oneP
-
-{- |
-prop> several noSep = manyP
--}
-several
-  :: (IsList s, IsList t, Distributor p)
-  => SepBy (p () ()) -> p (Item s) (Item t) -> p s t
-several (SepBy beg end sep) p = iso toList fromList . eotList >~
-  beg >* (p >*< manyP (sep >* p) >+< oneP) *< end
-
-{- |
-prop> several1 noSep = someP
--}
-several1
-  :: (IsList s, IsList t, Distributor p, Choice p)
-  => SepBy (p () ()) -> p (Item s) (Item t) -> p s t
-several1 (SepBy beg end sep) p = iso toList fromList . _Cons >?
-  beg >* (p >*< manyP (sep >* p)) *< end
-
-{- | Use a nilary constructor pattern to sequence zero times, or
-associate a binary constructor pattern to sequence one or more times. -}
-chain
-  :: Alternator p
-  => (forall x. x -> Either x x) -- ^ `Left` or `Right` associate
-  -> APartialIso a b (a,a) (b,b) -- ^ binary constructor pattern
-  -> APrism a b () () -- ^ nilary constructor pattern
-  -> SepBy (p () ()) -> p a b -> p a b
-chain association pat2 pat0 (SepBy beg end sep) p =
-  beg >* optionP pat0 (chain1 association pat2 (sepBy sep) p) *< end
-
-{- | Associate a binary constructor pattern to sequence one or more times. -}
-chain1
-  :: (Distributor p, Choice p)
-  => (forall x. x -> Either x x) -- ^ `Left` or `Right` associate
-  -> APartialIso a b (a,a) (b,b) -- ^ binary constructor pattern
-  -> SepBy (p () ()) -> p a b -> p a b
-chain1 association pat (SepBy beg end sep) = leftOrRight chainl1 chainr1
-  where
-    leftOrRight a b = case association () of Left _ -> a; Right _ -> b
-    chainl1 p = difoldl pat >? beg >* p >*< manyP (sep >* p) *< end
-    chainr1 p = difoldr pat >? beg >* manyP (p *< sep) >*< p *< end
-
-{- | Add a `SepBy` to `replicateP` using `intercalateP`. -}
-intercalateP
-  :: (Monoidal p, Choice p, AsEmpty s, Cons s s a a)
-  => Int {- ^ number of repetitions -}
-  -> SepBy (p () ()) -> p a a -> p s s
-intercalateP n (SepBy beg end _) _ | n <= 0 =
-  beg >* asEmpty *< end
-intercalateP n (SepBy beg end comma) p =
-  beg >* p >:< replicateP (n-1) (comma >* p) *< end
diff --git a/src/Data/Profunctor/Separator.hs b/src/Data/Profunctor/Separator.hs
new file mode 100644
index 0000000..dd0524d
--- /dev/null
+++ b/src/Data/Profunctor/Separator.hs
@@ -0,0 +1,104 @@
+{-|
+Module      : Data.Profunctor.Separator
+Description : distributors
+Copyright   : (C) 2026 - Eitan Chatav
+License     : BSD-style (see the file LICENSE)
+Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
+Stability   : provisional
+Portability : non-portable
+-}
+
+module Data.Profunctor.Separator
+  ( SepBy (..)
+  , sepBy
+  , noSep
+  , several
+  , several1
+  , chain
+  , chain1
+  , intercalateP
+  ) where
+
+import Control.Lens
+import Control.Lens.PartialIso
+import Data.Profunctor.Distributor
+import Data.Profunctor.Monoidal
+import GHC.Exts
+
+{- | Used to sequence multiple times,
+separated by a `separateBy`,
+begun by a `beginBy`,
+and ended by an `endBy`. -}
+data SepBy p = SepBy
+  { beginBy :: p
+  , endBy :: p
+  , separateBy :: p
+  } deriving stock
+    ( Functor, Foldable, Traversable
+    , Eq, Ord, Show, Read
+    )
+
+{- | A `SepBy` smart constructor,
+setting the `separateBy` field,
+with no beginning or ending delimitors,
+except by updating `beginBy` or `endBy` fields. -}
+sepBy :: Applicative p => p () -> SepBy (p ())
+sepBy = SepBy (pure ()) (pure ())
+
+-- sepWith :: (Monoidal p, TerminalSymbol c (p () ())) => 
+
+{- | A `SepBy` smart constructor for no separator,
+beginning or ending delimiters. -}
+noSep :: Monoidal p => SepBy (p () ())
+noSep = sepBy oneP
+
+{- |
+prop> several noSep = manyP
+-}
+several
+  :: (IsList s, IsList t, Distributor p)
+  => SepBy (p () ()) -> p (Item s) (Item t) -> p s t
+several (SepBy beg end sep) p = iso toList fromList . eotList >~
+  beg >* (p >*< manyP (sep >* p) >+< oneP) *< end
+
+{- |
+prop> several1 noSep = someP
+-}
+several1
+  :: (IsList s, IsList t, Distributor p, Choice p)
+  => SepBy (p () ()) -> p (Item s) (Item t) -> p s t
+several1 (SepBy beg end sep) p = iso toList fromList . _Cons >?
+  beg >* (p >*< manyP (sep >* p)) *< end
+
+{- | Use a nilary constructor pattern to sequence zero times, or
+associate a binary constructor pattern to sequence one or more times. -}
+chain
+  :: Alternator p
+  => (forall x. x -> Either x x) -- ^ `Left` or `Right` associate
+  -> APartialIso a b (a,a) (b,b) -- ^ binary constructor pattern
+  -> APrism a b () () -- ^ nilary constructor pattern
+  -> SepBy (p () ()) -> p a b -> p a b
+chain association pat2 pat0 (SepBy beg end sep) p =
+  beg >* optionP pat0 (chain1 association pat2 (sepBy sep) p) *< end
+
+{- | Associate a binary constructor pattern to sequence one or more times. -}
+chain1
+  :: (Distributor p, Choice p)
+  => (forall x. x -> Either x x) -- ^ `Left` or `Right` associate
+  -> APartialIso a b (a,a) (b,b) -- ^ binary constructor pattern
+  -> SepBy (p () ()) -> p a b -> p a b
+chain1 association pat (SepBy beg end sep) = leftOrRight chainl1 chainr1
+  where
+    leftOrRight a b = case association () of Left _ -> a; Right _ -> b
+    chainl1 p = difoldl pat >? beg >* p >*< manyP (sep >* p) *< end
+    chainr1 p = difoldr pat >? beg >* manyP (p *< sep) >*< p *< end
+
+{- | Add a `SepBy` to `replicateP` using `intercalateP`. -}
+intercalateP
+  :: (Monoidal p, Choice p, AsEmpty s, Cons s s a a)
+  => Int {- ^ number of repetitions -}
+  -> SepBy (p () ()) -> p a a -> p s s
+intercalateP n (SepBy beg end _) _ | n <= 0 =
+  beg >* asEmpty *< end
+intercalateP n (SepBy beg end comma) p =
+  beg >* p >:< replicateP (n-1) (comma >* p) *< end
diff --git a/src/Data/Traversable/Homogeneous.hs b/src/Data/Traversable/Homogeneous.hs
new file mode 100644
index 0000000..7dde3c4
--- /dev/null
+++ b/src/Data/Traversable/Homogeneous.hs
@@ -0,0 +1,140 @@
+{-|
+Module      : Data.Traversable.Homogeneous
+Description : distributors
+Copyright   : (C) 2026 - Eitan Chatav
+License     : BSD-style (see the file LICENSE)
+Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
+Stability   : provisional
+Portability : non-portable
+-}
+
+module Data.Traversable.Homogeneous
+  ( Homogeneous (..)
+  ) where
+
+import Control.Applicative
+import Control.Lens hiding (chosen)
+import Control.Lens.PartialIso
+import Data.Complex
+import Data.Functor.Compose
+import qualified Data.Functor.Product as Functor
+import qualified Data.Functor.Sum as Functor
+import qualified Data.Monoid as Monoid
+import Data.Profunctor.Monoidal
+import Data.Proxy
+import Data.Sequence (Seq)
+import Data.Tagged
+import Data.Tree (Tree (..))
+import Data.Vector (Vector)
+import Data.Void
+import GHC.Generics
+
+import Data.Profunctor.Distributor
+
+{- | A class of `Homogeneous`
+countable sums of countable products.
+-}
+class Traversable t => Homogeneous t where
+  {- | Sequences actions `homogeneously`.
+
+  prop> homogeneously @Maybe = optionalP
+  prop> homogeneously @[] = manyP
+
+  Any `Traversable` & `Data.Distributive.Distributive` countable product
+  can be given a default implementation for the `homogeneously` method.
+
+  prop> homogeneously = ditraverse
+
+  And any user-defined homogeneous algebraic datatype has
+  a default instance for `Homogeneous`, by deriving `Generic1`.
+  -}
+  homogeneously :: Distributor p => p a b -> p (t a) (t b)
+  default homogeneously
+    :: (Generic1 t, Homogeneous (Rep1 t), Distributor p)
+    => p a b -> p (t a) (t b)
+  homogeneously = dimap from1 to1 . homogeneously
+instance Homogeneous Par1 where
+  homogeneously = dimap unPar1 Par1
+instance Homogeneous Identity where
+  homogeneously = dimap runIdentity Identity
+instance Homogeneous Monoid.Dual where
+  homogeneously = dimap Monoid.getDual Monoid.Dual
+instance Homogeneous Monoid.Product where
+  homogeneously = dimap Monoid.getProduct Monoid.Product
+instance Homogeneous Monoid.Sum where
+  homogeneously = dimap Monoid.getSum Monoid.Sum
+instance Homogeneous (Tagged s) where
+  homogeneously = dimap unTagged Tagged
+instance Homogeneous U1 where
+  homogeneously _ = pure U1
+instance Homogeneous (K1 i ()) where
+  homogeneously _ = pure (K1 ())
+instance Homogeneous (Const ()) where
+  homogeneously _ = pure (Const ())
+instance Homogeneous Proxy where
+  homogeneously _ = pure Proxy
+instance (Homogeneous s, Homogeneous t)
+  => Homogeneous (s :.: t) where
+    homogeneously
+      = dimap unComp1 Comp1
+      . homogeneously . homogeneously
+instance (Homogeneous s, Homogeneous t)
+  => Homogeneous (Compose s t) where
+    homogeneously
+      = dimap getCompose Compose
+      . homogeneously . homogeneously
+instance (Homogeneous s, Homogeneous t)
+  => Homogeneous (s :*: t) where
+    homogeneously p = dimap2
+      (\(s :*: _) -> s)
+      (\(_ :*: t) -> t)
+      (:*:)
+      (homogeneously p)
+      (homogeneously p)
+instance (Homogeneous s, Homogeneous t)
+  => Homogeneous (Functor.Product s t) where
+    homogeneously p = dimap2
+      (\(Functor.Pair s _) -> s)
+      (\(Functor.Pair _ t) -> t)
+      Functor.Pair
+      (homogeneously p)
+      (homogeneously p)
+instance Homogeneous V1 where
+  homogeneously _ = dimap (\case) (\case) zeroP
+instance Homogeneous (K1 i Void) where
+  homogeneously _ = dimap unK1 K1 zeroP
+instance Homogeneous (Const Void) where
+  homogeneously _ = dimap getConst Const zeroP
+instance (Homogeneous s, Homogeneous t)
+  => Homogeneous (s :+: t) where
+    homogeneously p = dialt
+      (\case {L1 s -> Left s; R1 t -> Right t})
+      L1
+      R1
+      (homogeneously p)
+      (homogeneously p)
+instance (Homogeneous s, Homogeneous t)
+  => Homogeneous (Functor.Sum s t) where
+    homogeneously p = dialt
+      (\case {Functor.InL s -> Left s; Functor.InR t -> Right t})
+      Functor.InL
+      Functor.InR
+      (homogeneously p)
+      (homogeneously p)
+instance Homogeneous t
+  => Homogeneous (M1 i c t) where
+    homogeneously = dimap unM1 M1 . homogeneously
+instance Homogeneous f => Homogeneous (Rec1 f) where
+  homogeneously = dimap unRec1 Rec1 . homogeneously
+instance Homogeneous Maybe where
+  homogeneously = optionalP
+instance Homogeneous [] where
+  homogeneously = manyP
+instance Homogeneous Vector where
+  homogeneously p = eotList >~ p >*< homogeneously p >+< oneP
+instance Homogeneous Seq where
+  homogeneously p = eotList >~ p >*< homogeneously p >+< oneP
+instance Homogeneous Complex where
+  homogeneously p = dimap2 realPart imagPart (:+) p p
+instance Homogeneous Tree where
+  homogeneously p = dimap2 rootLabel subForest Node p (manyP (homogeneously p))
diff --git a/test/Examples/Arithmetic.hs b/test/Examples/Arithmetic.hs
index 4a40f2d..8224337 100644
--- a/test/Examples/Arithmetic.hs
+++ b/test/Examples/Arithmetic.hs
@@ -13,6 +13,7 @@ import Control.Lens.Grammar.Token
 import Control.Lens.PartialIso
 import Data.Profunctor.Distributor
 import Data.Profunctor.Monoidal
+import Data.Profunctor.Separator
 import Numeric.Natural
 
 data Arith
diff --git a/test/Examples/Chain.hs b/test/Examples/Chain.hs
index a7d1fcb..808c432 100644
--- a/test/Examples/Chain.hs
+++ b/test/Examples/Chain.hs
@@ -11,8 +11,8 @@ import Control.Lens.Grammar.BackusNaur
 import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
 import Control.Lens.PartialIso
-import Data.Profunctor.Distributor
 import Data.Profunctor.Monoidal
+import Data.Profunctor.Separator
 
 data Chain
   = Emp
diff --git a/test/Examples/Json.hs b/test/Examples/Json.hs
index c001085..622c429 100644
--- a/test/Examples/Json.hs
+++ b/test/Examples/Json.hs
@@ -15,6 +15,7 @@ import Control.Lens.Grammar.Token
 import Control.Lens.PartialIso
 import Data.Profunctor.Distributor
 import Data.Profunctor.Monoidal
+import Data.Profunctor.Separator
 import qualified Data.Map.Strict as Map
 import Data.Map.Strict (Map)
 import Numeric.Natural
diff --git a/test/Examples/Lambda.hs b/test/Examples/Lambda.hs
index bee41e3..0dfebd0 100644
--- a/test/Examples/Lambda.hs
+++ b/test/Examples/Lambda.hs
@@ -12,6 +12,7 @@ import Control.Lens.Grammar.Token
 import Control.Lens.PartialIso
 import Data.Profunctor.Distributor
 import Data.Profunctor.Monoidal
+import Data.Profunctor.Separator
 
 -- | Abstract syntax tree for lambda calculus terms
 data Lambda
diff --git a/test/Examples/LenVec.hs b/test/Examples/LenVec.hs
index a37b608..2e49a64 100644
--- a/test/Examples/LenVec.hs
+++ b/test/Examples/LenVec.hs
@@ -10,6 +10,7 @@ import Control.Lens.Grammar.Token
 import Control.Lens.PartialIso
 import Data.Profunctor.Distributor
 import qualified Data.Profunctor.Monadic as P
+import Data.Profunctor.Separator
 import Numeric.Natural
 
 data LenVec = LenVec {length :: Natural, vector :: [Natural]}
diff --git a/test/Examples/SExpr.hs b/test/Examples/SExpr.hs
index 84e900e..3c55595 100644
--- a/test/Examples/SExpr.hs
+++ b/test/Examples/SExpr.hs
@@ -13,6 +13,7 @@ import Control.Lens.Grammar.Token
 import Control.Lens.PartialIso hiding (List)
 import Data.Profunctor.Distributor
 import Data.Profunctor.Monoidal
+import Data.Profunctor.Separator
 
 -- | Abstract syntax tree for S-expressions
 data SExpr
diff --git a/test/Examples/SemVer.hs b/test/Examples/SemVer.hs
index 73a9cd8..b3732c5 100644
--- a/test/Examples/SemVer.hs
+++ b/test/Examples/SemVer.hs
@@ -14,6 +14,7 @@ import Control.Lens.PartialIso
 import Data.Profunctor.Distributor
 import qualified Data.Profunctor.Monadic as P
 import Data.Profunctor.Monoidal
+import Data.Profunctor.Separator
 import Numeric.Natural
 
 -- | Semantic version structure following semver.org specification

From 399ece511ab9619e58901270abefb847bbf665b2 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 7 Apr 2026 16:45:44 -0700
Subject: [PATCH 065/103] reexports

---
 src/Control/Lens/Grammar.hs   | 19 +++++++++++++++++++
 src/Control/Monad/Fail/Try.hs |  7 +++----
 test/Examples/Arithmetic.hs   |  7 -------
 test/Examples/Chain.hs        |  6 ------
 test/Examples/Json.hs         |  9 ---------
 test/Examples/Lambda.hs       |  7 -------
 test/Examples/LenVec.hs       |  5 -----
 test/Examples/RegString.hs    |  4 ----
 test/Examples/SExpr.hs        | 10 +---------
 test/Examples/SemVer.hs       |  6 ------
 test/Main.hs                  |  3 ---
 11 files changed, 23 insertions(+), 60 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 8ac97e9..ba6d6ff 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -32,6 +32,8 @@ module Control.Lens.Grammar
   , unparsecG
     -- * Utility
   , putStringLn
+    -- * Re-exports
+  , module X
   ) where
 
 import Control.Applicative
@@ -56,6 +58,23 @@ import GHC.Exts
 import Prelude hiding (filter)
 import Witherable
 
+-- Re-exports
+import Control.Applicative as X
+import Control.Lens.Grammar.BackusNaur as X
+import Control.Lens.Grammar.Boole as X
+import Control.Lens.Grammar.Kleene as X
+import Control.Lens.Grammar.Symbol as X
+import Control.Lens.Grammar.Token as X
+import Control.Lens.PartialIso as X
+import Control.Monad.Fail.Try as X
+import Data.Profunctor.Distributor as X
+import Data.Profunctor.Filtrator as X
+import Data.Profunctor.Grammar as X
+import Data.Profunctor.Grammar.Parsector as X
+import Data.Profunctor.Monoidal as X
+import Data.Profunctor.Separator as X
+import Data.Traversable.Homogeneous as X
+
 {- |
 A regular grammar may be constructed using
 `Lexical` and `Alternator` combinators.
diff --git a/src/Control/Monad/Fail/Try.hs b/src/Control/Monad/Fail/Try.hs
index ec04774..73bf2ed 100644
--- a/src/Control/Monad/Fail/Try.hs
+++ b/src/Control/Monad/Fail/Try.hs
@@ -16,10 +16,9 @@ module Control.Monad.Fail.Try
 
 import Control.Monad
 
-{- | `MonadTry`.
-
-A `MonadTry` implements `fail` & `try` and
-two alternation combinators; `<|>` & `mplus`.
+{- | `MonadTry` implements `fail` & `try` and
+two alternation combinators
+`Control.Applicative.<|>` & `mplus`.
 
 The following invariants should hold.
 
diff --git a/test/Examples/Arithmetic.hs b/test/Examples/Arithmetic.hs
index 8224337..3508ef9 100644
--- a/test/Examples/Arithmetic.hs
+++ b/test/Examples/Arithmetic.hs
@@ -7,13 +7,6 @@ module Examples.Arithmetic
 import Control.Applicative
 import Control.Lens
 import Control.Lens.Grammar
-import Control.Lens.Grammar.BackusNaur
-import Control.Lens.Grammar.Symbol
-import Control.Lens.Grammar.Token
-import Control.Lens.PartialIso
-import Data.Profunctor.Distributor
-import Data.Profunctor.Monoidal
-import Data.Profunctor.Separator
 import Numeric.Natural
 
 data Arith
diff --git a/test/Examples/Chain.hs b/test/Examples/Chain.hs
index 808c432..5d0f964 100644
--- a/test/Examples/Chain.hs
+++ b/test/Examples/Chain.hs
@@ -7,12 +7,6 @@ module Examples.Chain
 import Control.Applicative
 import Control.Lens
 import Control.Lens.Grammar
-import Control.Lens.Grammar.BackusNaur
-import Control.Lens.Grammar.Symbol
-import Control.Lens.Grammar.Token
-import Control.Lens.PartialIso
-import Data.Profunctor.Monoidal
-import Data.Profunctor.Separator
 
 data Chain
   = Emp
diff --git a/test/Examples/Json.hs b/test/Examples/Json.hs
index 622c429..2186c50 100644
--- a/test/Examples/Json.hs
+++ b/test/Examples/Json.hs
@@ -7,15 +7,6 @@ module Examples.Json
 import Control.Applicative
 import Control.Lens
 import Control.Lens.Grammar
-import Control.Lens.Grammar.BackusNaur
-import Control.Lens.Grammar.Boole
-import Control.Lens.Grammar.Kleene
-import Control.Lens.Grammar.Symbol
-import Control.Lens.Grammar.Token
-import Control.Lens.PartialIso
-import Data.Profunctor.Distributor
-import Data.Profunctor.Monoidal
-import Data.Profunctor.Separator
 import qualified Data.Map.Strict as Map
 import Data.Map.Strict (Map)
 import Numeric.Natural
diff --git a/test/Examples/Lambda.hs b/test/Examples/Lambda.hs
index 0dfebd0..45a9305 100644
--- a/test/Examples/Lambda.hs
+++ b/test/Examples/Lambda.hs
@@ -6,13 +6,6 @@ module Examples.Lambda
 
 import Control.Lens
 import Control.Lens.Grammar
-import Control.Lens.Grammar.BackusNaur
-import Control.Lens.Grammar.Symbol
-import Control.Lens.Grammar.Token
-import Control.Lens.PartialIso
-import Data.Profunctor.Distributor
-import Data.Profunctor.Monoidal
-import Data.Profunctor.Separator
 
 -- | Abstract syntax tree for lambda calculus terms
 data Lambda
diff --git a/test/Examples/LenVec.hs b/test/Examples/LenVec.hs
index 2e49a64..e770768 100644
--- a/test/Examples/LenVec.hs
+++ b/test/Examples/LenVec.hs
@@ -5,12 +5,7 @@ module Examples.LenVec
   ) where
 
 import Control.Lens.Grammar
-import Control.Lens.Grammar.Symbol
-import Control.Lens.Grammar.Token
-import Control.Lens.PartialIso
-import Data.Profunctor.Distributor
 import qualified Data.Profunctor.Monadic as P
-import Data.Profunctor.Separator
 import Numeric.Natural
 
 data LenVec = LenVec {length :: Natural, vector :: [Natural]}
diff --git a/test/Examples/RegString.hs b/test/Examples/RegString.hs
index 4d9f710..bdd1bdf 100644
--- a/test/Examples/RegString.hs
+++ b/test/Examples/RegString.hs
@@ -3,10 +3,6 @@ module Examples.RegString
   ) where
 
 import Control.Lens.Grammar
-import Control.Lens.Grammar.Boole
-import Control.Lens.Grammar.Kleene
-import Control.Lens.Grammar.Symbol
-import Control.Lens.Grammar.Token
 
 regexExamples :: [(RegString, String)]
 regexExamples =
diff --git a/test/Examples/SExpr.hs b/test/Examples/SExpr.hs
index 3c55595..3f3dc51 100644
--- a/test/Examples/SExpr.hs
+++ b/test/Examples/SExpr.hs
@@ -5,15 +5,7 @@ module Examples.SExpr
   ) where
 
 import Control.Lens hiding (List)
-import Control.Lens.Grammar
-import Control.Lens.Grammar.BackusNaur
-import Control.Lens.Grammar.Kleene
-import Control.Lens.Grammar.Symbol
-import Control.Lens.Grammar.Token
-import Control.Lens.PartialIso hiding (List)
-import Data.Profunctor.Distributor
-import Data.Profunctor.Monoidal
-import Data.Profunctor.Separator
+import Control.Lens.Grammar hiding (List)
 
 -- | Abstract syntax tree for S-expressions
 data SExpr
diff --git a/test/Examples/SemVer.hs b/test/Examples/SemVer.hs
index b3732c5..7ff57a6 100644
--- a/test/Examples/SemVer.hs
+++ b/test/Examples/SemVer.hs
@@ -8,13 +8,7 @@ module Examples.SemVer
 import Control.Applicative
 import Control.Lens
 import Control.Lens.Grammar
-import Control.Lens.Grammar.Symbol
-import Control.Lens.Grammar.Token
-import Control.Lens.PartialIso
-import Data.Profunctor.Distributor
 import qualified Data.Profunctor.Monadic as P
-import Data.Profunctor.Monoidal
-import Data.Profunctor.Separator
 import Numeric.Natural
 
 -- | Semantic version structure following semver.org specification
diff --git a/test/Main.hs b/test/Main.hs
index 3f5f8e3..1ad8f77 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -2,10 +2,7 @@ module Main (main) where
 
 import Data.Foldable hiding (toList)
 import Control.Lens.Grammar
-import Control.Lens.Grammar.BackusNaur
-import Control.Lens.Grammar.Boole
 import Data.List (genericLength)
-import Data.Profunctor.Grammar.Parsector
 import Test.DocTest
 import Test.Hspec
 

From d897b9ea6a411c7fe4f9e6d0fea7b8dcc8dd3adb Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 7 Apr 2026 17:26:42 -0700
Subject: [PATCH 066/103] sepWith

---
 src/Control/Lens/Grammar.hs         | 18 ++++++-------
 src/Control/Monad/Fail/Try.hs       |  8 +++++-
 src/Data/Profunctor/Separator.hs    | 39 +++++++++++++++++++++++------
 src/Data/Traversable/Homogeneous.hs |  6 +++--
 test/Examples/Arithmetic.hs         |  4 +--
 test/Examples/Json.hs               |  4 +--
 test/Examples/Lambda.hs             |  2 +-
 test/Examples/LenVec.hs             |  2 +-
 test/Examples/SExpr.hs              |  2 +-
 test/Examples/SemVer.hs             |  4 +--
 10 files changed, 59 insertions(+), 30 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index ba6d6ff..3b933d0 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -59,7 +59,6 @@ import Prelude hiding (filter)
 import Witherable
 
 -- Re-exports
-import Control.Applicative as X
 import Control.Lens.Grammar.BackusNaur as X
 import Control.Lens.Grammar.Boole as X
 import Control.Lens.Grammar.Kleene as X
@@ -125,7 +124,7 @@ semverGrammar = _SemVer
   >*< optionP _Empty (terminal "+" >* identifiersG)
   where
     numberG = iso show read >~ someP (asIn @Char DecimalNumber)
-    identifiersG = several1 (sepBy (terminal ".")) (someP charG)
+    identifiersG = several1 (sepWith ".") (someP charG)
     charG = asIn LowercaseLetter
       <|> asIn UppercaseLetter
       <|> asIn DecimalNumber
@@ -237,9 +236,9 @@ arithGrammar :: Grammar Char Arith
 arithGrammar = ruleRec "arith" sumG
   where
     sumG arith = rule "sum" $
-      chain1 Left _Add (sepBy (terminal "+")) (prodG arith)
+      chain1 Left _Add (sepWith "+") (prodG arith)
     prodG arith = rule "product" $
-      chain1 Left _Mul (sepBy (terminal "*")) (factorG arith)
+      chain1 Left _Mul (sepWith "*") (factorG arith)
     factorG arith = rule "factor" $
       numberG <|> terminal "(" >* arith *< terminal ")"
     numberG = rule "number" $
@@ -299,7 +298,7 @@ lenvecGrammar :: CtxGrammar Char LenVec
 lenvecGrammar = _LenVec >? P.do
   let
     numberG = iso show read >~ someP (asIn @Char DecimalNumber)
-    vectorG n = intercalateP n (sepBy (terminal ",")) numberG
+    vectorG n = intercalateP n (sepWith ",") numberG
   len <- numberG             -- bonds to _LenVec
   terminal ";"               -- doesn't bond
   vectorG (fromIntegral len) -- bonds to _LenVec
@@ -561,7 +560,7 @@ regexGrammar :: Grammar Char RegString
 regexGrammar = _RegString >~ ruleRec "regex" altG
   where
     altG rex = rule "alternate" $
-      chain1 Left (_RegExam . _Alternate) (sepBy (terminal "|")) (seqG rex)
+      chain1 Left (_RegExam . _Alternate) (sepWith "|") (seqG rex)
 
     seqG rex = rule "sequence" $
       chain Left _Sequence _SeqEmpty noSep (exprG rex)
@@ -619,10 +618,9 @@ regexGrammar = _RegString >~ ruleRec "regex" altG
 
     classCatG = rule "class-category" $ choice
       [ _AsIn >? terminal "\\p{" >* categoryG *< terminal "}"
-      , _NotAsIn >? several1 (sepBy (terminal "|"))
-          { beginBy = terminal "\\P{"
-          , endBy = terminal "}"
-          } categoryG
+      , _NotAsIn >? several1
+          (sepWith "|" & beginWith "\\P{" & endWith "}")
+          categoryG
       ]
 
     classOneOfG = rule "class-one-of" $ choice
diff --git a/src/Control/Monad/Fail/Try.hs b/src/Control/Monad/Fail/Try.hs
index 73bf2ed..a20986f 100644
--- a/src/Control/Monad/Fail/Try.hs
+++ b/src/Control/Monad/Fail/Try.hs
@@ -9,11 +9,17 @@ Portability : non-portable
 -}
 
 module Control.Monad.Fail.Try
-  ( MonadTry (..)
+  ( -- * MonadTry
+    MonadTry (..)
+    -- * MonadFail
   , MonadFail (..)
+    -- * MonadPlus
   , MonadPlus (..)
+    -- * Alternative
+  , Alternative (..)
   ) where
 
+import Control.Applicative
 import Control.Monad
 
 {- | `MonadTry` implements `fail` & `try` and
diff --git a/src/Data/Profunctor/Separator.hs b/src/Data/Profunctor/Separator.hs
index dd0524d..61024d6 100644
--- a/src/Data/Profunctor/Separator.hs
+++ b/src/Data/Profunctor/Separator.hs
@@ -9,9 +9,14 @@ Portability : non-portable
 -}
 
 module Data.Profunctor.Separator
-  ( SepBy (..)
+  ( -- * SepBy
+    SepBy (..)
   , sepBy
   , noSep
+  , sepWith
+  , beginWith
+  , endWith
+    -- * SepBy Combinators
   , several
   , several1
   , chain
@@ -21,6 +26,7 @@ module Data.Profunctor.Separator
 
 import Control.Lens
 import Control.Lens.PartialIso
+import Control.Lens.Grammar.Symbol
 import Data.Profunctor.Distributor
 import Data.Profunctor.Monoidal
 import GHC.Exts
@@ -39,18 +45,35 @@ data SepBy p = SepBy
     )
 
 {- | A `SepBy` smart constructor,
-setting the `separateBy` field,
-with no beginning or ending delimitors,
-except by updating `beginBy` or `endBy` fields. -}
+setting the `separateBy` field.
+Beginning and ending delimitors will be no-ops,
+except by modifier record updates `beginBy` or `endBy`. -}
 sepBy :: Applicative p => p () -> SepBy (p ())
 sepBy = SepBy (pure ()) (pure ())
 
--- sepWith :: (Monoidal p, TerminalSymbol c (p () ())) => 
-
 {- | A `SepBy` smart constructor for no separator,
 beginning or ending delimiters. -}
-noSep :: Monoidal p => SepBy (p () ())
-noSep = sepBy oneP
+noSep :: Applicative p => SepBy (p ())
+noSep = sepBy (pure ())
+
+{- | A `SepBy` smart constructor like `sepBy`,
+with a `terminal` argument.
+Beginning and ending delimitors will be no-ops,
+except by applying smart modifiers `beginWith` or `endWith`. -}
+sepWith
+  :: (Applicative p, TerminalSymbol c (p ()))
+  => [c] -> SepBy (p ())
+sepWith = sepBy . terminal
+
+{- | A `SepBy` smart modifier like `beginBy`,
+with a `terminal` argument. -}
+beginWith :: TerminalSymbol c p => [c] -> SepBy p -> SepBy p
+beginWith str separator = separator {beginBy = terminal str}
+
+{- | A `SepBy` smart modifier like `endBy`,
+with a `terminal` argument. -}
+endWith :: TerminalSymbol c p => [c] -> SepBy p -> SepBy p
+endWith str separator = separator {endBy = terminal str}
 
 {- |
 prop> several noSep = manyP
diff --git a/src/Data/Traversable/Homogeneous.hs b/src/Data/Traversable/Homogeneous.hs
index 7dde3c4..c71cdd5 100644
--- a/src/Data/Traversable/Homogeneous.hs
+++ b/src/Data/Traversable/Homogeneous.hs
@@ -9,7 +9,8 @@ Portability : non-portable
 -}
 
 module Data.Traversable.Homogeneous
-  ( Homogeneous (..)
+  ( -- * Homogeneous
+    Homogeneous (..)
   ) where
 
 import Control.Applicative
@@ -41,7 +42,8 @@ class Traversable t => Homogeneous t where
   prop> homogeneously @[] = manyP
 
   Any `Traversable` & `Data.Distributive.Distributive` countable product
-  can be given a default implementation for the `homogeneously` method.
+  can be given a default implementation for the `homogeneously` method
+  with `ditraverse`.
 
   prop> homogeneously = ditraverse
 
diff --git a/test/Examples/Arithmetic.hs b/test/Examples/Arithmetic.hs
index 3508ef9..f7ee1bb 100644
--- a/test/Examples/Arithmetic.hs
+++ b/test/Examples/Arithmetic.hs
@@ -21,9 +21,9 @@ arithGrammar :: Grammar Char Arith
 arithGrammar = ruleRec "arith" sumG
   where
     sumG arith = rule "sum" $
-      chain1 Left _Add (sepBy (terminal "+")) (prodG arith)
+      chain1 Left _Add (sepWith "+") (prodG arith)
     prodG arith = rule "product" $
-      chain1 Left _Mul (sepBy (terminal "*")) (factorG arith)
+      chain1 Left _Mul (sepWith "*") (factorG arith)
     factorG arith = rule "factor" $
       number <|> terminal "(" >* arith *< terminal ")"
     number = rule "number" $
diff --git a/test/Examples/Json.hs b/test/Examples/Json.hs
index 2186c50..e3aec52 100644
--- a/test/Examples/Json.hs
+++ b/test/Examples/Json.hs
@@ -53,7 +53,7 @@ jsonGrammar = ruleRec "json" elementG
 
     -- members = member | member ',' members
     membersG json = rule "members" $
-      several1 (sepBy (terminal ",")) (memberG json)
+      several1 (sepWith ",") (memberG json)
 
     -- member = ws string ws ':' element
     memberG json = rule "member" $
@@ -67,7 +67,7 @@ jsonGrammar = ruleRec "json" elementG
 
     -- elements = element | element ',' elements
     elementsG json = rule "elements" $
-      several1 (sepBy (terminal ",")) (elementG json)
+      several1 (sepWith ",") (elementG json)
 
     -- string = '"' characters '"'
     stringG = rule "string" $
diff --git a/test/Examples/Lambda.hs b/test/Examples/Lambda.hs
index 45a9305..3c43425 100644
--- a/test/Examples/Lambda.hs
+++ b/test/Examples/Lambda.hs
@@ -34,7 +34,7 @@ lambdaGrammar = ruleRec "lambda" termG
     -- Application: left-associative chain of atoms
     -- e.g., "f x y" parses as "(f x) y"
     appG term = rule "application" $
-      chain1 Left _App (sepBy (terminal " ")) (atomG term)
+      chain1 Left _App (sepWith " ") (atomG term)
 
     -- Atomic term: variable or parenthesized term
     atomG term = rule "atom" $ choice
diff --git a/test/Examples/LenVec.hs b/test/Examples/LenVec.hs
index e770768..13483dc 100644
--- a/test/Examples/LenVec.hs
+++ b/test/Examples/LenVec.hs
@@ -17,7 +17,7 @@ lenvecGrammar :: CtxGrammar Char LenVec
 lenvecGrammar = _LenVec >? P.do
   let
     numberG = iso show read >~ someP (asIn @Char DecimalNumber)
-    vectorG n = intercalateP n (sepBy (terminal ",")) numberG
+    vectorG n = intercalateP n (sepWith ",") numberG
   len <- numberG             -- bonds to _LenVec
   terminal ";"               -- doesn't bond
   vectorG (fromIntegral len) -- bonds to _LenVec
diff --git a/test/Examples/SExpr.hs b/test/Examples/SExpr.hs
index 3f3dc51..5cef3e4 100644
--- a/test/Examples/SExpr.hs
+++ b/test/Examples/SExpr.hs
@@ -29,7 +29,7 @@ sexprGrammar = ruleRec "sexpr" $ \sexpr -> choice
     -- List: parenthesized sequence of S-expressions
     -- Elements are separated by whitespace
     listG sexpr = rule "list" $
-      terminal "(" >* several (sepBy (terminal " ")) sexpr *< terminal ")"
+      terminal "(" >* several (sepWith " ") sexpr *< terminal ")"
 
     -- Characters allowed in atoms: letters, digits, and symbols
     atomChars =
diff --git a/test/Examples/SemVer.hs b/test/Examples/SemVer.hs
index 7ff57a6..c8f2ba5 100644
--- a/test/Examples/SemVer.hs
+++ b/test/Examples/SemVer.hs
@@ -42,7 +42,7 @@ semverGrammar = _SemVer
   >*< optionP _Empty (terminal "+" >* identifiersG)
   where
     numberG = iso show read >~ someP (asIn @Char DecimalNumber)
-    identifiersG = several1 (sepBy (terminal ".")) (someP charG)
+    identifiersG = several1 (sepWith ".") (someP charG)
     charG = asIn LowercaseLetter
       <|> asIn UppercaseLetter
       <|> asIn DecimalNumber
@@ -53,7 +53,7 @@ semverCtxGrammar :: CtxGrammar Char SemVer
 semverCtxGrammar = _SemVer >? P.do
   let
     numberG = iso show read >~ someP (asIn @Char DecimalNumber)
-    identifiersG = several1 (sepBy (terminal ".")) (someP charG)
+    identifiersG = several1 (sepWith ".") (someP charG)
     charG = asIn LowercaseLetter
       <|> asIn UppercaseLetter
       <|> asIn DecimalNumber

From f33b1dc5ca368c14e4afb622c1d23c3ba1082496 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 7 Apr 2026 18:04:41 -0700
Subject: [PATCH 067/103] - malternate

---
 src/Data/Profunctor/Distributor.hs | 15 ---------------
 src/Data/Profunctor/Filtrator.hs   |  2 +-
 2 files changed, 1 insertion(+), 16 deletions(-)

diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index c6cc23a..4885d3f 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -13,7 +13,6 @@ module Data.Profunctor.Distributor
     Distributor (..), dialt
     -- * Alternator
   , Alternator (..)
-  , malternate
   , choice
   ) where
 
@@ -23,7 +22,6 @@ import Control.Arrow
 import Control.Lens hiding (chosen)
 import Control.Lens.Internal.Profunctor
 import Control.Lens.PartialIso
-import Control.Monad
 import Data.Bifunctor.Clown
 import Data.Bifunctor.Joker
 import Data.Bifunctor.Product
@@ -35,7 +33,6 @@ import Data.Profunctor qualified as Pro (WrappedArrow)
 import Data.Profunctor.Cayley
 import Data.Profunctor.Composition
 import Data.Profunctor.Monad
-import Data.Profunctor.Monadic
 import Data.Profunctor.Monoidal
 import Data.Profunctor.Yoneda
 import Data.Void
@@ -224,18 +221,6 @@ class (Choice p, Distributor p, forall x. Alternative (p x))
     optionP :: APrism a b () () -> p a b -> p a b
     optionP def p = p <|> pureP def
 
--- | `malternate` gives an equivalent to `alternate` when `Monadic`.
---
--- prop> alternate = malternate
-malternate
-  :: (Monadic p, Alternator p)
-  => Either (p a b) (p c d) -- ^ `Left` or `Right` alternates
-  -> p (Either a c) (Either b d)
-malternate =
-  (left' >=> either (pure . Left) (const empty))
-  |||
-  (right' >=> either (const empty) (pure . Right))
-
 -- | Combines all `Alternative` choices in the specified list.
 choice :: (Foldable f, Alternative p) => f (p a) -> p a
 choice = foldl' (<|>) empty
diff --git a/src/Data/Profunctor/Filtrator.hs b/src/Data/Profunctor/Filtrator.hs
index d086bd3..5ea8ef7 100644
--- a/src/Data/Profunctor/Filtrator.hs
+++ b/src/Data/Profunctor/Filtrator.hs
@@ -61,7 +61,7 @@ class (Cochoice p, forall x. Filterable (p x))
       &&&
       dimapMaybe (Just . Right) (either (const Nothing) Just)
 
--- | Similar to `malternate`, a `Monadic` `Alternator` has
+-- | A `Monadic` `Alternator` has
 -- an equivalent to `filtrate`, given by `mfiltrate`.
 --
 -- prop> filtrate = mfiltrate

From 2c950dddc23eaa7ee00e60eb8cfeca9e5aebbdc1 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 7 Apr 2026 18:33:00 -0700
Subject: [PATCH 068/103] cleaning

---
 src/Control/Lens/Grammar.hs                | 8 ++++++--
 src/Control/Lens/Internal/NestedPrismTH.hs | 2 +-
 src/Control/Monad/Fail/Try.hs              | 2 +-
 src/Data/Profunctor/Grammar/Parsector.hs   | 2 +-
 src/Data/Profunctor/Separator.hs           | 2 +-
 src/Data/Traversable/Homogeneous.hs        | 2 +-
 6 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 3b933d0..85d04f0 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -94,11 +94,15 @@ data SemVer = SemVer          -- e.g., 2.1.5-rc.1+build.123
 
 We'd like to define an optic @_SemVer@,
 corresponding to the constructor pattern @SemVer@.
+You _could_ generate it with the TemplateHaskell combinator,
+`makeNestedPrisms`.
+
+@makeNestedPrisms ''SemVer@
+
 Unfortunately, we can't use TemplateHaskell to generate it in [GHCi]
 (https://wiki.haskell.org/GHC/GHCi),
 which is used to test this documenation.
-Normally we would write `makeNestedPrisms` @''SemVer@,
-but here is equivalent explicit Haskell code instead.
+Here is equivalent Haskell code instead.
 Since @SemVer@ has only one constructor,
 @_SemVer@ can be an `Control.Lens.Iso.Iso`.
 
diff --git a/src/Control/Lens/Internal/NestedPrismTH.hs b/src/Control/Lens/Internal/NestedPrismTH.hs
index 3debb1b..76c7e08 100644
--- a/src/Control/Lens/Internal/NestedPrismTH.hs
+++ b/src/Control/Lens/Internal/NestedPrismTH.hs
@@ -42,7 +42,7 @@ import Prelude
 -- The difference in `makeNestedPrisms`
 -- is that constructors with @n > 2@ arguments
 -- will use right-nested pairs, rather than a flat @n@-tuple.
--- This makes them suitable for bonding,
+-- This makes them suitable for pattern bonding,
 -- by use of the applicator `Control.Lens.PartialIso.>?`
 -- to `Data.Profunctor.Monoidal.Monoidal` idiom notation
 -- with `Data.Profunctor.Monoidal.>*<`,
diff --git a/src/Control/Monad/Fail/Try.hs b/src/Control/Monad/Fail/Try.hs
index a20986f..6aa20f5 100644
--- a/src/Control/Monad/Fail/Try.hs
+++ b/src/Control/Monad/Fail/Try.hs
@@ -1,6 +1,6 @@
 {-|
 Module      : Control.Monad.Fail.Try
-Description : monads with fail and try semantics
+Description : try & fail
 Copyright   : (C) 2026 - Eitan Chatav
 License     : BSD-style (see the file LICENSE)
 Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 776ca60..cfe940c 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -1,6 +1,6 @@
 {-|
 Module      : Data.Profunctor.Grammar.Parsector
-Description : Parsec-style invertible parser profunctor
+Description : lookahead grammar distributor
 Copyright   : (C) 2026 - Eitan Chatav
 License     : BSD-style (see the file LICENSE)
 Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
diff --git a/src/Data/Profunctor/Separator.hs b/src/Data/Profunctor/Separator.hs
index 61024d6..21b4d18 100644
--- a/src/Data/Profunctor/Separator.hs
+++ b/src/Data/Profunctor/Separator.hs
@@ -1,6 +1,6 @@
 {-|
 Module      : Data.Profunctor.Separator
-Description : distributors
+Description : separators
 Copyright   : (C) 2026 - Eitan Chatav
 License     : BSD-style (see the file LICENSE)
 Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
diff --git a/src/Data/Traversable/Homogeneous.hs b/src/Data/Traversable/Homogeneous.hs
index c71cdd5..52589af 100644
--- a/src/Data/Traversable/Homogeneous.hs
+++ b/src/Data/Traversable/Homogeneous.hs
@@ -1,6 +1,6 @@
 {-|
 Module      : Data.Traversable.Homogeneous
-Description : distributors
+Description : homogeneous
 Copyright   : (C) 2026 - Eitan Chatav
 License     : BSD-style (see the file LICENSE)
 Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>

From ee9d56bf28ba746c3adab44ba8e35b53dd52da58 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 8 Apr 2026 08:49:48 -0700
Subject: [PATCH 069/103] ParsecState & ParsecError

---
 src/Control/Lens/Grammar.hs              |   4 +-
 src/Data/Profunctor/Grammar/Parsector.hs | 186 ++++++++++++-----------
 test/Main.hs                             |   5 +-
 3 files changed, 103 insertions(+), 92 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 85d04f0..c43f5dc 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -818,7 +818,7 @@ parsecG
   => (Item string ~ token, Categorized token)
   => CtxGrammar token a
   -> string {- ^ input -}
-  -> Reply string a
+  -> ParsecState string a
 parsecG parsector = parsecP parsector
 
 {- | `unparsecG` generates a Parsec-style unparser from a `CtxGrammar`. -}
@@ -828,7 +828,7 @@ unparsecG
   => CtxGrammar token a
   -> a {- ^ syntax -}
   -> string {- ^ input -}
-  -> Reply string a
+  -> ParsecState string a
 unparsecG parsector = unparsecP parsector
 
 {- | `putStringLn` is a utility that generalizes `putStrLn`
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index cfe940c..3ef9a8b 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -11,7 +11,8 @@ Portability : non-portable
 module Data.Profunctor.Grammar.Parsector
   ( -- * Parsector
     Parsector (..)
-  , Reply (..)
+  , ParsecState (..)
+  , ParsecError (..)
   , parsecP
   , unparsecP
   ) where
@@ -33,13 +34,14 @@ import Data.Profunctor
 import Data.Profunctor.Distributor
 import Data.Profunctor.Filtrator
 import Data.Profunctor.Monoidal
+import Data.Tree
 import GHC.Exts
 import Prelude hiding (id, (.))
 import Witherable
 
 {- | `Parsector` is an invertible parser which can be used
 to parse with `parsecP` or print with `unparsecP`,
-yielding a `Reply`, with detailed errors and offset tracking.
+yielding a `ParsecState`, with detailed errors and offset tracking.
 
 `(<|>)` uses left-biased ordered choice in both parse and print mode:
 if the left alternative succeeds it is committed to immediately,
@@ -53,21 +55,44 @@ the default first so that a value matching the default prism
 short-circuits without entering @p@.
 -}
 newtype Parsector s a b = Parsector
-  { runParsector :: forall x. (Reply s b -> x) -> Reply s a -> x }
+  { runParsector :: forall x. (ParsecState s b -> x) -> ParsecState s a -> x }
 
-{- | `Reply` is the return type for `parsecP` & `unparsecP`.
+{- | `ParsecError` is the error payload inside a failed `ParsecState`.
+-}
+data ParsecError s = ParsecError
+  { parsecExpect :: TokenClass (Item s)
+    -- ^ class of expected tokens at the failure offset
+  , parsecLabels :: Forest String
+    {- ^ forest of `rule` labels active at failure;
+    nested @`rule`@ calls build children, @('<|>')@ merges siblings.
+    -}
+  }
+deriving stock instance
+  ( Categorized (Item s)
+  , Show (Item s), Show (Categorize (Item s))
+  ) => Show (ParsecError s)
+deriving stock instance
+  ( Categorized (Item s)
+  , Read (Item s), Read (Categorize (Item s))
+  ) => Read (ParsecError s)
+deriving stock instance Categorized (Item s) => Eq (ParsecError s)
+deriving stock instance Categorized (Item s) => Ord (ParsecError s)
+instance Categorized (Item s) => Semigroup (ParsecError s) where
+  ParsecError e1 l1 <> ParsecError e2 l2 = ParsecError (e1 >||< e2) (l1 ++ l2)
+instance Categorized (Item s) => Monoid (ParsecError s) where
+  mempty = ParsecError falseB []
+
+{- | `ParsecState` is the return type for `parsecP` & `unparsecP`.
 It's the fundamental building block of `Parsector`.
 -}
-data Reply s a = Reply
+data ParsecState s a = ParsecState
   { parsecOffset :: !Word
     -- ^ number of tokens either parsed or printed
-  , parsecExpect :: TokenClass (Item s)
-  , parsecResult :: Maybe a
-    {- ^ As an input `parsecResult` represents either parse mode,
-    or print mode with an input syntax value.
-    As an output `parsecResult` represents either failure
-    with the expected `TokenClass`,
-    or success with an output syntax value.
+  , parsecResult :: Either (ParsecError s) a
+    {- ^ As an input @parsecResult@ represents either parse mode (@Left@),
+    or print mode with an input syntax value (@Right a@).
+    As an output @parsecResult@ represents either failure
+    (@Left err@) or success (@Right b@).
     -}
   , parsecStream :: s -- ^ both input and output stream
   } deriving (Functor, Foldable, Traversable)
@@ -75,28 +100,28 @@ deriving stock instance
   ( Categorized (Item s)
   , Show (Item s), Show (Categorize (Item s))
   , Show a, Show s
-  ) => Show (Reply s a)
+  ) => Show (ParsecState s a)
 deriving stock instance
   ( Categorized (Item s)
   , Read (Item s), Read (Categorize (Item s))
   , Read a, Read s
-  ) => Read (Reply s a)
+  ) => Read (ParsecState s a)
 deriving stock instance
   ( Categorized (Item s)
   , Eq a, Eq s
-  ) => Eq (Reply s a)
+  ) => Eq (ParsecState s a)
 deriving stock instance
   ( Categorized (Item s)
   , Ord a, Ord s
-  ) => Ord (Reply s a)
+  ) => Ord (ParsecState s a)
 
 -- | `Parsector` is parsed using `parsecP`.
-parsecP :: Categorized (Item s) => Parsector s a b -> s -> Reply s b
-parsecP p s = runParsector p id (Reply 0 falseB Nothing s)
+parsecP :: Categorized (Item s) => Parsector s a b -> s -> ParsecState s b
+parsecP p s = runParsector p id (ParsecState 0 (Left mempty) s)
 
 -- | `Parsector` is printed using `unparsecP`.
-unparsecP :: Categorized (Item s) => Parsector s a b -> a -> s -> Reply s b
-unparsecP p a s = runParsector p id (Reply 0 falseB (Just a) s)
+unparsecP :: Parsector s a b -> a -> s -> ParsecState s b
+unparsecP p a s = runParsector p id (ParsecState 0 (Right a) s)
 
 -- Parsector instances
 instance
@@ -116,28 +141,34 @@ instance
     tokenClass test = Parsector $ \callback query ->
       let
         stream = parsecStream query
-        result = parsecResult query
+        mode = parsecResult query
         offset = parsecOffset query
         replyOk tok str = query
           { parsecStream = str
           , parsecOffset = offset + 1
-          , parsecResult = Just tok
+          , parsecResult = Right tok
           }
         replyErr = query
-          { parsecExpect = test
-          , parsecResult = Nothing
-          }
+          { parsecResult = Left (ParsecError test []) }
       in
-        callback $ case result of
-          Just tok
+        callback $ case mode of
+          -- print mode
+          Right tok
             | tokenClass test tok -> replyOk tok (snoc stream tok)
             | otherwise -> replyErr
-          Nothing -> case uncons stream of
+          -- parse mode
+          Left _ -> case uncons stream of
             Just (tok, rest)
               | tokenClass test tok -> replyOk tok rest
               | otherwise -> replyErr
             Nothing -> replyErr
-instance BackusNaurForm (Parsector s a b)
+instance BackusNaurForm (Parsector s a b) where
+  rule name p = Parsector $ \callback query ->
+    flip (runParsector p) query $ \reply -> callback $
+      case parsecResult reply of
+        Left (ParsecError expect labels) ->
+          reply { parsecResult = Left (ParsecError expect [Node name labels]) }
+        Right _ -> reply
 instance
   ( Categorized token, Item s ~ token
   , Cons s s token token, Snoc s s token token
@@ -146,20 +177,20 @@ instance Functor (Parsector s a) where
   fmap = rmap
 instance Categorized (Item s) => Applicative (Parsector s a) where
   pure b = Parsector $ \callback query ->
-    callback query { parsecResult = Just b }
+    callback query { parsecResult = Right b }
   (<*>) = ap
 instance Categorized (Item s) => Monad (Parsector s a) where
   return = pure
   p >>= f = Parsector $ \callback query ->
     flip (runParsector p) query $ \reply ->
       case parsecResult reply of
-        Nothing -> callback reply {parsecResult = Nothing}
-        Just b -> runParsector (f b) callback reply
+        Left err -> callback reply {parsecResult = Left err}
+        Right b -> runParsector (f b) callback reply
           {parsecResult = parsecResult query}
 instance Categorized (Item s) => Alternative (Parsector s a) where
   -- | Always fail, consuming no input and expecting nothing.
   empty = Parsector $ \callback query ->
-    callback query { parsecResult = Nothing }
+    callback query { parsecResult = Left mempty }
   p <|> q = mplus (try p) q
 instance Categorized (Item s) => MonadPlus (Parsector s a) where
   mplus p q = Parsector $ \callback query ->
@@ -169,26 +200,24 @@ instance Categorized (Item s) => MonadPlus (Parsector s a) where
       flip (runParsector p) query $ \replyP -> callback $
         if parsecOffset replyP == offset0
         then case parsecResult replyP of
-          Nothing ->
+          Left errP ->
             flip (runParsector q) query $ \replyQ ->
               if parsecOffset replyQ == offset0
-              then replyQ
-                {parsecExpect = ((>||<) `on` parsecExpect) replyP replyQ}
+              then case parsecResult replyQ of
+                Left errQ -> replyQ { parsecResult = Left (errP <> errQ) }
+                Right _   -> replyQ
               else replyQ
-          Just _ -> replyP
+          Right _ -> replyP
         else replyP
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
 instance Categorized (Item s) => MonadTry (Parsector s a) where
   try p = Parsector $ \callback query ->
     flip (runParsector p) query $ \reply -> callback $
-      if parsecOffset reply > 0
+      if parsecOffset reply > parsecOffset query
       then case parsecResult reply of
-        Nothing -> query
-          { parsecExpect = parsecExpect reply
-          , parsecResult = Nothing
-          }
-        Just _ -> reply
+        Left err -> query { parsecResult = Left err }
+        Right _  -> reply
       else reply
 instance Categorized (Item s) => Filterable (Parsector s a) where
   mapMaybe = dimapMaybe Just
@@ -232,73 +261,58 @@ instance Categorized (Item s) => Choice (Parsector s) where
 instance Categorized (Item s) => Distributor (Parsector s) where
   manyP p = Parsector $ \callback query ->
     case parsecResult query of
-      Nothing ->
+      Left _ ->
         let
-          queryP = Reply
-            { parsecOffset = parsecOffset query
-            , parsecExpect = parsecExpect query
-            , parsecResult = Nothing
-            , parsecStream = parsecStream query
-            }
+          queryP = query { parsecResult = Left mempty }
         in
           flip (runParsector (try p)) queryP $ \replyP ->
             case parsecResult replyP of
-              Nothing ->
-                callback Reply
-                  { parsecOffset = parsecOffset query
-                  , parsecExpect = parsecExpect query
-                  , parsecResult = Just []
-                  , parsecStream = parsecStream query
-                  }
-              Just a ->
+              Left _ ->
+                callback query { parsecResult = Right [] }
+              Right a ->
                 let
-                  queryM = Reply
-                    { parsecOffset = parsecOffset replyP
-                    , parsecExpect = parsecExpect replyP
-                    , parsecResult = Nothing
-                    , parsecStream = parsecStream replyP
-                    }
+                  queryM = replyP { parsecResult = Left mempty }
                 in
                   flip (runParsector (manyP p)) queryM $
                     \replyM -> callback replyM
                       {parsecResult = (a:) <$> parsecResult replyM}
-      Just _ ->
+      Right _ ->
         runParsector (eotList >~ p >*< manyP p >+< oneP) callback query
 instance Categorized (Item s) => Alternator (Parsector s) where
   alternate (Left p) = Parsector $ \callback query -> callback $
     let
       replyOk = query
-        { parsecResult = do
-            result <- parsecResult query
-            either Just (const Nothing) result
+        { parsecResult = case parsecResult query of
+            Left err       -> Left err
+            Right (Left a) -> Right a
+            Right (Right _) -> Left mempty
         }
-      replyErr = query
-        { parsecResult = Nothing }
+      replyErr = query { parsecResult = Left mempty }
     in
       case (parsecResult query, parsecResult replyOk) of
-        (Just _, Nothing) -> replyErr
+        (Right _, Left _) -> replyErr
         _________________ ->
           flip (runParsector p) replyOk $ \reply -> reply
-            { parsecResult = Left <$> parsecResult reply }
+            { parsecResult = fmap Left (parsecResult reply) }
   alternate (Right p) = Parsector $ \callback query -> callback $
     let
       replyOk = query
-        { parsecResult = do
-            result <- parsecResult query
-            either (const Nothing) Just result
+        { parsecResult = case parsecResult query of
+            Left err        -> Left err
+            Right (Left _)  -> Left mempty
+            Right (Right b) -> Right b
         }
-      replyErr = query
-        { parsecResult = Nothing }
+      replyErr = query { parsecResult = Left mempty }
     in
       case (parsecResult query, parsecResult replyOk) of
-        (Just _, Nothing) -> replyErr
+        (Right _, Left _) -> replyErr
         _________________ ->
           flip (runParsector p) replyOk $ \reply -> reply
-            { parsecResult = Right <$> parsecResult reply }
+            { parsecResult = fmap Right (parsecResult reply) }
   optionP def p = Parsector $ \callback query ->
     case parsecResult query of
-      Nothing -> runParsector (p <|> pureP def) callback query
-      Just _ -> runParsector (pureP def <|> p) callback query
+      Left _ -> runParsector (p <|> pureP def) callback query
+      Right _ -> runParsector (pureP def <|> p) callback query
 instance Categorized (Item s) => Cochoice (Parsector s) where
   unleft = fst . filtrate
   unright = snd . filtrate
@@ -307,15 +321,13 @@ instance Categorized (Item s) => Filtrator (Parsector s) where
     ( Parsector $ \callback query ->
         flip (runParsector p) (Left <$> query) $ \reply ->
           callback reply
-            { parsecResult = do
-                result <- parsecResult reply
-                either Just (const Nothing) result
+            { parsecResult =
+                parsecResult reply >>= either Right (const (Left mempty))
             }
     , Parsector $ \callback query ->
         flip (runParsector p) (Right <$> query) $ \reply ->
           callback reply
-            { parsecResult = do
-                result <- parsecResult reply
-                either (const Nothing) Just result
+            { parsecResult =
+                parsecResult reply >>= either (const (Left mempty)) Right
             }
     )
diff --git a/test/Main.hs b/test/Main.hs
index 1ad8f77..c00d86d 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -100,11 +100,10 @@ testCtxGrammarExample grammar (expectedSyntax, expectedString) = do
   it ("should parsecG from " <> expectedString <> " correctly") $ do
     let actualSyntax = parsecG grammar expectedString
     let expectedLength = genericLength expectedString
-    let actualExpect = parsecExpect actualSyntax
     actualSyntax `shouldBe`
-      (Reply expectedLength actualExpect (Just expectedSyntax) "")
+      (ParsecState expectedLength (Right expectedSyntax) "")
   it ("should unparsecG to " <> expectedString <> " correctly") $ do
     let actualString = unparsecG grammar expectedSyntax ""
     let expectedLength = genericLength expectedString
     actualString `shouldBe`
-      (Reply expectedLength falseB (Just expectedSyntax) expectedString)
+      (ParsecState expectedLength (Right expectedSyntax) expectedString)

From 386888b965909870dd942a106929abaf892c5878 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 8 Apr 2026 09:06:12 -0700
Subject: [PATCH 070/103] cleaning

---
 src/Data/Profunctor/Grammar/Parsector.hs | 19 +++++++++++--------
 test/Main.hs                             |  4 ++--
 2 files changed, 13 insertions(+), 10 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 3ef9a8b..149bae0 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -62,7 +62,7 @@ newtype Parsector s a b = Parsector
 data ParsecError s = ParsecError
   { parsecExpect :: TokenClass (Item s)
     -- ^ class of expected tokens at the failure offset
-  , parsecLabels :: Forest String
+  , parsecLabels :: [Tree String]
     {- ^ forest of `rule` labels active at failure;
     nested @`rule`@ calls build children, @('<|>')@ merges siblings.
     -}
@@ -84,17 +84,20 @@ instance Categorized (Item s) => Monoid (ParsecError s) where
 
 {- | `ParsecState` is the return type for `parsecP` & `unparsecP`.
 It's the fundamental building block of `Parsector`.
+@Parsector s a b@ is equivalent to
+@ParsecState s a -> ParsecState s b@, so it had a dual
+interpretation as input and output.
 -}
 data ParsecState s a = ParsecState
   { parsecOffset :: !Word
     -- ^ number of tokens either parsed or printed
+  , parsecStream :: s -- ^ input and output stream
   , parsecResult :: Either (ParsecError s) a
-    {- ^ As an input @parsecResult@ represents either parse mode (@Left@),
-    or print mode with an input syntax value (@Right a@).
-    As an output @parsecResult@ represents either failure
-    (@Left err@) or success (@Right b@).
+    {- ^ As an input @parsecResult@ represents either parse mode,
+    `Left` `mempty`, or print mode with an input syntax value.
+    As an output @parsecResult@ represents either an error or
+    a successful result with an output syntax value.
     -}
-  , parsecStream :: s -- ^ both input and output stream
   } deriving (Functor, Foldable, Traversable)
 deriving stock instance
   ( Categorized (Item s)
@@ -117,11 +120,11 @@ deriving stock instance
 
 -- | `Parsector` is parsed using `parsecP`.
 parsecP :: Categorized (Item s) => Parsector s a b -> s -> ParsecState s b
-parsecP p s = runParsector p id (ParsecState 0 (Left mempty) s)
+parsecP p s = runParsector p id (ParsecState 0 s (Left mempty))
 
 -- | `Parsector` is printed using `unparsecP`.
 unparsecP :: Parsector s a b -> a -> s -> ParsecState s b
-unparsecP p a s = runParsector p id (ParsecState 0 (Right a) s)
+unparsecP p a s = runParsector p id (ParsecState 0 s (Right a))
 
 -- Parsector instances
 instance
diff --git a/test/Main.hs b/test/Main.hs
index c00d86d..51a38df 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -101,9 +101,9 @@ testCtxGrammarExample grammar (expectedSyntax, expectedString) = do
     let actualSyntax = parsecG grammar expectedString
     let expectedLength = genericLength expectedString
     actualSyntax `shouldBe`
-      (ParsecState expectedLength (Right expectedSyntax) "")
+      (ParsecState expectedLength "" (Right expectedSyntax))
   it ("should unparsecG to " <> expectedString <> " correctly") $ do
     let actualString = unparsecG grammar expectedSyntax ""
     let expectedLength = genericLength expectedString
     actualString `shouldBe`
-      (ParsecState expectedLength (Right expectedSyntax) expectedString)
+      (ParsecState expectedLength expectedString (Right expectedSyntax))

From 04675438ec88d69e073a0c0b69d95421215f37c9 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 8 Apr 2026 09:09:24 -0700
Subject: [PATCH 071/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 149bae0..7fd125d 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -61,7 +61,7 @@ newtype Parsector s a b = Parsector
 -}
 data ParsecError s = ParsecError
   { parsecExpect :: TokenClass (Item s)
-    -- ^ class of expected tokens at the failure offset
+    -- ^ class of expected token `Item`s at the failure offset
   , parsecLabels :: [Tree String]
     {- ^ forest of `rule` labels active at failure;
     nested @`rule`@ calls build children, @('<|>')@ merges siblings.
@@ -82,10 +82,10 @@ instance Categorized (Item s) => Semigroup (ParsecError s) where
 instance Categorized (Item s) => Monoid (ParsecError s) where
   mempty = ParsecError falseB []
 
-{- | `ParsecState` is the return type for `parsecP` & `unparsecP`.
+{- | `ParsecState` is the outpute type for `parsecP` & `unparsecP`.
 It's the fundamental building block of `Parsector`.
 @Parsector s a b@ is equivalent to
-@ParsecState s a -> ParsecState s b@, so it had a dual
+@ParsecState s a -> ParsecState s b@, so it has a dual
 interpretation as input and output.
 -}
 data ParsecState s a = ParsecState

From c4f32c8fc7891af8a8e738983dcc3bdce6651d5a Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 8 Apr 2026 09:37:38 -0700
Subject: [PATCH 072/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index c43f5dc..8470073 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -362,7 +362,7 @@ type CtxGrammar token a = forall p.
   , forall x. BackusNaurForm (p x x)
   , Alternator p
   , Filtrator p
-  , Monadic p
+  , MonadicTry p
   ) => p a a
 
 {- |

From f5f9302b4035e784a8ee81509cf9b3fb35b94be2 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 8 Apr 2026 13:45:01 -0700
Subject: [PATCH 073/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 26 ++++++++++--------------
 1 file changed, 11 insertions(+), 15 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 7fd125d..5b776f1 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -197,21 +197,17 @@ instance Categorized (Item s) => Alternative (Parsector s a) where
   p <|> q = mplus (try p) q
 instance Categorized (Item s) => MonadPlus (Parsector s a) where
   mplus p q = Parsector $ \callback query ->
-    let
-      offset0 = parsecOffset query
-    in
-      flip (runParsector p) query $ \replyP -> callback $
-        if parsecOffset replyP == offset0
-        then case parsecResult replyP of
-          Left errP ->
-            flip (runParsector q) query $ \replyQ ->
-              if parsecOffset replyQ == offset0
-              then case parsecResult replyQ of
-                Left errQ -> replyQ { parsecResult = Left (errP <> errQ) }
-                Right _   -> replyQ
-              else replyQ
-          Right _ -> replyP
-        else replyP
+    flip (runParsector p) query $ \replyP -> callback $
+      case parsecResult replyP of
+        Right _ -> replyP
+        Left errP -> flip (runParsector q) query $ \replyQ ->
+          case parsecResult replyQ of
+            Right _ -> replyQ
+            Left errQ ->
+              case (compare `on` parsecOffset) replyP replyQ of
+                LT -> replyQ
+                EQ -> replyP {parsecResult = Left (errP <> errQ)}
+                GT -> replyP
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
 instance Categorized (Item s) => MonadTry (Parsector s a) where

From d0a5898af8339d5fabff470fbc83ffe19364a987 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 8 Apr 2026 13:49:08 -0700
Subject: [PATCH 074/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 5b776f1..1a33bf0 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -199,13 +199,19 @@ instance Categorized (Item s) => MonadPlus (Parsector s a) where
   mplus p q = Parsector $ \callback query ->
     flip (runParsector p) query $ \replyP -> callback $
       case parsecResult replyP of
+        -- if p succeeds do p's branch,
         Right _ -> replyP
+        -- otherwise,
         Left errP -> flip (runParsector q) query $ \replyQ ->
           case parsecResult replyQ of
+            -- if q succeeds do q's branch,
             Right _ -> replyQ
+            -- otherwise,
             Left errQ ->
+              -- do the longer branch,
               case (compare `on` parsecOffset) replyP replyQ of
                 LT -> replyQ
+                -- merging errors on ties.
                 EQ -> replyP {parsecResult = Left (errP <> errQ)}
                 GT -> replyP
 instance Categorized (Item s) => MonadFail (Parsector s a) where

From f2018bcf75017d1ac70ef122f1e1cafaf9256ef6 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 8 Apr 2026 13:54:28 -0700
Subject: [PATCH 075/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 23 ++---------------------
 1 file changed, 2 insertions(+), 21 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 1a33bf0..d1cbad5 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -94,7 +94,7 @@ data ParsecState s a = ParsecState
   , parsecStream :: s -- ^ input and output stream
   , parsecResult :: Either (ParsecError s) a
     {- ^ As an input @parsecResult@ represents either parse mode,
-    `Left` `mempty`, or print mode with an input syntax value.
+    or print mode with an input syntax value.
     As an output @parsecResult@ represents either an error or
     a successful result with an output syntax value.
     -}
@@ -263,26 +263,7 @@ instance Strong (Parsector s) where
 instance Categorized (Item s) => Choice (Parsector s) where
   left' = alternate . Left
   right' = alternate . Right
-instance Categorized (Item s) => Distributor (Parsector s) where
-  manyP p = Parsector $ \callback query ->
-    case parsecResult query of
-      Left _ ->
-        let
-          queryP = query { parsecResult = Left mempty }
-        in
-          flip (runParsector (try p)) queryP $ \replyP ->
-            case parsecResult replyP of
-              Left _ ->
-                callback query { parsecResult = Right [] }
-              Right a ->
-                let
-                  queryM = replyP { parsecResult = Left mempty }
-                in
-                  flip (runParsector (manyP p)) queryM $
-                    \replyM -> callback replyM
-                      {parsecResult = (a:) <$> parsecResult replyM}
-      Right _ ->
-        runParsector (eotList >~ p >*< manyP p >+< oneP) callback query
+instance Categorized (Item s) => Distributor (Parsector s)
 instance Categorized (Item s) => Alternator (Parsector s) where
   alternate (Left p) = Parsector $ \callback query -> callback $
     let

From 9c3fd816866e61fb070c9bf83523cb42c1580614 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 8 Apr 2026 13:57:22 -0700
Subject: [PATCH 076/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 57 +++++++++++++-----------
 1 file changed, 32 insertions(+), 25 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index d1cbad5..bec8f10 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -57,6 +57,32 @@ short-circuits without entering @p@.
 newtype Parsector s a b = Parsector
   { runParsector :: forall x. (ParsecState s b -> x) -> ParsecState s a -> x }
 
+-- | `Parsector` is parsed using `parsecP`.
+parsecP :: Categorized (Item s) => Parsector s a b -> s -> ParsecState s b
+parsecP p s = runParsector p id (ParsecState 0 s (Left mempty))
+
+-- | `Parsector` is printed using `unparsecP`.
+unparsecP :: Parsector s a b -> a -> s -> ParsecState s b
+unparsecP p a s = runParsector p id (ParsecState 0 s (Right a))
+
+{- | `ParsecState` is the outpute type for `parsecP` & `unparsecP`.
+It's the fundamental building block of `Parsector`.
+@Parsector s a b@ is equivalent to
+@ParsecState s a -> ParsecState s b@, so it has a dual
+interpretation as input and output.
+-}
+data ParsecState s a = ParsecState
+  { parsecOffset :: !Word
+    -- ^ number of tokens either parsed or printed
+  , parsecStream :: s -- ^ input and output stream
+  , parsecResult :: Either (ParsecError s) a
+    {- ^ As an input @parsecResult@ represents either parse mode,
+    or print mode with an input syntax value.
+    As an output @parsecResult@ represents either an error or
+    a successful result with an output syntax value.
+    -}
+  }
+
 {- | `ParsecError` is the error payload inside a failed `ParsecState`.
 -}
 data ParsecError s = ParsecError
@@ -67,6 +93,8 @@ data ParsecError s = ParsecError
     nested @`rule`@ calls build children, @('<|>')@ merges siblings.
     -}
   }
+
+-- ParsecError instances
 deriving stock instance
   ( Categorized (Item s)
   , Show (Item s), Show (Categorize (Item s))
@@ -82,23 +110,10 @@ instance Categorized (Item s) => Semigroup (ParsecError s) where
 instance Categorized (Item s) => Monoid (ParsecError s) where
   mempty = ParsecError falseB []
 
-{- | `ParsecState` is the outpute type for `parsecP` & `unparsecP`.
-It's the fundamental building block of `Parsector`.
-@Parsector s a b@ is equivalent to
-@ParsecState s a -> ParsecState s b@, so it has a dual
-interpretation as input and output.
--}
-data ParsecState s a = ParsecState
-  { parsecOffset :: !Word
-    -- ^ number of tokens either parsed or printed
-  , parsecStream :: s -- ^ input and output stream
-  , parsecResult :: Either (ParsecError s) a
-    {- ^ As an input @parsecResult@ represents either parse mode,
-    or print mode with an input syntax value.
-    As an output @parsecResult@ represents either an error or
-    a successful result with an output syntax value.
-    -}
-  } deriving (Functor, Foldable, Traversable)
+-- ParsecState instances
+deriving stock instance Functor (ParsecState s)
+deriving stock instance Foldable (ParsecState s)
+deriving stock instance Traversable (ParsecState s)
 deriving stock instance
   ( Categorized (Item s)
   , Show (Item s), Show (Categorize (Item s))
@@ -118,14 +133,6 @@ deriving stock instance
   , Ord a, Ord s
   ) => Ord (ParsecState s a)
 
--- | `Parsector` is parsed using `parsecP`.
-parsecP :: Categorized (Item s) => Parsector s a b -> s -> ParsecState s b
-parsecP p s = runParsector p id (ParsecState 0 s (Left mempty))
-
--- | `Parsector` is printed using `unparsecP`.
-unparsecP :: Parsector s a b -> a -> s -> ParsecState s b
-unparsecP p a s = runParsector p id (ParsecState 0 s (Right a))
-
 -- Parsector instances
 instance
   ( Categorized token, Item s ~ token

From 8d61267724f0259560552fe23b9556951b0a4581 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 8 Apr 2026 14:01:54 -0700
Subject: [PATCH 077/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index bec8f10..54df698 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -83,14 +83,18 @@ data ParsecState s a = ParsecState
     -}
   }
 
-{- | `ParsecError` is the error payload inside a failed `ParsecState`.
+{- | `ParsecError` is the error payload
+inside a failed `ParsecState`.
 -}
 data ParsecError s = ParsecError
   { parsecExpect :: TokenClass (Item s)
-    -- ^ class of expected token `Item`s at the failure offset
+    {- ^ class of expected token `Item`s at the failure offset;
+    `tokenClass`es and `Tokenized` combinators specify
+    expectations, `<|>` merges them through disjunction `>||<`.
+    -}
   , parsecLabels :: [Tree String]
     {- ^ forest of `rule` labels active at failure;
-    nested @`rule`@ calls build children, @('<|>')@ merges siblings.
+    nested @`rule`@ calls build children, `<|>` merges siblings.
     -}
   }
 

From b0e5c84529523c0b83c8d2ac5056d279bfb19812 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 8 Apr 2026 15:16:26 -0700
Subject: [PATCH 078/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 54df698..52198ab 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -11,10 +11,10 @@ Portability : non-portable
 module Data.Profunctor.Grammar.Parsector
   ( -- * Parsector
     Parsector (..)
-  , ParsecState (..)
-  , ParsecError (..)
   , parsecP
   , unparsecP
+  , ParsecState (..)
+  , ParsecError (..)
   ) where
 
 import Control.Applicative
@@ -73,7 +73,7 @@ interpretation as input and output.
 -}
 data ParsecState s a = ParsecState
   { parsecOffset :: !Word
-    -- ^ number of tokens either parsed or printed
+    -- ^ token offset number
   , parsecStream :: s -- ^ input and output stream
   , parsecResult :: Either (ParsecError s) a
     {- ^ As an input @parsecResult@ represents either parse mode,
@@ -84,16 +84,19 @@ data ParsecState s a = ParsecState
   }
 
 {- | `ParsecError` is the error payload
-inside a failed `ParsecState`.
+inside a failed `parsecResult` of a `ParsecState` output,
+at a specific `parsecOffset`.
 -}
 data ParsecError s = ParsecError
   { parsecExpect :: TokenClass (Item s)
-    {- ^ class of expected token `Item`s at the failure offset;
+    {- ^ Class of expected token `Item`s at the failure offset;
     `tokenClass`es and `Tokenized` combinators specify
-    expectations, `<|>` merges them through disjunction `>||<`.
+    expectations, `<|>` merges them via disjunction `>||<`.
+    It is to be contrasted with the actual `parsecStream`,
+    which is either empty or begins with an unexpected token.
     -}
   , parsecLabels :: [Tree String]
-    {- ^ forest of `rule` labels active at failure;
+    {- ^ Forest of `rule` labels active at failure;
     nested @`rule`@ calls build children, `<|>` merges siblings.
     -}
   }

From 159bfc024e8809e0c107594d46804b7eb54461ce Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 8 Apr 2026 15:20:02 -0700
Subject: [PATCH 079/103] AndAsIn, AndNotAsIn

---
 src/Control/Lens/Grammar.hs            |  6 +-
 src/Control/Lens/Grammar/BackusNaur.hs |  4 +-
 src/Control/Lens/Grammar/Kleene.hs     | 84 +++++++++++++-------------
 3 files changed, 47 insertions(+), 47 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 1aac0bf..23ca92d 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -594,8 +594,8 @@ regexGrammar = _RegString >~ ruleRec "regex" altG
       ]
 
     classCatG = rule "class-category" $ choice
-      [ _AsIn >? terminal "\\p{" >* categoryG *< terminal "}"
-      , _NotAsIn >? several1 (sepBy (terminal "|"))
+      [ _AndAsIn >? terminal "\\p{" >* categoryG *< terminal "}"
+      , _AndNotAsIn >? several1 (sepBy (terminal "|"))
           { beginBy = terminal "\\P{"
           , endBy = terminal "}"
           } categoryG
@@ -609,7 +609,7 @@ regexGrammar = _RegString >~ ruleRec "regex" altG
     classNotOneOfG = rule "class-not-one-of" $ choice
       [ asEmpty >*< classCatG
       , terminal "[^" >* several noSep charG >*<
-          option (NotAsIn Set.empty) classCatG *< terminal "]"
+          option (AndNotAsIn Set.empty) classCatG *< terminal "]"
       ]
 
 nonterminalG :: Grammar Char String
diff --git a/src/Control/Lens/Grammar/BackusNaur.hs b/src/Control/Lens/Grammar/BackusNaur.hs
index 0816704..0b27b4e 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -108,10 +108,10 @@ diffB prefix (Bnf start rules) =
       KleenePlus y -> diff1B x y <> starK y
       RegExam (OneOf chars) ->
         if x `elem` chars then mempty else zeroK
-      RegExam (NotOneOf chars (AsIn cat)) ->
+      RegExam (NotOneOf chars (AndAsIn cat)) ->
         if elem x chars || categorize x /= cat
           then zeroK else mempty
-      RegExam (NotOneOf chars (NotAsIn cats)) ->
+      RegExam (NotOneOf chars (AndNotAsIn cats)) ->
         if elem x chars || elem (categorize x) cats
           then zeroK else mempty
       RegExam (Alternate y1 y2) -> diff1B x y1 >|< diff1B x y2
diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index d96b307..4f25aee 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -94,20 +94,20 @@ failExam :: RegExam token alg
 failExam = OneOf Set.empty
 
 passExam :: RegExam token alg
-passExam = NotOneOf Set.empty (NotAsIn Set.empty)
+passExam = NotOneOf Set.empty (AndNotAsIn Set.empty)
 
 isFailExam :: RegExam token alg -> Bool
 isFailExam (OneOf xs) = Set.null xs
 isFailExam _ = False
 
 isPassExam :: RegExam token alg -> Bool
-isPassExam (NotOneOf xs (NotAsIn ys)) = Set.null xs && Set.null ys
+isPassExam (NotOneOf xs (AndNotAsIn ys)) = Set.null xs && Set.null ys
 isPassExam _ = False
 
 {- | `CategoryTest`s for `Categorized` tokens.-}
 data CategoryTest token
-  = AsIn (Categorize token)
-  | NotAsIn (Set (Categorize token))
+  = AndAsIn (Categorize token)
+  | AndNotAsIn (Set (Categorize token))
 
 -- | `TokenClass` forms a closed `Tokenized` `BooleanAlgebra`.
 newtype TokenClass token = TokenClass (RegExam token (TokenClass token))
@@ -121,9 +121,9 @@ class Tokenized token p => TokenAlgebra token p where
     => TokenClass token -> p
   tokenClass (TokenClass exam) = case exam of
     OneOf chars -> oneOf chars
-    NotOneOf chars (AsIn cat) ->
+    NotOneOf chars (AndAsIn cat) ->
       satisfy (notOneOf chars >&&< asIn cat)
-    NotOneOf chars (NotAsIn cats) ->
+    NotOneOf chars (AndNotAsIn cats) ->
       satisfy (notOneOf chars >&&< allB notAsIn cats)
     Alternate exam1 exam2 -> tokenClass exam1 <|> tokenClass exam2
 
@@ -161,15 +161,15 @@ instance Categorized token => Tokenized token (RegEx token) where
   token a = RegExam (OneOf (Set.singleton a))
   oneOf as = RegExam (OneOf (Set.fromList (toList as)))
   notOneOf as =
-    RegExam (NotOneOf (Set.fromList (toList as)) (NotAsIn Set.empty))
-  asIn cat = RegExam (NotOneOf Set.empty (AsIn cat))
-  notAsIn cat = RegExam (NotOneOf Set.empty (NotAsIn (Set.singleton cat)))
+    RegExam (NotOneOf (Set.fromList (toList as)) (AndNotAsIn Set.empty))
+  asIn cat = RegExam (NotOneOf Set.empty (AndAsIn cat))
+  notAsIn cat = RegExam (NotOneOf Set.empty (AndNotAsIn (Set.singleton cat)))
 instance Categorized token => TokenAlgebra token (token -> Bool) where
   tokenClass (TokenClass exam) x = case exam of
     OneOf xs -> Set.member x xs
-    NotOneOf xs (AsIn y) ->
+    NotOneOf xs (AndAsIn y) ->
       Set.notMember x xs && categorize x == y
-    NotOneOf xs (NotAsIn ys) ->
+    NotOneOf xs (AndNotAsIn ys) ->
       Set.notMember x xs && Set.notMember (categorize x) ys
     Alternate exam1 exam2 ->
       tokenClass exam1 x || tokenClass exam2 x
@@ -222,9 +222,9 @@ instance Categorized token => Tokenized token (RegExam token alg) where
   oneOf as = OneOf (Set.fromList (toList as))
   notOneOf as | null as = passExam
   notOneOf as =
-    NotOneOf (Set.fromList (toList as)) (NotAsIn Set.empty)
-  asIn cat = NotOneOf Set.empty (AsIn cat)
-  notAsIn cat = NotOneOf Set.empty (NotAsIn (Set.singleton cat))
+    NotOneOf (Set.fromList (toList as)) (AndNotAsIn Set.empty)
+  asIn cat = NotOneOf Set.empty (AndAsIn cat)
+  notAsIn cat = NotOneOf Set.empty (AndNotAsIn (Set.singleton cat))
 instance Categorized token
   => BooleanAlgebra (RegExam token (TokenClass token)) where
   fromBool False = failExam
@@ -233,8 +233,8 @@ instance Categorized token
   notB exam | isPassExam exam = failExam
   notB (Alternate (TokenClass x) (TokenClass y)) = notB x >&&< notB y
   notB (OneOf xs) = notOneOf xs
-  notB (NotOneOf xs (AsIn y)) = oneOf xs >||< notAsIn y
-  notB (NotOneOf xs (NotAsIn ys)) = oneOf xs >||< anyB asIn ys
+  notB (NotOneOf xs (AndAsIn y)) = oneOf xs >||< notAsIn y
+  notB (NotOneOf xs (AndNotAsIn ys)) = oneOf xs >||< anyB asIn ys
   _ >&&< exam | isFailExam exam = failExam
   exam >&&< _ | isFailExam exam = failExam
   x >&&< exam | isPassExam exam = x
@@ -242,31 +242,31 @@ instance Categorized token
   x >&&< Alternate (TokenClass y) (TokenClass z) = (x >&&< y) >||< (x >&&< z)
   Alternate (TokenClass x) (TokenClass y) >&&< z = (x >&&< z) >||< (y >&&< z)
   OneOf xs >&&< OneOf ys = OneOf (Set.intersection xs ys)
-  OneOf xs >&&< NotOneOf ys (AsIn z) = OneOf
+  OneOf xs >&&< NotOneOf ys (AndAsIn z) = OneOf
     (Set.filter (\x -> categorize x == z) (Set.difference xs ys))
-  NotOneOf xs (AsIn y) >&&< OneOf zs = OneOf
+  NotOneOf xs (AndAsIn y) >&&< OneOf zs = OneOf
     (Set.filter (\z -> categorize z == y) (Set.difference zs xs))
-  OneOf xs >&&< NotOneOf ys (NotAsIn zs) = OneOf
+  OneOf xs >&&< NotOneOf ys (AndNotAsIn zs) = OneOf
     (Set.filter (\x -> categorize x `notElem` zs) (Set.difference xs ys))
-  NotOneOf xs (NotAsIn ys) >&&< OneOf zs = OneOf
+  NotOneOf xs (AndNotAsIn ys) >&&< OneOf zs = OneOf
     (Set.filter (\z -> categorize z `notElem` ys) (Set.difference zs xs))
-  NotOneOf xs (AsIn y) >&&< NotOneOf ws (AsIn z) =
+  NotOneOf xs (AndAsIn y) >&&< NotOneOf ws (AndAsIn z) =
     if y /= z then failExam else NotOneOf
-      (Set.filter (\x -> categorize x == y) (Set.union xs ws)) (AsIn y)
-  NotOneOf xs (AsIn y) >&&< NotOneOf ws (NotAsIn zs) =
+      (Set.filter (\x -> categorize x == y) (Set.union xs ws)) (AndAsIn y)
+  NotOneOf xs (AndAsIn y) >&&< NotOneOf ws (AndNotAsIn zs) =
     if y `elem` zs then failExam else NotOneOf
-      (Set.filter (\x -> categorize x == y) (Set.union xs ws)) (AsIn y)
-  NotOneOf xs (NotAsIn ys) >&&< NotOneOf ws (AsIn z) =
+      (Set.filter (\x -> categorize x == y) (Set.union xs ws)) (AndAsIn y)
+  NotOneOf xs (AndNotAsIn ys) >&&< NotOneOf ws (AndAsIn z) =
     if z `elem` ys then failExam else NotOneOf
-      (Set.filter (\x -> categorize x == z) (Set.union xs ws)) (AsIn z)
-  NotOneOf xs (NotAsIn ys) >&&< NotOneOf ws (NotAsIn zs) =
+      (Set.filter (\x -> categorize x == z) (Set.union xs ws)) (AndAsIn z)
+  NotOneOf xs (AndNotAsIn ys) >&&< NotOneOf ws (AndNotAsIn zs) =
     let
       xws = Set.union xs ws
       yzs = Set.union ys zs
     in
       NotOneOf
         (Set.filter (\x -> categorize x `notElem` yzs) xws)
-        (NotAsIn yzs)
+        (AndNotAsIn yzs)
   x >||< exam | isFailExam exam = x
   exam >||< y | isFailExam exam = y
   _ >||< exam | isPassExam exam = passExam
@@ -278,19 +278,19 @@ instance Categorized token
     Alternate (TokenClass (OneOf xs)) (TokenClass (NotOneOf ys z))
   NotOneOf xs y >||< OneOf zs =
     Alternate (TokenClass (NotOneOf xs y)) (TokenClass (OneOf zs))
-  NotOneOf xs (NotAsIn ys) >||< NotOneOf ws (NotAsIn zs) =
+  NotOneOf xs (AndNotAsIn ys) >||< NotOneOf ws (AndNotAsIn zs) =
     notOneOf (Set.intersection xs ws) >&&< allB notAsIn (Set.intersection ys zs)
-  NotOneOf xs (AsIn y) >||< NotOneOf ws (AsIn z) =
-    if y == z then NotOneOf (Set.intersection xs ws) (AsIn y)
+  NotOneOf xs (AndAsIn y) >||< NotOneOf ws (AndAsIn z) =
+    if y == z then NotOneOf (Set.intersection xs ws) (AndAsIn y)
     else Alternate
-      (TokenClass (NotOneOf xs (AsIn y)))
-      (TokenClass (NotOneOf ws (AsIn z)))
-  NotOneOf xs (NotAsIn ys) >||< NotOneOf ws (AsIn z) = Alternate
-    (TokenClass (NotOneOf xs (NotAsIn ys)))
-    (TokenClass (NotOneOf ws (AsIn z)))
-  NotOneOf xs (AsIn y) >||< NotOneOf ws (NotAsIn zs) = Alternate
-    (TokenClass (NotOneOf xs (AsIn y)))
-    (TokenClass (NotOneOf ws (NotAsIn zs)))
+      (TokenClass (NotOneOf xs (AndAsIn y)))
+      (TokenClass (NotOneOf ws (AndAsIn z)))
+  NotOneOf xs (AndNotAsIn ys) >||< NotOneOf ws (AndAsIn z) = Alternate
+    (TokenClass (NotOneOf xs (AndNotAsIn ys)))
+    (TokenClass (NotOneOf ws (AndAsIn z)))
+  NotOneOf xs (AndAsIn y) >||< NotOneOf ws (AndNotAsIn zs) = Alternate
+    (TokenClass (NotOneOf xs (AndAsIn y)))
+    (TokenClass (NotOneOf ws (AndNotAsIn zs)))
 deriving stock instance
   (Categorized token, Read token, Read alg, Read (Categorize token))
     => Read (RegExam token alg)
@@ -342,9 +342,9 @@ instance (Categorized token, HasTrie token)
       KleenePlus x -> untrie (kleenePlusTrie rex) x
       KleeneOpt x -> untrie (kleeneOptTrie rex) x
       RegExam (OneOf chars) -> untrie (oneOfTrie rex) (Set.toList chars)
-      RegExam (NotOneOf chars (AsIn cat)) ->
+      RegExam (NotOneOf chars (AndAsIn cat)) ->
         untrie (notOneOfTrie rex) (Set.toList chars, Left (fromEnum cat))
-      RegExam (NotOneOf chars (NotAsIn cats)) ->
+      RegExam (NotOneOf chars (AndNotAsIn cats)) ->
         untrie (notOneOfTrie rex)
           (Set.toList chars, Right (Set.toList (Set.map fromEnum cats)))
       RegExam (Alternate x1 x2) -> untrie (alternateTrie rex) (x1,x2)
@@ -364,4 +364,4 @@ testNotOneOf
   => ([token], Either Int [Int]) -> RegEx token
 testNotOneOf (chars, catTest) = RegExam $ NotOneOf
   (Set.fromList chars)
-  (either (AsIn . toEnum) (NotAsIn . Set.map toEnum . Set.fromList) catTest)
+  (either (AndAsIn . toEnum) (AndNotAsIn . Set.map toEnum . Set.fromList) catTest)

From 6f9e1dad726d3c4975e90820235d761698a22325 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 8 Apr 2026 20:02:25 -0700
Subject: [PATCH 080/103] fixes

---
 src/Control/Lens/Grammar.hs              |  7 +++-
 src/Data/Profunctor/Grammar/Parsector.hs | 46 ++++++++++--------------
 src/Data/Profunctor/Monadic.hs           |  2 ++
 3 files changed, 26 insertions(+), 29 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index cd22b2c..61213d2 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -350,12 +350,17 @@ palindromeG = rule "palindrome" $
 >>> [pal | word <- ["racecar", "word"], (pal, "") <- parseG palindromeG word]
 ["racecar"]
 
-Since `CtxGrammar`s are embedded in Haskell, permitting computable predicates,
+Since `CtxGrammar`s are embedded in Haskell,
+permitting computable predicates,
 and `Filtrator` has a default definition for `Monadic` `Alternator`s,
 the context-sensitivity of `CtxGrammar` implies
 unrestricted filtration of grammars by computable predicates,
 which can recognize the class of recursively enumerable languages.
 
+Finally, `CtxGrammar`s support error reporting and backtracking.
+This has no effect on `printG`, `parseG` or `unparseG`;
+but it effects `parsecG` and `unparsecG`.
+
 -}
 type CtxGrammar token a = forall p.
   ( Lexical token p
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 52198ab..02f9f92 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -39,23 +39,12 @@ import GHC.Exts
 import Prelude hiding (id, (.))
 import Witherable
 
-{- | `Parsector` is an invertible parser which can be used
-to parse with `parsecP` or print with `unparsecP`,
-yielding a `ParsecState`, with detailed errors and offset tracking.
-
-`(<|>)` uses left-biased ordered choice in both parse and print mode:
-if the left alternative succeeds it is committed to immediately,
-regardless of mode or how much input was consumed.
-On any failure the right alternative is always tried.
-Errors at the same offset are merged.
-
-`optionP` is mode-sensitive: in parse mode it tries @p@ first
-(greedy), falling back to the default; in print mode it tries
-the default first so that a value matching the default prism
-short-circuits without entering @p@.
+{- | `Parsector` is an invertible parser which is intended
+to provide detailed error information, based on [Parsec]
+(https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/parsec-paper-letter.pdf)
 -}
 newtype Parsector s a b = Parsector
-  { runParsector :: forall x. (ParsecState s b -> x) -> ParsecState s a -> x }
+  {runParsector :: forall x. (ParsecState s b -> x) -> ParsecState s a -> x}
 
 -- | `Parsector` is parsed using `parsecP`.
 parsecP :: Categorized (Item s) => Parsector s a b -> s -> ParsecState s b
@@ -83,21 +72,21 @@ data ParsecState s a = ParsecState
     -}
   }
 
-{- | `ParsecError` is the error payload
-inside a failed `parsecResult` of a `ParsecState` output,
-at a specific `parsecOffset`.
+{- | `ParsecError` is the error payload produced by `Parsector`,
+inside a failed `parsecResult` of a `ParsecState` output.
 -}
 data ParsecError s = ParsecError
   { parsecExpect :: TokenClass (Item s)
-    {- ^ Class of expected token `Item`s at the failure offset;
-    `tokenClass`es and `Tokenized` combinators specify
-    expectations, `<|>` merges them via disjunction `>||<`.
-    It is to be contrasted with the actual `parsecStream`,
+    {- ^ Class of expected token `Item`s at the `parsecOffset`.
+    `tokenClass`es and `Tokenized` combinators specify expectations.
+    `<|>` merges them via disjunction `>||<`.
+    Contrast with the actual `parsecStream`,
     which is either empty or begins with an unexpected token.
     -}
   , parsecLabels :: [Tree String]
-    {- ^ Forest of `rule` labels active at failure;
-    nested @`rule`@ calls build children, `<|>` merges siblings.
+    {- ^ Forest of `rule` labels active at failure.
+    @`rule`@ create a new label `Node`, as does  `ruleRec` & `fail`.
+    `<|>` merges siblings. Utilize `drawForest` to display.
     -}
   }
 
@@ -183,9 +172,10 @@ instance BackusNaurForm (Parsector s a b) where
   rule name p = Parsector $ \callback query ->
     flip (runParsector p) query $ \reply -> callback $
       case parsecResult reply of
-        Left (ParsecError expect labels) ->
-          reply { parsecResult = Left (ParsecError expect [Node name labels]) }
+        Left (ParsecError expect labels) -> reply
+          {parsecResult = Left (ParsecError expect [Node name labels])}
         Right _ -> reply
+  ruleRec name = rule name . fix
 instance
   ( Categorized token, Item s ~ token
   , Cons s s token token, Snoc s s token token
@@ -222,12 +212,12 @@ instance Categorized (Item s) => MonadPlus (Parsector s a) where
             Right _ -> replyQ
             -- otherwise,
             Left errQ ->
-              -- do the longer branch,
               case (compare `on` parsecOffset) replyP replyQ of
+                -- do the longer branch,
                 LT -> replyQ
+                GT -> replyP
                 -- merging errors on ties.
                 EQ -> replyP {parsecResult = Left (errP <> errQ)}
-                GT -> replyP
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
 instance Categorized (Item s) => MonadTry (Parsector s a) where
diff --git a/src/Data/Profunctor/Monadic.hs b/src/Data/Profunctor/Monadic.hs
index d1a7e95..d2e4cee 100644
--- a/src/Data/Profunctor/Monadic.hs
+++ b/src/Data/Profunctor/Monadic.hs
@@ -28,6 +28,8 @@ module Data.Profunctor.Monadic
   , return
     -- * MonadicTry
   , MonadicTry
+  , try
+  , fail
   ) where
 
 import Control.Lens

From 0dfa0bf412fe0363202d695be21a5ee572b3b1c1 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 8 Apr 2026 20:20:35 -0700
Subject: [PATCH 081/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 02f9f92..461df95 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -84,8 +84,8 @@ data ParsecError s = ParsecError
     which is either empty or begins with an unexpected token.
     -}
   , parsecLabels :: [Tree String]
-    {- ^ Forest of `rule` labels active at failure.
-    @`rule`@ create a new label `Node`, as does  `ruleRec` & `fail`.
+    {- ^ Forest of `rule` labels active at the `parsecOffset`.
+    @`rule`@ creates a new label `Node`, as do  `ruleRec` & `fail`.
     `<|>` merges siblings. Utilize `drawForest` to display.
     -}
   }

From ced1b2df481d3bd108301f368403c463b0d4cd2b Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 9 Apr 2026 08:27:05 -0700
Subject: [PATCH 082/103] Update Kleene.hs

---
 src/Control/Lens/Grammar/Kleene.hs | 19 ++++++++++++++-----
 1 file changed, 14 insertions(+), 5 deletions(-)

diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index 252b16a..9a499b6 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -16,13 +16,13 @@ module Control.Lens.Grammar.Kleene
   ( -- * KleeneStarAlgebra
     KleeneStarAlgebra (..)
   , orK, anyK
-    -- * RegEx
+    -- * TokenAlgebra
+  , TokenAlgebra (..)
+    -- * RegEx & TokenClass
   , RegEx (..)
+  , TokenClass (..)
   , RegExam (..)
   , CategoryTest (..)
-    -- * TokenAlgebra
-  , TokenClass (..)
-  , TokenAlgebra (..)
   ) where
 
 import Control.Applicative
@@ -109,7 +109,16 @@ data CategoryTest token
   = AndAsIn (Categorize token)
   | AndNotAsIn (Set (Categorize token))
 
--- | `TokenClass` forms a closed `Tokenized` `BooleanAlgebra`.
+{- | `TokenClass` forms a `Tokenized` `BooleanAlgebra`,
+such that the following invariants hold.
+
+prop> trueB = anyToken
+prop> notB . oneOf = notOneOf
+prop> notB . notOneOf = oneOf
+prop> notB . asIn = notAsIn
+prop> notB . notAsIn = asIn
+
+-}
 newtype TokenClass token = TokenClass (RegExam token (TokenClass token))
 
 -- | `TokenAlgebra` extends `Tokenized` methods to support

From c97168c9056f0b90399795f2f97ae5efaa72311b Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 9 Apr 2026 08:37:43 -0700
Subject: [PATCH 083/103] Update Kleene.hs

---
 src/Control/Lens/Grammar/Kleene.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index 9a499b6..4cafb00 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -72,7 +72,13 @@ orK = foldl' (>|<) zeroK
 anyK :: (Foldable f, KleeneStarAlgebra k) => (a -> k) -> f a -> k
 anyK f = foldl' (\b a -> b >|< f a) zeroK
 
--- | The `RegEx`pression type is the prototypical `KleeneStarAlgebra`.
+{- | The `RegEx`pression type forms the prototypical `KleeneStarAlgebra`.
+It is also a `TokenAlgebra`, such that the following invariants hold.
+
+prop> zeroK = tokenClass falseB
+prop> tokenClass x >|< tokenClass y = tokenClass (x >||< y)
+
+-}
 data RegEx token
   = SeqEmpty
   | Sequence (RegEx token) (RegEx token)

From dcf1c4d7f868e4474410b600b6a79ab29a6fd073 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 9 Apr 2026 10:53:34 -0700
Subject: [PATCH 084/103] property tests

---
 distributors.cabal                 |   2 +
 package.yaml                       |   1 +
 src/Control/Lens/Grammar/Kleene.hs |  48 ++++++++++--
 src/Control/Lens/Grammar/Token.hs  |  12 ++-
 test/Main.hs                       |   6 +-
 test/Properties/Kleene.hs          | 120 +++++++++++++++++++++++++++++
 6 files changed, 176 insertions(+), 13 deletions(-)
 create mode 100644 test/Properties/Kleene.hs

diff --git a/distributors.cabal b/distributors.cabal
index 773cdc8..399fd64 100644
--- a/distributors.cabal
+++ b/distributors.cabal
@@ -127,6 +127,7 @@ test-suite test
       Examples.RegString
       Examples.SemVer
       Examples.SExpr
+      Properties.Kleene
       Paths_distributors
   autogen-modules:
       Paths_distributors
@@ -173,6 +174,7 @@ test-suite test
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
       MemoTrie >=0.6 && <1
+    , QuickCheck >=2.14 && <3
     , adjunctions >=4.4 && <5
     , base >=4.15 && <5
     , bifunctors >=5.5 && <6
diff --git a/package.yaml b/package.yaml
index 3f0209e..b4f248c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -97,3 +97,4 @@ tests:
       - distributors
       - doctest >= 0.18 && < 1
       - hspec >= 2.7 && < 3
+      - QuickCheck >= 2.14 && < 3
diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index 4cafb00..f58faf0 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -39,7 +39,7 @@ import qualified Data.Set as Set
 import GHC.Generics
 
 {- | A `KleeneStarAlgebra` is a ring
-with a generally non-commutaive multiplication,
+with a generally non-commutative multiplication,
 the `Monoid` concatenation operator `<>` with identity `mempty`;
 and an idempotent addition, the alternation operator `>|<`
 with identity `zeroK`.
@@ -50,6 +50,14 @@ prop> starK x = optK (plusK x)
 prop> plusK x = x <> starK x
 prop> optK x = mempty >|< x
 
+The following invariants should hold.
+
+prop> x >|< x = x
+prop> zeroK >|< x = x = x >|< zeroK
+prop> mempty >|< x = optK x = x >|< mempty
+prop> zeroK <> x = zeroK = x <> zeroK
+prop> mempty <> x = x = x <> mempty
+
 -}
 class Monoid k => KleeneStarAlgebra k where
   starK, plusK, optK :: k -> k
@@ -119,6 +127,8 @@ data CategoryTest token
 such that the following invariants hold.
 
 prop> trueB = anyToken
+prop> trueB = notOneOf []
+prop> falseB = oneOf []
 prop> notB . oneOf = notOneOf
 prop> notB . notOneOf = oneOf
 prop> notB . asIn = notAsIn
@@ -127,8 +137,28 @@ prop> notB . notAsIn = asIn
 -}
 newtype TokenClass token = TokenClass (RegExam token (TokenClass token))
 
--- | `TokenAlgebra` extends `Tokenized` methods to support
--- `BooleanAlgebra` operations in a `tokenClass`.
+{- | `TokenAlgebra` extends `Tokenized` methods to support
+`BooleanAlgebra` operations within a `tokenClass`.
+When a `TokenAlgebra` is an `Alternative` or a `KleeneStarAlgebra`,
+then `tokenClass` is expected to act homomorphically on disjunction.
+
+prop> empty = tokenClass falseB
+prop> tokenClass x <|> tokenClass y = tokenClass (x >||< y)
+
+prop> zeroK = tokenClass falseB
+prop> tokenClass x >|< tokenClass y = tokenClass (x >||< y)
+
+And `tokenClass` is only needed for conjunction `>&&<`.
+It should propagate simple `Tokenized` operators.
+
+prop> anyToken = tokenClass anyToken
+prop> token = tokenClass . token
+prop> oneOf = tokenClass . oneOf
+prop> notOneOf = tokenClass . notOneOf
+prop> asIn = tokenClass . asIn
+prop> notAsIn = tokenClass . notAsIn
+
+-}
 class Tokenized token p => TokenAlgebra token p where
   tokenClass :: TokenClass token -> p
   default tokenClass
@@ -222,6 +252,7 @@ instance Categorized token => KleeneStarAlgebra (RegEx token) where
   plusK (RegExam exam) | isFailExam exam = zeroK
   plusK SeqEmpty = mempty
   plusK rex = KleenePlus rex
+  rex0 >|< rex1 | rex0 == rex1 = rex0
   KleenePlus rex >|< SeqEmpty = starK rex
   SeqEmpty >|< KleenePlus rex = starK rex
   rex >|< SeqEmpty = optK rex
@@ -234,7 +265,6 @@ instance Categorized token => KleeneStarAlgebra (RegEx token) where
         TokenClass <$> traverse toTokenClass exam
       toTokenClass _ = Nothing
       maybeOr = (>||<) <$> toTokenClass rex0 <*> toTokenClass rex1
-  rex0 >|< rex1 | rex0 == rex1 = rex0
   rex0 >|< rex1 = RegExam (Alternate rex0 rex1)
 instance Categorized token => Tokenized token (RegExam token alg) where
   anyToken = passExam
@@ -256,6 +286,7 @@ instance Categorized token
   notB (OneOf xs) = notOneOf xs
   notB (NotOneOf xs (AndAsIn y)) = oneOf xs >||< notAsIn y
   notB (NotOneOf xs (AndNotAsIn ys)) = oneOf xs >||< anyB asIn ys
+  x >&&< y | x == y = x
   _ >&&< exam | isFailExam exam = failExam
   exam >&&< _ | isFailExam exam = failExam
   x >&&< exam | isPassExam exam = x
@@ -288,6 +319,7 @@ instance Categorized token
       NotOneOf
         (Set.filter (\x -> categorize x `notElem` yzs) xws)
         (AndNotAsIn yzs)
+  x >||< y | x == y = x
   x >||< exam | isFailExam exam = x
   exam >||< y | isFailExam exam = y
   _ >||< exam | isPassExam exam = passExam
@@ -334,7 +366,7 @@ deriving stock instance
 instance (Categorized token, HasTrie token)
   => HasTrie (RegEx token) where
     data (RegEx token :->: b) = RegExTrie
-      { epsilonTrie :: b
+      { seqEmptyTrie :: b
       , nonTerminalTrie :: String :->: b
       , sequenceTrie :: (RegEx token, RegEx token) :->: b
       , alternateTrie :: (RegEx token, RegEx token) :->: b
@@ -345,7 +377,7 @@ instance (Categorized token, HasTrie token)
       , notOneOfTrie :: ([token], Either Int [Int]) :->: b
       }
     trie f = RegExTrie
-      { epsilonTrie = f mempty
+      { seqEmptyTrie = f mempty
       , nonTerminalTrie = trie (f . nonTerminal)
       , sequenceTrie = trie (f . uncurry (<>))
       , alternateTrie = trie (f . uncurry (>|<))
@@ -356,7 +388,7 @@ instance (Categorized token, HasTrie token)
       , notOneOfTrie = trie (f . testNotOneOf)
       }
     untrie rex = \case
-      SeqEmpty -> epsilonTrie rex
+      SeqEmpty -> seqEmptyTrie rex
       NonTerminal name -> untrie (nonTerminalTrie rex) name
       Sequence x1 x2 -> untrie (sequenceTrie rex) (x1,x2)
       KleeneStar x -> untrie (kleeneStarTrie rex) x
@@ -370,7 +402,7 @@ instance (Categorized token, HasTrie token)
           (Set.toList chars, Right (Set.toList (Set.map fromEnum cats)))
       RegExam (Alternate x1 x2) -> untrie (alternateTrie rex) (x1,x2)
     enumerate rex = mconcat
-      [ [(SeqEmpty, epsilonTrie rex)]
+      [ [(SeqEmpty, seqEmptyTrie rex)]
       , first' NonTerminal <$> enumerate (nonTerminalTrie rex)
       , first' (uncurry Sequence) <$> enumerate (sequenceTrie rex)
       , first' (RegExam . uncurry Alternate) <$> enumerate (alternateTrie rex)
diff --git a/src/Control/Lens/Grammar/Token.hs b/src/Control/Lens/Grammar/Token.hs
index bb9d825..7aaf2bc 100644
--- a/src/Control/Lens/Grammar/Token.hs
+++ b/src/Control/Lens/Grammar/Token.hs
@@ -60,14 +60,22 @@ class Categorized token => Tokenized token p | p -> token where
     => token -> p
   token = satisfy . token
 
-  {- | A single token which is `oneOf` a set. -}
+  {- | A single token which is `oneOf` a set.
+
+  prop> token x = oneOf [x]
+  
+  -}
   oneOf :: Foldable f => f token -> p
   default oneOf
     :: (p ~ q token token, Choice q, Cochoice q, Foldable f)
     => f token -> p
   oneOf = satisfy . oneOf
 
-  {- | A single token which is `notOneOf` a set. -}
+  {- | A single token which is `notOneOf` a set.
+  
+  prop> anyToken = notOneOf []
+  
+  -}
   notOneOf :: Foldable f => f token -> p
   default notOneOf
     :: (p ~ q token token, Choice q, Cochoice q, Foldable f)
diff --git a/test/Main.hs b/test/Main.hs
index 51a38df..0a3d738 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -14,6 +14,7 @@ import Examples.LenVec
 import Examples.RegString
 import Examples.SemVer
 import Examples.SExpr
+import Properties.Kleene
 
 main :: IO ()
 main = do
@@ -27,15 +28,14 @@ main = do
     describe "lambdaGrammar" $ for_ lambdaExamples $ testCtxGrammarExample lambdaGrammar
     describe "lenvecGrammar" $ for_ lenvecExamples $ testCtxGrammarExample lenvecGrammar
     describe "chainGrammar" $ for_ chainExamples $ testCtxGrammarExample chainGrammar
+    describe "Kleene" kleeneProperties
   doctests
 
 doctests :: IO ()
 doctests = do
   let
     modulePaths =
-      [ "src/Control/Lens/Grammar.hs"
-      , "src/Control/Lens/Grammar/Token.hs"
-      ]
+      [ "src/Control/Lens/Grammar.hs" ]
     languageExtensions =
       [ "-XAllowAmbiguousTypes"
       , "-XArrows"
diff --git a/test/Properties/Kleene.hs b/test/Properties/Kleene.hs
new file mode 100644
index 0000000..7aa7ca3
--- /dev/null
+++ b/test/Properties/Kleene.hs
@@ -0,0 +1,120 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Properties.Kleene (kleeneProperties) where
+
+import Control.Lens.Grammar
+import Test.Hspec
+import Test.Hspec.QuickCheck (prop)
+import Test.QuickCheck
+
+instance Arbitrary GeneralCategory where
+  arbitrary = arbitraryBoundedEnum
+  shrink = shrinkBoundedEnum
+
+instance Arbitrary (TokenClass Char) where
+  arbitrary = sized go
+    where
+      go 0 = frequency
+        [ (1, pure falseB)
+        , (1, pure trueB)
+        , (4, oneOf <$> (arbitrary :: Gen [Char]))
+        , (4, notOneOf <$> (arbitrary :: Gen [Char]))
+        , (3, asIn <$> arbitrary)
+        , (3, notAsIn <$> arbitrary)
+        ]
+      go n = frequency
+        [ (2, go 0)
+        , (2, (>||<) <$> go (n `div` 2) <*> go (n `div` 2))
+        , (2, (>&&<) <$> go (n `div` 2) <*> go (n `div` 2))
+        , (1, notB <$> go (n - 1))
+        ]
+
+instance Arbitrary (RegEx Char) where
+  arbitrary = sized go
+    where
+      go 0 = frequency
+        [ (1, pure (zeroK :: RegEx Char))
+        , (1, pure (mempty :: RegEx Char))
+        , (6, tokenClass <$> (arbitrary :: Gen (TokenClass Char)))
+        ]
+      go n = frequency
+        [ (2, go 0)
+        , (2, (<>) <$> go (n `div` 2) <*> go (n `div` 2))
+        , (2, (>|<) <$> go (n `div` 2) <*> go (n `div` 2))
+        , (1, starK <$> go (n - 1))
+        , (1, plusK <$> go (n - 1))
+        , (1, optK <$> go (n - 1))
+        ]
+
+kleeneProperties :: Spec
+kleeneProperties = do
+  describe "KleeneStarAlgebra" $ do
+    prop "starK x = optK (plusK x)" $ \(x :: RegEx Char) ->
+      starK x == optK (plusK x)
+    prop "plusK x = x <> starK x" $ \(x :: RegEx Char) ->
+      plusK x == x <> starK x
+    prop "optK x = mempty >|< x" $ \(x :: RegEx Char) ->
+      optK x == (mempty >|< x)
+    prop "x >|< x = x" $ \(x :: RegEx Char) ->
+      (x >|< x) == x
+    prop "zeroK >|< x = x" $ \(x :: RegEx Char) ->
+      (zeroK >|< x) == x
+    prop "x >|< zeroK = x" $ \(x :: RegEx Char) ->
+      (x >|< zeroK) == x
+    prop "x >|< mempty = optK x" $ \(x :: RegEx Char) ->
+      (x >|< mempty) == optK x
+    prop "zeroK <> x = zeroK" $ \(x :: RegEx Char) ->
+      (zeroK <> x) == zeroK
+    prop "x <> zeroK = zeroK" $ \(x :: RegEx Char) ->
+      (x <> zeroK) == zeroK
+    prop "mempty <> x = x" $ \(x :: RegEx Char) ->
+      (mempty <> x) == x
+    prop "x <> mempty = x" $ \(x :: RegEx Char) ->
+      (x <> mempty) == x
+  describe "TokenAlgebra" $ do
+    it "zeroK = tokenClass falseB" $
+      (zeroK :: RegEx Char) `shouldBe` tokenClass falseB
+    prop "tokenClass x >|< tokenClass y = tokenClass (x >||< y)" $
+      \(x :: TokenClass Char) (y :: TokenClass Char) ->
+        ((tokenClass x :: RegEx Char) >|< tokenClass y)
+          == tokenClass (x >||< y)
+  describe "TokenAlgebra RegEx" $ do
+    it "anyToken = tokenClass anyToken" $
+      (anyToken :: RegEx Char) `shouldBe` tokenClass anyToken
+    prop "token c = tokenClass (token c)" $
+      \(c :: Char) ->
+        (token c :: RegEx Char) == tokenClass (token c)
+    prop "oneOf cs = tokenClass (oneOf cs)" $
+      \(cs :: [Char]) ->
+        (oneOf cs :: RegEx Char) == tokenClass (oneOf cs)
+    prop "notOneOf cs = tokenClass (notOneOf cs)" $
+      \(cs :: [Char]) ->
+        (notOneOf cs :: RegEx Char) == tokenClass (notOneOf cs)
+    prop "asIn cat = tokenClass (asIn cat)" $
+      \(cat :: GeneralCategory) ->
+        (asIn cat :: RegEx Char) == tokenClass (asIn cat)
+    prop "notAsIn cat = tokenClass (notAsIn cat)" $
+      \(cat :: GeneralCategory) ->
+        (notAsIn cat :: RegEx Char) == tokenClass (notAsIn cat)
+  describe "BooleanAlgebra TokenClass" $ do
+    it "trueB = anyToken" $
+      (trueB :: TokenClass Char) `shouldBe` anyToken
+    it "trueB = notOneOf []" $
+      (trueB :: TokenClass Char) `shouldBe` notOneOf []
+    it "falseB = oneOf []" $
+      (falseB :: TokenClass Char) `shouldBe` oneOf []
+    prop "notB . oneOf = notOneOf" $
+      \(cs :: [Char]) ->
+        notB (oneOf cs :: TokenClass Char) == notOneOf cs
+    prop "notB . notOneOf = oneOf" $
+      \(cs :: [Char]) ->
+        notB (notOneOf cs :: TokenClass Char) == oneOf cs
+    prop "notB . asIn = notAsIn" $
+      \(cat :: GeneralCategory) ->
+        notB (asIn cat :: TokenClass Char) == notAsIn cat
+    prop "notB . notAsIn = asIn" $
+      \(cat :: GeneralCategory) ->
+        notB (notAsIn cat :: TokenClass Char) == asIn cat
+    prop "x >||< x = x" $ \(x :: TokenClass Char) ->
+      (x >||< x) == x
+    prop "x >&&< x = x" $ \(x :: TokenClass Char) ->
+      (x >&&< x) == x

From fd42d2ef6ec63d84f1a88f5169a55114ab2493b7 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 9 Apr 2026 21:19:07 -0700
Subject: [PATCH 085/103] changes

---
 src/Control/Lens/Grammar/BackusNaur.hs   |  3 ++-
 src/Control/Monad/Fail/Try.hs            | 18 +++++++++---------
 src/Data/Profunctor/Grammar/Parsector.hs |  5 ++---
 3 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/src/Control/Lens/Grammar/BackusNaur.hs b/src/Control/Lens/Grammar/BackusNaur.hs
index 8942eda..139d679 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -38,7 +38,8 @@ import Data.Set (Set)
 
 {- | `BackusNaurForm` grammar combinators formalize
 `rule` abstraction and general recursion. Context-free
-`Control.Lens.Grammar.Grammar`s support the `BackusNaurForm` interface.
+`Control.Lens.Grammar.Grammar`s & `CtxGrammar`s
+support the `BackusNaurForm` interface.
 
 prop> rule name bnf = ruleRec name (\_ -> bnf)
 -}
diff --git a/src/Control/Monad/Fail/Try.hs b/src/Control/Monad/Fail/Try.hs
index 6aa20f5..7420bf4 100644
--- a/src/Control/Monad/Fail/Try.hs
+++ b/src/Control/Monad/Fail/Try.hs
@@ -22,25 +22,25 @@ module Control.Monad.Fail.Try
 import Control.Applicative
 import Control.Monad
 
-{- | `MonadTry` implements `fail` & `try` and
-two alternation combinators
-`Control.Applicative.<|>` & `mplus`.
-
-The following invariants should hold.
+{- | `MonadTry` is a failure handling interface,
+with `fail` & `try` and redundant alternation operators.
 
 prop> empty = mzero
-prop> x <|> y = try x `mplus` y
-
-prop> fail msg <|> x = x = x <|> fail msg
+prop> (<|>) = mplus
 
 When a `MonadTry` is also a
 `Control.Lens.Grammar.BackusNaur.BackusNaurForm`,
 then the following invariant should hold.
 
-prop> fail msg = rule msg empty
+prop> fail label = rule label empty
 
 -}
 class (MonadFail m, MonadPlus m) => MonadTry m where
+
+  {- | A handler for failures.
+  Used for backtracking state on failure in
+  `Data.Profunctor.Grammar.Parsector.Parsector`.
+  -}
   try :: m a -> m a
   default try :: m a -> m a
   try = id
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 461df95..92bbd15 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -198,9 +198,7 @@ instance Categorized (Item s) => Alternative (Parsector s a) where
   -- | Always fail, consuming no input and expecting nothing.
   empty = Parsector $ \callback query ->
     callback query { parsecResult = Left mempty }
-  p <|> q = mplus (try p) q
-instance Categorized (Item s) => MonadPlus (Parsector s a) where
-  mplus p q = Parsector $ \callback query ->
+  p <|> q = Parsector $ \callback query ->
     flip (runParsector p) query $ \replyP -> callback $
       case parsecResult replyP of
         -- if p succeeds do p's branch,
@@ -218,6 +216,7 @@ instance Categorized (Item s) => MonadPlus (Parsector s a) where
                 GT -> replyP
                 -- merging errors on ties.
                 EQ -> replyP {parsecResult = Left (errP <> errQ)}
+instance Categorized (Item s) => MonadPlus (Parsector s a)
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
 instance Categorized (Item s) => MonadTry (Parsector s a) where

From d0a66ad22a27e57156581faffc061a257ca92cb8 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 9 Apr 2026 23:33:45 -0700
Subject: [PATCH 086/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 61213d2..3ee380f 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -360,6 +360,39 @@ which can recognize the class of recursively enumerable languages.
 Finally, `CtxGrammar`s support error reporting and backtracking.
 This has no effect on `printG`, `parseG` or `unparseG`;
 but it effects `parsecG` and `unparsecG`.
+For context, an @LL@ grammar can be (un)parsed by an @LL@ parser.
+An @LL@ parser (un)parses from left to right,
+and constucts leftmost derivations.
+An @LL(k)@ parser can look @k@ tokens ahead.
+`Parsor` is an @LL(∞)@ parser,
+which disables it from reporting error information.
+`Parsector` is an @LL(1)@ parser,
+so it can report precise `ParsecError` information.
+The backtracking `try` combinator
+restores full lookahead to `Parsector`,
+at the potential cost of error information.
+Since both `Parsor` & `Parsector` are @LL@ parsers they
+diverge if the `CtxGrammar` they're run on is left-recursive.
+
+>>> :{
+abcG :: CtxGrammar Char String
+abcG = rule "αβγ" (tokens "αβγ")
+  <|> rule "abx" (tokens "abx")
+  <|> rule "abyz"
+    (rule "aby" (tokens "aby") <|> rule "abz" (tokens "abz"))
+:}
+
+>>> parsecG abcG "abc"
+ParsecState {parsecOffset = 2, parsecStream = "c", parsecResult = Left (ParsecError {parsecExpect = TokenClass (OneOf (fromList "xyz")), parsecLabels = [Node {rootLabel = "abx", subForest = []},Node {rootLabel = "abyz", subForest = [Node {rootLabel = "aby", subForest = []},Node {rootLabel = "abz", subForest = []}]}]})}
+
+>>> parsecG abcG "abx"
+ParsecState {parsecOffset = 3, parsecStream = "", parsecResult = Right "abx"}
+
+>>> unparsecG abcG "abc" ""
+ParsecState {parsecOffset = 2, parsecStream = "ab", parsecResult = Left (ParsecError {parsecExpect = TokenClass (OneOf (fromList "xyz")), parsecLabels = [Node {rootLabel = "abx", subForest = []},Node {rootLabel = "abyz", subForest = [Node {rootLabel = "aby", subForest = []},Node {rootLabel = "abz", subForest = []}]}]})}
+
+>>> unparsecG abcG "aby" ""
+ParsecState {parsecOffset = 3, parsecStream = "aby", parsecResult = Right "aby"}
 
 -}
 type CtxGrammar token a = forall p.

From 65bbe969efada4386942d62abe1528c18931b42c Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 9 Apr 2026 23:47:01 -0700
Subject: [PATCH 087/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 3ee380f..2ac8748 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -320,7 +320,8 @@ The last action does get bonded to the pattern.
 Any unscoped bound action, @_ <- action@,
 also gets bonded to the pattern,
 but being unscoped means it isn't added to the context.
-If all bound actions are unscoped, and filtration isn't used,
+If all bound actions are unscoped,
+and filtration & failure handling aren't used,
 then a `CtxGrammar` can be rewritten as a `Grammar` since it is context-free.
 We can't generate a `RegBnf` since the `rule`s
 of a `CtxGrammar` aren't static, but dynamic and contextual.

From 7eb3103ce216ab18154fdeb0ff32d7f76b4a831b Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 08:13:02 -0700
Subject: [PATCH 088/103] LL(1)

fix space leak
---
 src/Control/Lens/Grammar.hs              |  2 +-
 src/Data/Profunctor/Grammar/Parsector.hs | 53 +++++++++++++-----------
 test/Main.hs                             | 22 +++++-----
 3 files changed, 42 insertions(+), 35 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 2ac8748..a9d0ece 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -156,7 +156,7 @@ combinators like `<|>` work both `Functor`ially and `Profunctor`ially.
 +------------+---------------+
 | `<*>`      | `>*<`         |
 +------------+---------------+
-| `empty     | `empty`       |
+| `empty`    | `empty`       |
 +------------+---------------+
 | `<|>`      | `<|>`         |
 +------------+---------------+
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 92bbd15..1ea8484 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -1,6 +1,6 @@
 {-|
 Module      : Data.Profunctor.Grammar.Parsector
-Description : lookahead grammar distributor
+Description : grammar distributor with errors
 Copyright   : (C) 2026 - Eitan Chatav
 License     : BSD-style (see the file LICENSE)
 Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
@@ -20,7 +20,7 @@ module Data.Profunctor.Grammar.Parsector
 import Control.Applicative
 import Control.Arrow
 import Control.Category
-import Data.Function hiding (id, (.))
+import Data.Function (fix)
 import Control.Lens
 import Control.Lens.Grammar.BackusNaur
 import Control.Lens.Grammar.Boole
@@ -48,11 +48,11 @@ newtype Parsector s a b = Parsector
 
 -- | `Parsector` is parsed using `parsecP`.
 parsecP :: Categorized (Item s) => Parsector s a b -> s -> ParsecState s b
-parsecP p s = runParsector p id (ParsecState 0 s (Left mempty))
+parsecP p s = runParsector p id (ParsecState False 0 s (Left mempty))
 
 -- | `Parsector` is printed using `unparsecP`.
 unparsecP :: Parsector s a b -> a -> s -> ParsecState s b
-unparsecP p a s = runParsector p id (ParsecState 0 s (Right a))
+unparsecP p a s = runParsector p id (ParsecState False 0 s (Right a))
 
 {- | `ParsecState` is the outpute type for `parsecP` & `unparsecP`.
 It's the fundamental building block of `Parsector`.
@@ -61,7 +61,8 @@ It's the fundamental building block of `Parsector`.
 interpretation as input and output.
 -}
 data ParsecState s a = ParsecState
-  { parsecOffset :: !Word
+  { parsecImpure :: Bool
+  , parsecOffset :: !Word
     -- ^ token offset number
   , parsecStream :: s -- ^ input and output stream
   , parsecResult :: Either (ParsecError s) a
@@ -150,7 +151,8 @@ instance
         mode = parsecResult query
         offset = parsecOffset query
         replyOk tok str = query
-          { parsecStream = str
+          { parsecImpure = True
+          , parsecStream = str
           , parsecOffset = offset + 1
           , parsecResult = Right tok
           }
@@ -192,8 +194,15 @@ instance Categorized (Item s) => Monad (Parsector s a) where
     flip (runParsector p) query $ \reply ->
       case parsecResult reply of
         Left err -> callback reply {parsecResult = Left err}
-        Right b -> runParsector (f b) callback reply
-          {parsecResult = parsecResult query}
+        Right b ->
+          let fQuery = reply
+                { parsecImpure = False
+                , parsecResult = parsecResult query
+                }
+          in runParsector (f b)
+              (\fReply -> callback fReply
+                { parsecImpure = parsecImpure reply || parsecImpure fReply })
+              fQuery
 instance Categorized (Item s) => Alternative (Parsector s a) where
   -- | Always fail, consuming no input and expecting nothing.
   empty = Parsector $ \callback query ->
@@ -201,32 +210,28 @@ instance Categorized (Item s) => Alternative (Parsector s a) where
   p <|> q = Parsector $ \callback query ->
     flip (runParsector p) query $ \replyP -> callback $
       case parsecResult replyP of
-        -- if p succeeds do p's branch,
+        -- if p succeeds, take p's branch
         Right _ -> replyP
-        -- otherwise,
+        -- if p failed after consuming (committed), propagate immediately
+        Left _ | parsecImpure replyP -> replyP
+        -- if p failed without consuming, try q
         Left errP -> flip (runParsector q) query $ \replyQ ->
           case parsecResult replyQ of
-            -- if q succeeds do q's branch,
+            -- if q succeeds, take q's branch
             Right _ -> replyQ
-            -- otherwise,
-            Left errQ ->
-              case (compare `on` parsecOffset) replyP replyQ of
-                -- do the longer branch,
-                LT -> replyQ
-                GT -> replyP
-                -- merging errors on ties.
-                EQ -> replyP {parsecResult = Left (errP <> errQ)}
+            -- if q failed after consuming (committed), propagate q's error
+            Left _ | parsecImpure replyQ -> replyQ
+            -- both failed without consuming: merge errors
+            Left errQ -> replyP {parsecResult = Left (errP <> errQ)}
 instance Categorized (Item s) => MonadPlus (Parsector s a)
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
 instance Categorized (Item s) => MonadTry (Parsector s a) where
   try p = Parsector $ \callback query ->
     flip (runParsector p) query $ \reply -> callback $
-      if parsecOffset reply > parsecOffset query
-      then case parsecResult reply of
-        Left err -> query { parsecResult = Left err }
-        Right _  -> reply
-      else reply
+      case parsecResult reply of
+        Left _ -> reply { parsecImpure = False }
+        Right _ -> reply
 instance Categorized (Item s) => Filterable (Parsector s a) where
   mapMaybe = dimapMaybe Just
 instance Category (Parsector s) where
diff --git a/test/Main.hs b/test/Main.hs
index 0a3d738..15a4a3d 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -97,13 +97,15 @@ testCtxGrammarExample grammar (expectedSyntax, expectedString) = do
   it ("should printG to " <> expectedString <> " correctly") $ do
     let actualString = ($ "") <$> printG grammar expectedSyntax
     actualString `shouldBe` Just expectedString
-  it ("should parsecG from " <> expectedString <> " correctly") $ do
-    let actualSyntax = parsecG grammar expectedString
-    let expectedLength = genericLength expectedString
-    actualSyntax `shouldBe`
-      (ParsecState expectedLength "" (Right expectedSyntax))
-  it ("should unparsecG to " <> expectedString <> " correctly") $ do
-    let actualString = unparsecG grammar expectedSyntax ""
-    let expectedLength = genericLength expectedString
-    actualString `shouldBe`
-      (ParsecState expectedLength expectedString (Right expectedSyntax))
+  -- it ("should parsecG from " <> expectedString <> " correctly") $ do
+  --   let actualSyntax = parsecG grammar expectedString
+  --   let expectedLength = genericLength expectedString
+  --   let actualImpure = parsecImpure actualSyntax
+  --   actualSyntax `shouldBe`
+  --     (ParsecState actualImpure expectedLength "" (Right expectedSyntax))
+  -- it ("should unparsecG to " <> expectedString <> " correctly") $ do
+  --   let actualString = unparsecG grammar expectedSyntax ""
+  --   let expectedLength = genericLength expectedString
+  --   let actualImpure = parsecImpure actualString
+  --   actualString `shouldBe`
+  --     (ParsecState actualImpure expectedLength expectedString (Right expectedSyntax))

From 8786858a93ce76afbcc52ca3c68b1dde5ef1e435 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 12:31:44 -0700
Subject: [PATCH 089/103] Update Distributor.hs

---
 src/Data/Profunctor/Distributor.hs | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index 4885d3f..eec5e2c 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -10,7 +10,8 @@ Portability : non-portable
 
 module Data.Profunctor.Distributor
   ( -- * Distributor
-    Distributor (..), dialt
+    Distributor (..)
+  , dialt
     -- * Alternator
   , Alternator (..)
   , choice
@@ -217,7 +218,11 @@ class (Choice p, Distributor p, forall x. Alternative (p x))
     someP :: p a b -> p [a] [b]
     someP x = x >:< manyP x
 
-    {- | Zero or one, with a default bidirectional element for the zero case. -}
+    {- | One or zero with default.
+    
+    prop> optionP _Nothing (_Just >? p) = optionalP p
+
+    -}
     optionP :: APrism a b () () -> p a b -> p a b
     optionP def p = p <|> pureP def
 

From e51d86ea9f1dc3413bdf6bd960605b9c9736c0dd Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 12:31:54 -0700
Subject: [PATCH 090/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 32 +++++++++-----------------------
 1 file changed, 9 insertions(+), 23 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index a9d0ece..886b8f0 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -365,35 +365,21 @@ For context, an @LL@ grammar can be (un)parsed by an @LL@ parser.
 An @LL@ parser (un)parses from left to right,
 and constucts leftmost derivations.
 An @LL(k)@ parser can look @k@ tokens ahead.
-`Parsor` is an @LL(∞)@ parser,
-which disables it from reporting error information.
-`Parsector` is an @LL(1)@ parser,
-so it can report precise `ParsecError` information.
+`Parsor` is an @LL(∞)@ parser.
+`Parsector` is an @LL(1)@ parser.
 The backtracking `try` combinator
-restores full lookahead to `Parsector`,
-at the potential cost of error information.
+restores full lookahead to `Parsector`.
 Since both `Parsor` & `Parsector` are @LL@ parsers they
 diverge if the `CtxGrammar` they're run on is left-recursive.
 
->>> :{
-abcG :: CtxGrammar Char String
-abcG = rule "αβγ" (tokens "αβγ")
-  <|> rule "abx" (tokens "abx")
-  <|> rule "abyz"
-    (rule "aby" (tokens "aby") <|> rule "abz" (tokens "abz"))
-:}
-
->>> parsecG abcG "abc"
-ParsecState {parsecOffset = 2, parsecStream = "c", parsecResult = Left (ParsecError {parsecExpect = TokenClass (OneOf (fromList "xyz")), parsecLabels = [Node {rootLabel = "abx", subForest = []},Node {rootLabel = "abyz", subForest = [Node {rootLabel = "aby", subForest = []},Node {rootLabel = "abz", subForest = []}]}]})}
-
->>> parsecG abcG "abx"
-ParsecState {parsecOffset = 3, parsecStream = "", parsecResult = Right "abx"}
+>>> parsecG (rule "foo" (fail "bar") <|> fail "baz") "abc"
+ParsecState {parsecLooked = False, parsecOffset = 0, parsecStream = "abc", parsecResult = Left (ParsecError {parsecExpect = TokenClass (OneOf (fromList "")), parsecLabels = [Node {rootLabel = "foo", subForest = [Node {rootLabel = "bar", subForest = []}]},Node {rootLabel = "baz", subForest = []}]})}
 
->>> unparsecG abcG "abc" ""
-ParsecState {parsecOffset = 2, parsecStream = "ab", parsecResult = Left (ParsecError {parsecExpect = TokenClass (OneOf (fromList "xyz")), parsecLabels = [Node {rootLabel = "abx", subForest = []},Node {rootLabel = "abyz", subForest = [Node {rootLabel = "aby", subForest = []},Node {rootLabel = "abz", subForest = []}]}]})}
+>>> parsecG (terminal "abc" >* tokenClass (notOneOf "456" >&&< asIn @Char DecimalNumber)) "abcd"
+ParsecState {parsecLooked = True, parsecOffset = 3, parsecStream = "d", parsecResult = Left (ParsecError {parsecExpect = TokenClass (NotOneOf (fromList "456") (AndAsIn DecimalNumber)), parsecLabels = []})}
 
->>> unparsecG abcG "aby" ""
-ParsecState {parsecOffset = 3, parsecStream = "aby", parsecResult = Right "aby"}
+>>> unparsecG (tokens "abc") "abx" ""
+ParsecState {parsecLooked = True, parsecOffset = 2, parsecStream = "ab", parsecResult = Left (ParsecError {parsecExpect = TokenClass (OneOf (fromList "c")), parsecLabels = []})}
 
 -}
 type CtxGrammar token a = forall p.

From 21aaae38a160db3f3a43140ebcb859b68b7ff4fd Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 12:32:02 -0700
Subject: [PATCH 091/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 26 ++++++++++++------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 1ea8484..14c5e3e 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -61,7 +61,7 @@ It's the fundamental building block of `Parsector`.
 interpretation as input and output.
 -}
 data ParsecState s a = ParsecState
-  { parsecImpure :: Bool
+  { parsecLooked :: !Bool
   , parsecOffset :: !Word
     -- ^ token offset number
   , parsecStream :: s -- ^ input and output stream
@@ -151,7 +151,7 @@ instance
         mode = parsecResult query
         offset = parsecOffset query
         replyOk tok str = query
-          { parsecImpure = True
+          { parsecLooked = True
           , parsecStream = str
           , parsecOffset = offset + 1
           , parsecResult = Right tok
@@ -195,14 +195,14 @@ instance Categorized (Item s) => Monad (Parsector s a) where
       case parsecResult reply of
         Left err -> callback reply {parsecResult = Left err}
         Right b ->
-          let fQuery = reply
-                { parsecImpure = False
-                , parsecResult = parsecResult query
-                }
-          in runParsector (f b)
-              (\fReply -> callback fReply
-                { parsecImpure = parsecImpure reply || parsecImpure fReply })
-              fQuery
+          let
+            fQuery = reply
+              { parsecLooked = False
+              , parsecResult = parsecResult query
+              }
+          in
+            flip (runParsector (f b)) fQuery $ \fReply -> callback fReply
+              { parsecLooked = parsecLooked reply || parsecLooked fReply }
 instance Categorized (Item s) => Alternative (Parsector s a) where
   -- | Always fail, consuming no input and expecting nothing.
   empty = Parsector $ \callback query ->
@@ -213,14 +213,14 @@ instance Categorized (Item s) => Alternative (Parsector s a) where
         -- if p succeeds, take p's branch
         Right _ -> replyP
         -- if p failed after consuming (committed), propagate immediately
-        Left _ | parsecImpure replyP -> replyP
+        Left _ | parsecLooked replyP -> replyP
         -- if p failed without consuming, try q
         Left errP -> flip (runParsector q) query $ \replyQ ->
           case parsecResult replyQ of
             -- if q succeeds, take q's branch
             Right _ -> replyQ
             -- if q failed after consuming (committed), propagate q's error
-            Left _ | parsecImpure replyQ -> replyQ
+            Left _ | parsecLooked replyQ -> replyQ
             -- both failed without consuming: merge errors
             Left errQ -> replyP {parsecResult = Left (errP <> errQ)}
 instance Categorized (Item s) => MonadPlus (Parsector s a)
@@ -230,7 +230,7 @@ instance Categorized (Item s) => MonadTry (Parsector s a) where
   try p = Parsector $ \callback query ->
     flip (runParsector p) query $ \reply -> callback $
       case parsecResult reply of
-        Left _ -> reply { parsecImpure = False }
+        Left _ -> reply { parsecLooked = False }
         Right _ -> reply
 instance Categorized (Item s) => Filterable (Parsector s a) where
   mapMaybe = dimapMaybe Just

From 75bfa33d8b6b993efe596b85a6920a500405b209 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 12:32:04 -0700
Subject: [PATCH 092/103] Update Main.hs

---
 test/Main.hs | 54 +++++++++++++++++++++++++++-------------------------
 1 file changed, 28 insertions(+), 26 deletions(-)

diff --git a/test/Main.hs b/test/Main.hs
index 15a4a3d..aad2942 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -2,6 +2,7 @@ module Main (main) where
 
 import Data.Foldable hiding (toList)
 import Control.Lens.Grammar
+import Control.Monad (when)
 import Data.List (genericLength)
 import Test.DocTest
 import Test.Hspec
@@ -19,15 +20,15 @@ import Properties.Kleene
 main :: IO ()
 main = do
   hspec $ do
-    describe "regexGrammar" $ for_ regexExamples $ testGrammarExample regexGrammar
-    describe "semverGrammar" $ for_ semverExamples $ testCtxGrammarExample semverGrammar
-    describe "semverCtxGrammar" $ for_ semverExamples $ testCtxGrammarExample semverCtxGrammar
-    describe "arithGrammar" $ for_ arithExamples $ testGrammarExample arithGrammar
-    describe "jsonGrammar" $ for_ jsonExamples $ testCtxGrammarExample jsonGrammar
-    describe "sexprGrammar" $ for_ sexprExamples $ testCtxGrammarExample sexprGrammar
-    describe "lambdaGrammar" $ for_ lambdaExamples $ testCtxGrammarExample lambdaGrammar
-    describe "lenvecGrammar" $ for_ lenvecExamples $ testCtxGrammarExample lenvecGrammar
-    describe "chainGrammar" $ for_ chainExamples $ testCtxGrammarExample chainGrammar
+    describe "regexGrammar" $ for_ regexExamples $ testGrammar False regexGrammar
+    describe "semverGrammar" $ for_ semverExamples $ testCtxGrammar True semverGrammar
+    describe "semverCtxGrammar" $ for_ semverExamples $ testCtxGrammar True semverCtxGrammar
+    describe "arithGrammar" $ for_ arithExamples $ testGrammar True arithGrammar
+    describe "jsonGrammar" $ for_ jsonExamples $ testCtxGrammar False jsonGrammar
+    describe "sexprGrammar" $ for_ sexprExamples $ testCtxGrammar True sexprGrammar
+    describe "lambdaGrammar" $ for_ lambdaExamples $ testCtxGrammar True lambdaGrammar
+    describe "lenvecGrammar" $ for_ lenvecExamples $ testCtxGrammar True lenvecGrammar
+    describe "chainGrammar" $ for_ chainExamples $ testCtxGrammar True chainGrammar
     describe "Kleene" kleeneProperties
   doctests
 
@@ -79,15 +80,15 @@ doctests = do
     putStrLn modulePath
     doctest (modulePath : languageExtensions)
 
-testGrammarExample :: (Show a, Eq a) => Grammar Char a -> (a, String) -> Spec
-testGrammarExample grammar (expectedSyntax, expectedString) = do
-  testCtxGrammarExample grammar (expectedSyntax, expectedString)
+testGrammar :: (Show a, Eq a) => Bool -> Grammar Char a -> (a, String) -> Spec
+testGrammar isLL1 grammar (expectedSyntax, expectedString) = do
+  testCtxGrammar isLL1 grammar (expectedSyntax, expectedString)
   it ("should match " <> expectedString <> " correctly") $ do
     let actualMatch = expectedString =~ regbnfG grammar
     actualMatch `shouldBe` True
 
-testCtxGrammarExample :: (Show a, Eq a) => CtxGrammar Char a -> (a, String) -> Spec
-testCtxGrammarExample grammar (expectedSyntax, expectedString) = do
+testCtxGrammar :: (Show a, Eq a) => Bool -> CtxGrammar Char a -> (a, String) -> Spec
+testCtxGrammar isLL1 grammar (expectedSyntax, expectedString) = do
   it ("should parseG from " <> expectedString <> " correctly") $ do
     let actualSyntax = [parsed | (parsed, "") <- parseG grammar expectedString]
     actualSyntax `shouldBe` [expectedSyntax]
@@ -97,15 +98,16 @@ testCtxGrammarExample grammar (expectedSyntax, expectedString) = do
   it ("should printG to " <> expectedString <> " correctly") $ do
     let actualString = ($ "") <$> printG grammar expectedSyntax
     actualString `shouldBe` Just expectedString
-  -- it ("should parsecG from " <> expectedString <> " correctly") $ do
-  --   let actualSyntax = parsecG grammar expectedString
-  --   let expectedLength = genericLength expectedString
-  --   let actualImpure = parsecImpure actualSyntax
-  --   actualSyntax `shouldBe`
-  --     (ParsecState actualImpure expectedLength "" (Right expectedSyntax))
-  -- it ("should unparsecG to " <> expectedString <> " correctly") $ do
-  --   let actualString = unparsecG grammar expectedSyntax ""
-  --   let expectedLength = genericLength expectedString
-  --   let actualImpure = parsecImpure actualString
-  --   actualString `shouldBe`
-  --     (ParsecState actualImpure expectedLength expectedString (Right expectedSyntax))
+  when isLL1 $ do
+    it ("should parsecG from " <> expectedString <> " correctly") $ do
+      let actualSyntax = parsecG grammar expectedString
+      let expectedLength = genericLength expectedString
+      let actualLooked = parsecLooked actualSyntax
+      actualSyntax `shouldBe`
+        (ParsecState actualLooked expectedLength "" (Right expectedSyntax))
+    it ("should unparsecG to " <> expectedString <> " correctly") $ do
+      let actualString = unparsecG grammar expectedSyntax ""
+      let expectedLength = genericLength expectedString
+      let actualLooked = parsecLooked actualString
+      actualString `shouldBe`
+        (ParsecState actualLooked expectedLength expectedString (Right expectedSyntax))

From b4339383e63d241be746070203d045174496ef38 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 12:35:27 -0700
Subject: [PATCH 093/103] version

---
 distributors.cabal | 2 +-
 package.yaml       | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/distributors.cabal b/distributors.cabal
index 399fd64..7350ef4 100644
--- a/distributors.cabal
+++ b/distributors.cabal
@@ -5,7 +5,7 @@ cabal-version: 2.2
 -- see: https://github.com/sol/hpack
 
 name:           distributors
-version:        0.3.0.0
+version:        0.4.0.0
 synopsis:       Unifying Parsers, Printers & Grammars
 description:    Distributors provides mathematically inspired abstractions for coders to write parsers that can also be inverted to printers.
 category:       Profunctors, Optics, Parsing
diff --git a/package.yaml b/package.yaml
index b4f248c..a4bcd1c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: distributors
-version: 0.3.0.0
+version: 0.4.0.0
 github: "morphismtech/distributors"
 license: BSD-3-Clause
 author: "Eitan Chatav"

From 386f294e821e266d90c5a7433df5c8b72b40e9bd Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 12:37:37 -0700
Subject: [PATCH 094/103] Update BackusNaur.hs

---
 src/Control/Lens/Grammar/BackusNaur.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Control/Lens/Grammar/BackusNaur.hs b/src/Control/Lens/Grammar/BackusNaur.hs
index 139d679..fa7fe7a 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -37,8 +37,8 @@ import qualified Data.Set as Set
 import Data.Set (Set)
 
 {- | `BackusNaurForm` grammar combinators formalize
-`rule` abstraction and general recursion. Context-free
-`Control.Lens.Grammar.Grammar`s & `CtxGrammar`s
+`rule` abstraction and general recursion. Both Context-free
+`Control.Lens.Grammar.Grammar`s & `Control.Lens.Grammar.CtxGrammar`s
 support the `BackusNaurForm` interface.
 
 prop> rule name bnf = ruleRec name (\_ -> bnf)

From aaa8c3af8aaf0d39305477f9ec95343f07ea1848 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 12:45:55 -0700
Subject: [PATCH 095/103] Update BackusNaur.hs

---
 src/Control/Lens/Grammar/BackusNaur.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Control/Lens/Grammar/BackusNaur.hs b/src/Control/Lens/Grammar/BackusNaur.hs
index fa7fe7a..75d1f77 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -45,7 +45,7 @@ prop> rule name bnf = ruleRec name (\_ -> bnf)
 -}
 class BackusNaurForm bnf where
 
-  {- | Rule abstraction. -}
+  {- | Rule abstraction, `rule` can be used to detail parse errors. -}
   rule :: String -> bnf -> bnf
   rule _ = id
 

From cc4f34170a0d5c36640b2f11848ac1a0eb7de4a2 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 13:32:04 -0700
Subject: [PATCH 096/103] improve errors with hints

---
 src/Control/Lens/Grammar.hs              |  8 ++--
 src/Data/Profunctor/Grammar/Parsector.hs | 51 ++++++++++++++++++------
 test/Main.hs                             |  6 ++-
 3 files changed, 46 insertions(+), 19 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 886b8f0..1af1b0b 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -373,13 +373,13 @@ Since both `Parsor` & `Parsector` are @LL@ parsers they
 diverge if the `CtxGrammar` they're run on is left-recursive.
 
 >>> parsecG (rule "foo" (fail "bar") <|> fail "baz") "abc"
-ParsecState {parsecLooked = False, parsecOffset = 0, parsecStream = "abc", parsecResult = Left (ParsecError {parsecExpect = TokenClass (OneOf (fromList "")), parsecLabels = [Node {rootLabel = "foo", subForest = [Node {rootLabel = "bar", subForest = []}]},Node {rootLabel = "baz", subForest = []}]})}
+ParsecState {parsecLooked = False, parsecOffset = 0, parsecStream = "abc", parsecHint = ParsecError {parsecExpect = TokenClass (OneOf (fromList "")), parsecLabels = []}, parsecResult = Left (ParsecError {parsecExpect = TokenClass (OneOf (fromList "")), parsecLabels = [Node {rootLabel = "foo", subForest = [Node {rootLabel = "bar", subForest = []}]},Node {rootLabel = "baz", subForest = []}]})}
 
->>> parsecG (terminal "abc" >* tokenClass (notOneOf "456" >&&< asIn @Char DecimalNumber)) "abcd"
-ParsecState {parsecLooked = True, parsecOffset = 3, parsecStream = "d", parsecResult = Left (ParsecError {parsecExpect = TokenClass (NotOneOf (fromList "456") (AndAsIn DecimalNumber)), parsecLabels = []})}
+>>> parsecG (manyP (token 'a') >*< asIn @Char DecimalNumber) "aaab"
+ParsecState {parsecLooked = True, parsecOffset = 3, parsecStream = "b", parsecHint = ParsecError {parsecExpect = TokenClass (OneOf (fromList "")), parsecLabels = []}, parsecResult = Left (ParsecError {parsecExpect = TokenClass (Alternate (TokenClass (OneOf (fromList "a"))) (TokenClass (NotOneOf (fromList "") (AndAsIn DecimalNumber)))), parsecLabels = []})}
 
 >>> unparsecG (tokens "abc") "abx" ""
-ParsecState {parsecLooked = True, parsecOffset = 2, parsecStream = "ab", parsecResult = Left (ParsecError {parsecExpect = TokenClass (OneOf (fromList "c")), parsecLabels = []})}
+ParsecState {parsecLooked = True, parsecOffset = 2, parsecStream = "ab", parsecHint = ParsecError {parsecExpect = TokenClass (OneOf (fromList "")), parsecLabels = []}, parsecResult = Left (ParsecError {parsecExpect = TokenClass (OneOf (fromList "c")), parsecLabels = []})}
 
 -}
 type CtxGrammar token a = forall p.
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 14c5e3e..2c6717f 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -48,11 +48,11 @@ newtype Parsector s a b = Parsector
 
 -- | `Parsector` is parsed using `parsecP`.
 parsecP :: Categorized (Item s) => Parsector s a b -> s -> ParsecState s b
-parsecP p s = runParsector p id (ParsecState False 0 s (Left mempty))
+parsecP p s = runParsector p id (ParsecState False 0 s mempty (Left mempty))
 
 -- | `Parsector` is printed using `unparsecP`.
-unparsecP :: Parsector s a b -> a -> s -> ParsecState s b
-unparsecP p a s = runParsector p id (ParsecState False 0 s (Right a))
+unparsecP :: Categorized (Item s) => Parsector s a b -> a -> s -> ParsecState s b
+unparsecP p a s = runParsector p id (ParsecState False 0 s mempty (Right a))
 
 {- | `ParsecState` is the outpute type for `parsecP` & `unparsecP`.
 It's the fundamental building block of `Parsector`.
@@ -65,6 +65,12 @@ data ParsecState s a = ParsecState
   , parsecOffset :: !Word
     -- ^ token offset number
   , parsecStream :: s -- ^ input and output stream
+  , parsecHint   :: ParsecError s
+    {- ^ Accumulated hint: the merged empty-failure errors from all discarded
+    alternatives at the current position.
+    On the success path in `<|>` & `>>=`, this propagates forward so that
+    downstream failures include the full expected-token set.
+    -}
   , parsecResult :: Either (ParsecError s) a
     {- ^ As an input @parsecResult@ represents either parse mode,
     or print mode with an input syntax value.
@@ -152,12 +158,14 @@ instance
         offset = parsecOffset query
         replyOk tok str = query
           { parsecLooked = True
+          , parsecHint   = mempty
           , parsecStream = str
           , parsecOffset = offset + 1
           , parsecResult = Right tok
           }
         replyErr = query
-          { parsecResult = Left (ParsecError test []) }
+          { parsecHint   = mempty
+          , parsecResult = Left (ParsecError test []) }
       in
         callback $ case mode of
           -- print mode
@@ -188,6 +196,20 @@ instance Categorized (Item s) => Applicative (Parsector s a) where
   pure b = Parsector $ \callback query ->
     callback query { parsecResult = Right b }
   (<*>) = ap
+
+-- | Merge a hint into a reply. If the reply did not consume input,
+-- prepend the hint to any empty failure, or accumulate it into the
+-- success hint for further propagation. If the reply consumed, ignore
+-- the hint (LL(1) commitment means old alternatives are irrelevant).
+applyHint
+  :: Categorized (Item s)
+  => ParsecError s -> ParsecState s a -> ParsecState s a
+applyHint hint st
+  | parsecLooked st = st
+  | otherwise = case parsecResult st of
+      Left err -> st { parsecResult = Left (hint <> err) }
+      Right _  -> st { parsecHint   = hint <> parsecHint st }
+
 instance Categorized (Item s) => Monad (Parsector s a) where
   return = pure
   p >>= f = Parsector $ \callback query ->
@@ -196,13 +218,16 @@ instance Categorized (Item s) => Monad (Parsector s a) where
         Left err -> callback reply {parsecResult = Left err}
         Right b ->
           let
+            hintP  = parsecHint reply
             fQuery = reply
               { parsecLooked = False
+              , parsecHint   = mempty
               , parsecResult = parsecResult query
               }
           in
-            flip (runParsector (f b)) fQuery $ \fReply -> callback fReply
-              { parsecLooked = parsecLooked reply || parsecLooked fReply }
+            flip (runParsector (f b)) fQuery $ \fReply -> callback $
+              (applyHint hintP fReply)
+                { parsecLooked = parsecLooked reply || parsecLooked fReply }
 instance Categorized (Item s) => Alternative (Parsector s a) where
   -- | Always fail, consuming no input and expecting nothing.
   empty = Parsector $ \callback query ->
@@ -216,13 +241,13 @@ instance Categorized (Item s) => Alternative (Parsector s a) where
         Left _ | parsecLooked replyP -> replyP
         -- if p failed without consuming, try q
         Left errP -> flip (runParsector q) query $ \replyQ ->
-          case parsecResult replyQ of
-            -- if q succeeds, take q's branch
-            Right _ -> replyQ
-            -- if q failed after consuming (committed), propagate q's error
-            Left _ | parsecLooked replyQ -> replyQ
-            -- both failed without consuming: merge errors
-            Left errQ -> replyP {parsecResult = Left (errP <> errQ)}
+          case (parsecLooked replyQ, parsecResult replyQ) of
+            -- q consumed (ok or err): propagate as-is, drop errP
+            (True, _)         -> replyQ
+            -- q empty ok: carry errP forward as hint for downstream
+            (False, Right _)  -> replyQ { parsecHint = errP <> parsecHint replyQ }
+            -- both empty fail: merge errors
+            (False, Left errQ) -> replyP { parsecResult = Left (errP <> errQ) }
 instance Categorized (Item s) => MonadPlus (Parsector s a)
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
diff --git a/test/Main.hs b/test/Main.hs
index aad2942..6c71fca 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -103,11 +103,13 @@ testCtxGrammar isLL1 grammar (expectedSyntax, expectedString) = do
       let actualSyntax = parsecG grammar expectedString
       let expectedLength = genericLength expectedString
       let actualLooked = parsecLooked actualSyntax
+      let actualHint   = parsecHint   actualSyntax
       actualSyntax `shouldBe`
-        (ParsecState actualLooked expectedLength "" (Right expectedSyntax))
+        (ParsecState actualLooked expectedLength "" actualHint (Right expectedSyntax))
     it ("should unparsecG to " <> expectedString <> " correctly") $ do
       let actualString = unparsecG grammar expectedSyntax ""
       let expectedLength = genericLength expectedString
       let actualLooked = parsecLooked actualString
+      let actualHint   = parsecHint   actualString
       actualString `shouldBe`
-        (ParsecState actualLooked expectedLength expectedString (Right expectedSyntax))
+        (ParsecState actualLooked expectedLength expectedString actualHint (Right expectedSyntax))

From 1095d98697d9752ebec314cd9f925e51870f0d4d Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 14:27:17 -0700
Subject: [PATCH 097/103] Update BackusNaur.hs

---
 src/Control/Lens/Grammar/BackusNaur.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Control/Lens/Grammar/BackusNaur.hs b/src/Control/Lens/Grammar/BackusNaur.hs
index 75d1f77..79bdbe6 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -42,6 +42,9 @@ import Data.Set (Set)
 support the `BackusNaurForm` interface.
 
 prop> rule name bnf = ruleRec name (\_ -> bnf)
+
+See Breitner, [Showcasing Applicative]
+(https://www.joachim-breitner.de/blog/710-Showcasing_Applicative)
 -}
 class BackusNaurForm bnf where
 

From 0c605cc941d2fde41d7b69711f850365a2000f5f Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 14:46:57 -0700
Subject: [PATCH 098/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 106 ++++++++++++++---------
 1 file changed, 67 insertions(+), 39 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 2c6717f..ac5960c 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -6,6 +6,10 @@ License     : BSD-style (see the file LICENSE)
 Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
 Stability   : provisional
 Portability : non-portable
+
+See Leijen,
+[Parsec: Direct Style Monadic Parser Combinators For The Real World]
+(https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/parsec-paper-letter.pdf)
 -}
 
 module Data.Profunctor.Grammar.Parsector
@@ -39,43 +43,63 @@ import GHC.Exts
 import Prelude hiding (id, (.))
 import Witherable
 
-{- | `Parsector` is an invertible parser which is intended
+{- | `Parsector` is an invertible @LL(1)@ parser which is intended
 to provide detailed error information, based on [Parsec]
-(https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/parsec-paper-letter.pdf)
+(https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/parsec-paper-letter.pdf).
 -}
 newtype Parsector s a b = Parsector
   {runParsector :: forall x. (ParsecState s b -> x) -> ParsecState s a -> x}
 
--- | `Parsector` is parsed using `parsecP`.
-parsecP :: Categorized (Item s) => Parsector s a b -> s -> ParsecState s b
+{- | Run `Parsector` as a parser: consume tokens from @s@,
+left to right, returning a `ParsecState` whose `parsecResult`
+is either a successful output syntax value or a `ParsecError`. -}
+parsecP
+  :: Categorized (Item s)
+  => Parsector s a b
+  -> s -- ^ input stream
+  -> ParsecState s b
 parsecP p s = runParsector p id (ParsecState False 0 s mempty (Left mempty))
 
--- | `Parsector` is printed using `unparsecP`.
-unparsecP :: Categorized (Item s) => Parsector s a b -> a -> s -> ParsecState s b
+{- | Run `Parsector` as an unparser: given a syntax value @a@ and
+an input stream, append tokens to @s@ left to right,
+returning a `ParsecState` whose `parsecResult` is
+either a `ParsecError` or a successful output syntax value,
+in which case, `parsecStream` is the output stream. -}
+unparsecP
+  :: Categorized (Item s)
+  => Parsector s a b
+  -> a -- ^ input syntax
+  -> s -- ^ input stream
+  -> ParsecState s b
 unparsecP p a s = runParsector p id (ParsecState False 0 s mempty (Right a))
 
-{- | `ParsecState` is the outpute type for `parsecP` & `unparsecP`.
-It's the fundamental building block of `Parsector`.
+{- | `ParsecState` is both the input and output type of the
+underlying function inside `Parsector`.
 @Parsector s a b@ is equivalent to
-@ParsecState s a -> ParsecState s b@, so it has a dual
-interpretation as input and output.
--}
+
+@ParsecState s a -> ParsecState s b@
+
+So `ParsecState` has a dual interpretation as input and output. -}
 data ParsecState s a = ParsecState
   { parsecLooked :: !Bool
+    {- ^ @True@ once the parser has consumed at least one token
+    since the last `<|>` / `try` decision point.
+    Controls LL(1) commitment: a failure with `parsecLooked = True`
+    is propagated immediately without trying alternatives.
+    Reset to @False@ by `try` on failure, and at the start of
+    each `>>=` continuation.
+    -}
   , parsecOffset :: !Word
-    -- ^ token offset number
-  , parsecStream :: s -- ^ input and output stream
+    -- ^ Number of tokens consumed from the start of the stream.
+  , parsecStream :: s -- ^ stream
   , parsecHint   :: ParsecError s
-    {- ^ Accumulated hint: the merged empty-failure errors from all discarded
+    {- ^ Hint: the merged `ParsecError`s from all empty-failing
     alternatives at the current position.
-    On the success path in `<|>` & `>>=`, this propagates forward so that
-    downstream failures include the full expected-token set.
-    -}
+    Carried forward on the *success* path by `<|>` and `>>=` so that
+    downstream failures include the full set of expected tokens. -}
   , parsecResult :: Either (ParsecError s) a
-    {- ^ As an input @parsecResult@ represents either parse mode,
-    or print mode with an input syntax value.
-    As an output @parsecResult@ represents either an error or
-    a successful result with an output syntax value.
+    {- ^ As an input: Either parse mode or print mode with syntax value.
+    As an output: Either a failure or success with syntax value.
     -}
   }
 
@@ -92,8 +116,11 @@ data ParsecError s = ParsecError
     -}
   , parsecLabels :: [Tree String]
     {- ^ Forest of `rule` labels active at the `parsecOffset`.
-    @`rule`@ creates a new label `Node`, as do  `ruleRec` & `fail`.
-    `<|>` merges siblings. Utilize `drawForest` to display.
+    Each `rule` wraps its inner labels in a new `Node`.
+    `ruleRec` & `fail` also create label nodes.
+    When two empty failures are merged by `<|>`,
+    their forests are concatenated as siblings.
+    Use `drawForest` to display.
     -}
   }
 
@@ -179,6 +206,8 @@ instance
               | otherwise -> replyErr
             Nothing -> replyErr
 instance BackusNaurForm (Parsector s a b) where
+  -- | Wraps inner `parsecLabels` in a new `Node name` on failure.
+  -- Has no effect on success.
   rule name p = Parsector $ \callback query ->
     flip (runParsector p) query $ \reply -> callback $
       case parsecResult reply of
@@ -197,19 +226,6 @@ instance Categorized (Item s) => Applicative (Parsector s a) where
     callback query { parsecResult = Right b }
   (<*>) = ap
 
--- | Merge a hint into a reply. If the reply did not consume input,
--- prepend the hint to any empty failure, or accumulate it into the
--- success hint for further propagation. If the reply consumed, ignore
--- the hint (LL(1) commitment means old alternatives are irrelevant).
-applyHint
-  :: Categorized (Item s)
-  => ParsecError s -> ParsecState s a -> ParsecState s a
-applyHint hint st
-  | parsecLooked st = st
-  | otherwise = case parsecResult st of
-      Left err -> st { parsecResult = Left (hint <> err) }
-      Right _  -> st { parsecHint   = hint <> parsecHint st }
-
 instance Categorized (Item s) => Monad (Parsector s a) where
   return = pure
   p >>= f = Parsector $ \callback query ->
@@ -226,10 +242,19 @@ instance Categorized (Item s) => Monad (Parsector s a) where
               }
           in
             flip (runParsector (f b)) fQuery $ \fReply -> callback $
-              (applyHint hintP fReply)
-                { parsecLooked = parsecLooked reply || parsecLooked fReply }
+              if parsecLooked fReply
+                then fReply
+                else case parsecResult fReply of
+                  Left err -> fReply
+                    { parsecLooked = parsecLooked reply
+                    , parsecResult = Left (hintP <> err)
+                    }
+                  Right _ -> fReply
+                    { parsecLooked = parsecLooked reply
+                    , parsecHint   = hintP <> parsecHint fReply
+                    }
 instance Categorized (Item s) => Alternative (Parsector s a) where
-  -- | Always fail, consuming no input and expecting nothing.
+  -- | Always fails without consuming input; expects nothing.
   empty = Parsector $ \callback query ->
     callback query { parsecResult = Left mempty }
   p <|> q = Parsector $ \callback query ->
@@ -252,6 +277,9 @@ instance Categorized (Item s) => MonadPlus (Parsector s a)
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
 instance Categorized (Item s) => MonadTry (Parsector s a) where
+  -- | On failure, resets `parsecLooked` to @False@, allowing
+  -- the enclosing `<|>` to try the next alternative even if @p@
+  -- consumed input. Has no effect on success.
   try p = Parsector $ \callback query ->
     flip (runParsector p) query $ \reply -> callback $
       case parsecResult reply of

From 01c8e2becbb4a2fa7f4e785ad62f9e3ebca7fb81 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 14:50:30 -0700
Subject: [PATCH 099/103] Update CHANGELOG.md

---
 CHANGELOG.md | 41 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 41 insertions(+)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 693daf6..ba221d5 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,46 @@
 # Changelog for `distributors`
 
+## 0.4.0.0 - 2026-04-10
+
+### New Modules
+
+- `Control.Monad.Fail.Try` - `MonadTry` class with `try` & `fail` for backtracking parsers
+- `Data.Profunctor.Grammar.Parsector` - Invertible LL(1) parser with Parsec-style error reporting:
+  `ParsecState`, `ParsecError`, `parsecP`, `unparsecP`; implements hints, LL(1) commitment
+  via `parsecLooked`, and `try` for explicit backtracking
+- `Data.Profunctor.Separator` - Separator/delimiter combinators: `sepWith`, `noSep`,
+  `beginWith`, `endWith`, `several`, `several1`, `intercalateP`, `chain`, `chain1`
+- `Data.Traversable.Homogeneous` - `Homogeneous` class for static containers with uniform elements;
+  `ditraverse` for distributive traversals
+
+### New Combinators
+
+- `Control.Lens.Grammar.Kleene`: `tokenClass` embedding into `RegEx`; `KleeneAlgebra` laws
+  as QuickCheck properties; `RegExam` helpers `failExam`, `passExam`, `isFailExam`
+- `Control.Lens.Grammar.Boole`: `trueB`, `falseB` added to `BooleanAlgebra`;
+  `andB`, `orB`, `allB`, `anyB` fold combinators
+- `Data.Profunctor.Monadic`: `MonadicTry` constraint alias; `P.return` combinator;
+  improved documentation for qualified do-notation pattern bonding
+- `Data.Profunctor.Distributor`: `manyP` / `optionalP` now place the empty case on
+  the right of `>+<` for correct LL(1) behaviour (`p >*< manyP p >+< oneP`)
+
+### Changes
+
+- `<|>` in `Parsector` now commits when the left branch consumes input (LL(1));
+  use `try` to opt into backtracking
+- `TokenTest` renamed to `TokenClass` throughout
+- `chain`, `chain1`, `intercalateP` moved from `Data.Profunctor.Distributor`
+  to the new `Data.Profunctor.Separator`
+- `BackusNaurForm`: `rule` documentation clarified; added reference to Breitner's
+  *Showcasing Applicative*
+
+### Testing
+
+- `test/Properties/Kleene` - QuickCheck properties for `KleeneStarAlgebra`,
+  `TokenAlgebra`, `BooleanAlgebra TokenClass`
+- `test/Examples/Chain` - Chain grammar example
+- `test/Main`: `testCtxGrammarExample` extended with `parsecG` / `unparsecG` round-trip checks
+
 ## 0.3.0.0 - 2026-02-05
 
 ### New Modules

From 4b468c530dbf9c0f955e095500744cb72306f24c Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 16:30:45 -0700
Subject: [PATCH 100/103] Update Grammar.hs

---
 src/Control/Lens/Grammar.hs | 26 +++++++++++++++++++++-----
 1 file changed, 21 insertions(+), 5 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 1af1b0b..d038c74 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -804,7 +804,7 @@ printG
   -> m (string -> string)
 printG printor = printP printor
 
-{- | `parseG` generates a parser from a `CtxGrammar`.
+{- | `parseG` generates a parser from a @LL(∞)@ `CtxGrammar`.
 Since both `RegGrammar`s and context-free `Grammar`s are `CtxGrammar`s,
 the type system will allow `parseG` to be applied to them.
 Running the parser on an input string value `uncons`es
@@ -820,10 +820,10 @@ parseG
   -> m (a, string)
 parseG parsor = parseP parsor
 
-{- | `unparseG` generates an unparser from a `CtxGrammar`.
+{- | `unparseG` generates a printer from a @LL(∞)@ `CtxGrammar`.
 Since both `RegGrammar`s and context-free `Grammar`s are `CtxGrammar`s,
 the type system will allow `unparseG` to be applied to them.
-Running the unparser on a syntax value and an input string
+Running the printer on a syntax value and an input string
 `snoc`s tokens at the end of the string, from left to right,
 returning the output string.
 -}
@@ -837,7 +837,15 @@ unparseG
   -> m string
 unparseG parsor = unparseP parsor
 
-{- | `parsecG` generates a Parsec-style parser from a `CtxGrammar`. -}
+{- | `parsecG` generates a parser from a @LL(1)@ `CtxGrammar`,
+with `try` for restoring full @LL(∞)@ lookahead.
+Since both `RegGrammar`s and context-free `Grammar`s are `CtxGrammar`s,
+the type system will allow `parsecG` to be applied to them.
+Running the parser on an input string value `uncons`es
+tokens from the beginning of an input string from left to right,
+returning a `parsecResult` which is a `ParsecError` or a syntax value,
+and a remaining output `parsecStream`.
+-}
 parsecG
   :: (Cons string string token token, Snoc string string token token)
   => (Item string ~ token, Categorized token)
@@ -846,7 +854,15 @@ parsecG
   -> ParsecState string a
 parsecG parsector = parsecP parsector
 
-{- | `unparsecG` generates a Parsec-style unparser from a `CtxGrammar`. -}
+{- | `unparsecG` generates a printer from a @LL(1)@ `CtxGrammar`,
+with `try` for restoring full @LL(∞)@ lookahead.
+Since both `RegGrammar`s and context-free `Grammar`s are `CtxGrammar`s,
+the type system will allow `unparsecG` to be applied to them.
+Running the printer on a syntax value and an input string
+`snoc`s tokens at the end of the string, from left to right,
+returning a `parsecResult` which is a `ParsecError`
+or the input syntax value, and a remaining output `parsecStream`.
+-}
 unparsecG
   :: (Cons string string token token, Snoc string string token token)
   => (Item string ~ token, Categorized token)

From 05da5f7a5de5132677660f4964b62790f77d7465 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 16:36:41 -0700
Subject: [PATCH 101/103] Update Kleene.hs

---
 src/Control/Lens/Grammar/Kleene.hs | 15 +--------------
 1 file changed, 1 insertion(+), 14 deletions(-)

diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index f58faf0..2139221 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -139,25 +139,12 @@ newtype TokenClass token = TokenClass (RegExam token (TokenClass token))
 
 {- | `TokenAlgebra` extends `Tokenized` methods to support
 `BooleanAlgebra` operations within a `tokenClass`.
-When a `TokenAlgebra` is an `Alternative` or a `KleeneStarAlgebra`,
+When a `TokenAlgebra` is an `Alternative`,
 then `tokenClass` is expected to act homomorphically on disjunction.
 
 prop> empty = tokenClass falseB
 prop> tokenClass x <|> tokenClass y = tokenClass (x >||< y)
 
-prop> zeroK = tokenClass falseB
-prop> tokenClass x >|< tokenClass y = tokenClass (x >||< y)
-
-And `tokenClass` is only needed for conjunction `>&&<`.
-It should propagate simple `Tokenized` operators.
-
-prop> anyToken = tokenClass anyToken
-prop> token = tokenClass . token
-prop> oneOf = tokenClass . oneOf
-prop> notOneOf = tokenClass . notOneOf
-prop> asIn = tokenClass . asIn
-prop> notAsIn = tokenClass . notAsIn
-
 -}
 class Tokenized token p => TokenAlgebra token p where
   tokenClass :: TokenClass token -> p

From 5752072060fc655e8d1bfbcfc12fee19d1a70aaa Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 16:57:33 -0700
Subject: [PATCH 102/103] Update Parsector.hs

---
 src/Data/Profunctor/Grammar/Parsector.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index ac5960c..63568d3 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -60,7 +60,7 @@ parsecP
   -> ParsecState s b
 parsecP p s = runParsector p id (ParsecState False 0 s mempty (Left mempty))
 
-{- | Run `Parsector` as an unparser: given a syntax value @a@ and
+{- | Run `Parsector` as a printer: given a syntax value @a@ and
 an input stream, append tokens to @s@ left to right,
 returning a `ParsecState` whose `parsecResult` is
 either a `ParsecError` or a successful output syntax value,
@@ -84,10 +84,9 @@ data ParsecState s a = ParsecState
   { parsecLooked :: !Bool
     {- ^ @True@ once the parser has consumed at least one token
     since the last `<|>` / `try` decision point.
-    Controls LL(1) commitment: a failure with `parsecLooked = True`
+    Controls LL(1) commitment: a failure with `parsecLooked` @True@
     is propagated immediately without trying alternatives.
-    Reset to @False@ by `try` on failure, and at the start of
-    each `>>=` continuation.
+    Reset to @False@ by `try` on failure.
     -}
   , parsecOffset :: !Word
     -- ^ Number of tokens consumed from the start of the stream.

From 1bc4040e453db5843504e2d6b102a132d741d03e Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 10 Apr 2026 16:57:39 -0700
Subject: [PATCH 103/103] Update Grammar.hs

---
 src/Data/Profunctor/Grammar.hs | 28 ++++++++++++++--------------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/src/Data/Profunctor/Grammar.hs b/src/Data/Profunctor/Grammar.hs
index 7949848..30279a2 100644
--- a/src/Data/Profunctor/Grammar.hs
+++ b/src/Data/Profunctor/Grammar.hs
@@ -9,13 +9,13 @@ Portability : non-portable
 -}
 
 module Data.Profunctor.Grammar
-  ( -- * Parsor
-    Parsor (..)
+  ( -- * Printor
+    Printor (..)
+  , printP
+    -- * Parsor
+  , Parsor (..)
   , unparseP
   , parseP
-    -- * Printor
-  , Printor (..)
-  , printP
     -- * Grammor
   , Grammor (..)
   ) where
@@ -42,6 +42,15 @@ import Prelude hiding (id, (.))
 import GHC.Exts
 import Witherable
 
+-- | `Printor` is a simple printer `Profunctor`.
+newtype Printor s f a b = Printor {runPrintor :: a -> f (b, s -> s)}
+
+-- | Run the printer on a value, returning a function
+-- that `cons`es tokens at the beginning of an input string,
+-- from right to left.
+printP :: Functor f => Printor s f a b -> a -> f (s -> s)
+printP (Printor f) = fmap snd . f
+
 -- | `Parsor` is a simple invertible parser `Profunctor`.
 newtype Parsor s f a b = Parsor {runParsor :: Maybe a -> s -> f (b,s)}
 
@@ -57,15 +66,6 @@ parseP (Parsor f) = f Nothing
 unparseP :: Functor f => Parsor s f a b -> a -> s -> f s
 unparseP (Parsor f) a = fmap snd . f (Just a)
 
--- | `Printor` is a simple printer `Profunctor`.
-newtype Printor s f a b = Printor {runPrintor :: a -> f (b, s -> s)}
-
--- | Run the printer on a value, returning a function
--- that `cons`es tokens at the beginning of an input string,
--- from right to left.
-printP :: Functor f => Printor s f a b -> a -> f (s -> s)
-printP (Printor f) = fmap snd . f
-
 -- | `Grammor` is a constant `Profunctor`.
 newtype Grammor k a b = Grammor {runGrammor :: k}