From b6933c56ebff7fdf27eafb2768fe87e58bc5db14 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 13 Apr 2026 13:37:43 -0700
Subject: [PATCH 01/30] Update Symbol.hs

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

diff --git a/src/Control/Lens/Grammar/Symbol.hs b/src/Control/Lens/Grammar/Symbol.hs
index d5ab6b3e..7d1a3794 100644
--- a/src/Control/Lens/Grammar/Symbol.hs
+++ b/src/Control/Lens/Grammar/Symbol.hs
@@ -24,9 +24,9 @@ import Data.Profunctor.Monoidal
 class TerminalSymbol token s | s -> token where
   terminal :: [token] -> s
   default terminal
-    :: (p () () ~ s, Tokenized token (p token token), Monoidal p, Cochoice p)
+    :: (p () () ~ s, Tokenized token (p token token), Monoidal p, Choice p, Cochoice p)
     => [token] -> s
-  terminal = foldr (\a p -> only a ?< token a *> p) oneP
+  terminal str = only str ?< tokens str
 
 -- | A `nonTerminal` symbol in a grammar.
 class NonTerminalSymbol s where

From 16013d496090b28cf029a6e4c2300d8ca687b3c9 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Mon, 13 Apr 2026 13:37:46 -0700
Subject: [PATCH 02/30] Update NestedPrismTH.hs

---
 src/Control/Lens/Internal/NestedPrismTH.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Control/Lens/Internal/NestedPrismTH.hs b/src/Control/Lens/Internal/NestedPrismTH.hs
index 76c7e08c..f444db3f 100644
--- a/src/Control/Lens/Internal/NestedPrismTH.hs
+++ b/src/Control/Lens/Internal/NestedPrismTH.hs
@@ -63,11 +63,11 @@ import Prelude
 -- will create
 --
 -- @
--- _Foo :: Prism (FooBarBaz a) (FooBarBaz b) a b
--- _Bar :: Prism' (FooBarBaz a) Int
--- _Baz :: Prism' (FooBarBaz a) (Int, Char)
--- _Buzz :: Prism' (FooBarBaz a) (Double, (String, Bool))
--- _Boop :: Prism' (FooBarBaz a) ()
+-- _Foo :: Prism (FooBar a) (FooBar b) a b
+-- _Bar :: Prism' (FooBar a) Int
+-- _Baz :: Prism' (FooBar a) (Int, Char)
+-- _Buzz :: Prism' (FooBar a) (Double, (String, Bool))
+-- _Boop :: Prism' (FooBar a) ()
 -- @
 makeNestedPrisms :: Name -> DecsQ
 makeNestedPrisms typeName =

From 451e1de3087ba5520067652893a3c3b1373037d7 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 14 Apr 2026 16:19:44 -0700
Subject: [PATCH 03/30] Bnf - more docs & less code

---
 src/Control/Lens/Grammar/BackusNaur.hs | 64 ++++++++++++++++++--------
 1 file changed, 46 insertions(+), 18 deletions(-)

diff --git a/src/Control/Lens/Grammar/BackusNaur.hs b/src/Control/Lens/Grammar/BackusNaur.hs
index c37b8636..c9396127 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -36,28 +36,61 @@ import Data.MemoTrie
 import qualified Data.Set as Set
 import Data.Set (Set)
 
-{- | `BackusNaurForm` grammar combinators formalize
-`rule` abstraction and general recursion. Both context-free
-`Control.Lens.Grammar.Grammar`s & `Control.Lens.Grammar.CtxGrammar`s
+{- | `BackusNaurForm` grammar combinators formalize traced
+`rule` abstraction and general recursion with `ruleRec`,
+related by this invariant.
+
+prop> rule label bnf = ruleRec label (\_ -> bnf)
+
+The `BackusNaurForm` interface is reminiscent of
+two distinct notions of trace.
+First as a [traced Cartesian monoidal category]
+(https://ncatlab.org/nlab/show/traced+monoidal+category#in_cartesian_monoidal_categories)
+which models general recursion abstractly,
+and second as a `Debug.Trace.trace`-like label for `rule` abstraction.
+The category @(->)@ already has a traced @(,)@-monoidal structure
+in the form of `Data.Profunctor.unfirst` or `Control.Arrow.loop`
+and the general recursion function `fix`,
+determining default methods for a `BackusNaurForm`.
+
+prop> rule _ = id
+prop> ruleRec _ = fix
+
+The `BackusNaurForm` interface permits overloading these methods,
+and tracing their occurence with a label.
+When a `BackusNaurForm` is a
+`Control.Monad.Fail.Try.MonadFail` &
+`Control.Monad.Fail.Try.MonadPlus`,
+this invariant should hold.
+
+prop> fail label = rule label mzero
+
+Both context-free `Control.Lens.Grammar.Grammar`s
+& `Control.Lens.Grammar.CtxGrammar`s
 support the `BackusNaurForm` interface.
-
-prop> rule name bnf = ruleRec name (\_ -> bnf)
-
 See Breitner, [Showcasing Applicative]
-(https://www.joachim-breitner.de/blog/710-Showcasing_Applicative).
+(https://www.joachim-breitner.de/blog/710-Showcasing_Applicative),
+for the original interface.
+
 -}
 class BackusNaurForm bnf where
 
-  {- | Rule abstraction, `rule` can be used to detail parse errors. -}
+  {- | Rule abstraction. -}
   rule :: String -> bnf -> bnf
   rule _ = id
 
-  {- | General recursion, using `ruleRec`, rules can refer to themselves. -}
+  {- | General recursion. -}
   ruleRec :: String -> (bnf -> bnf) -> bnf
   ruleRec _ = fix
 
 {- | A `Bnf` consists of a distinguished starting rule
-and a set of named rules, supporting the `BackusNaurForm` interface. -}
+and a set of named rules. When a `Bnf` supports `NonTerminalSymbol`s,
+then it supports the `BackusNaurForm` interface
+by replacing recursive calls with `nonTerminal`s.
+
+prop> ruleRec label f = rule label (f (nonTerminal label))
+
+-}
 data Bnf rule = Bnf
   { startBnf :: rule
   , rulesBnf :: Set (String, rule)
@@ -145,14 +178,9 @@ rulesNamed nameX = foldl' (flip inserter) Set.empty where
 -- instances
 instance (Ord rule, NonTerminalSymbol rule)
   => BackusNaurForm (Bnf rule) where
-    rule name = ruleRec name . const
-    ruleRec name f =
-      let
-        newStart = nonTerminal name
-        Bnf newRule oldRules = f (Bnf newStart mempty)
-        newRules = Set.insert (name, newRule) oldRules
-      in
-        Bnf newStart newRules
+    rule label (Bnf newRule oldRules) = (nonTerminal label)
+      {rulesBnf = Set.insert (label, newRule) oldRules}
+    ruleRec label f = rule label (f (nonTerminal label))
 instance (Ord rule, TerminalSymbol token rule)
   => TerminalSymbol token (Bnf rule) where
   terminal = liftBnf0 . terminal

From 3f69b68899b5e53cca8b5b3100871fff7cf23dd5 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 14 Apr 2026 18:53:39 -0700
Subject: [PATCH 04/30] Jokers to the right

---
 src/Control/Lens/Grammar.hs            | 24 ++++++++++++++++++++++++
 src/Control/Lens/Grammar/BackusNaur.hs |  8 ++++++--
 src/Control/Lens/Grammar/Kleene.hs     |  4 ++++
 src/Control/Lens/Grammar/Symbol.hs     |  6 ++++++
 src/Control/Lens/Grammar/Token.hs      | 26 ++++++++++++++++++--------
 src/Control/Lens/PartialIso.hs         | 24 +++++++++++++++++++++++-
 src/Control/Monad/Fail/Try.hs          |  5 +++++
 src/Data/Profunctor/Distributor.hs     |  5 +++++
 src/Data/Profunctor/Filtrator.hs       |  6 ++++++
 src/Data/Profunctor/Monoidal.hs        | 11 -----------
 10 files changed, 97 insertions(+), 22 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 6612325c..1f4dd488 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -20,11 +20,13 @@ module Control.Lens.Grammar
   , regexGrammar
     -- * Context-free grammar
   , Grammar
+  , applicativeG
   , RegBnf (..)
   , regbnfG
   , regbnfGrammar
     -- * Context-sensitive grammar
   , CtxGrammar
+  , monadG
   , printG
   , parseG
   , unparseG
@@ -44,6 +46,7 @@ import Control.Lens.Grammar.Boole
 import Control.Lens.Grammar.Kleene
 import Control.Lens.Grammar.Token
 import Control.Lens.Grammar.Symbol
+import Data.Bifunctor.Joker
 import Data.Maybe hiding (mapMaybe)
 import Data.Monoid
 import Data.Profunctor.Distributor
@@ -870,6 +873,27 @@ unparsecG
   -> ParsecState string a
 unparsecG parsector = unparsecP parsector
 
+applicativeG
+  :: ( Alternative f
+     , forall x. BackusNaurForm (f x)
+     , TokenAlgebra token (f token)
+     , TerminalSymbol token (f ())
+     )
+  => Grammar token a
+  -> f a
+applicativeG joker = runJoker joker
+
+monadG
+  :: ( MonadTry f
+     , Filterable f
+     , forall x. BackusNaurForm (f x)
+     , TokenAlgebra token (f token)
+     , TerminalSymbol token (f ())
+     )
+  => CtxGrammar token a
+  -> f a
+monadG joker = runJoker joker 
+
 {- | `putStringLn` is a utility that generalizes `putStrLn`
 to string-like interfaces such as `RegString` and `RegBnf`.
 -}
diff --git a/src/Control/Lens/Grammar/BackusNaur.hs b/src/Control/Lens/Grammar/BackusNaur.hs
index c9396127..1132d155 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -29,6 +29,7 @@ import Control.Lens.Extras
 import Control.Lens.Grammar.Kleene
 import Control.Lens.Grammar.Token
 import Control.Lens.Grammar.Symbol
+import Data.Bifunctor.Joker
 import Data.Coerce
 import Data.Foldable
 import Data.Function
@@ -59,8 +60,7 @@ prop> ruleRec _ = fix
 The `BackusNaurForm` interface permits overloading these methods,
 and tracing their occurence with a label.
 When a `BackusNaurForm` is a
-`Control.Monad.Fail.Try.MonadFail` &
-`Control.Monad.Fail.Try.MonadPlus`,
+`Control.Monad.Fail.Try.MonadTry`,
 this invariant should hold.
 
 prop> fail label = rule label mzero
@@ -181,6 +181,10 @@ instance (Ord rule, NonTerminalSymbol rule)
     rule label (Bnf newRule oldRules) = (nonTerminal label)
       {rulesBnf = Set.insert (label, newRule) oldRules}
     ruleRec label f = rule label (f (nonTerminal label))
+instance (forall x. BackusNaurForm (f x))
+  => BackusNaurForm (Joker f a b) where
+    rule name = Joker . rule name . runJoker
+    ruleRec name = Joker . ruleRec name . dimap Joker runJoker
 instance (Ord rule, TerminalSymbol token rule)
   => TerminalSymbol token (Bnf rule) where
   terminal = liftBnf0 . terminal
diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index cf65d386..13c846dd 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -29,6 +29,7 @@ import Control.Applicative
 import Control.Lens.Grammar.Boole
 import Control.Lens.Grammar.Symbol
 import Control.Lens.Grammar.Token
+import Data.Bifunctor.Joker
 import Data.Foldable
 import Data.MemoTrie
 import Data.Monoid
@@ -217,6 +218,9 @@ instance Categorized token => TokenAlgebra token (RegEx token) where
     NotOneOf as catTest -> RegExam (NotOneOf as catTest)
     Alternate exam1 exam2 ->
       RegExam (Alternate (tokenClass exam1) (tokenClass exam2))
+instance TokenAlgebra token (f token)
+  => TokenAlgebra token (Joker f token token) where
+    tokenClass = Joker . tokenClass
 instance Categorized token => Monoid (RegEx token) where
   mempty = SeqEmpty
 instance Categorized token => Semigroup (RegEx token) where
diff --git a/src/Control/Lens/Grammar/Symbol.hs b/src/Control/Lens/Grammar/Symbol.hs
index 7d1a3794..1da31de1 100644
--- a/src/Control/Lens/Grammar/Symbol.hs
+++ b/src/Control/Lens/Grammar/Symbol.hs
@@ -17,6 +17,7 @@ module Control.Lens.Grammar.Symbol
 import Control.Lens
 import Control.Lens.PartialIso
 import Control.Lens.Grammar.Token
+import Data.Bifunctor.Joker
 import Data.Profunctor
 import Data.Profunctor.Monoidal
 
@@ -31,3 +32,8 @@ class TerminalSymbol token s | s -> token where
 -- | A `nonTerminal` symbol in a grammar.
 class NonTerminalSymbol s where
   nonTerminal :: String -> s
+
+-- instances
+instance TerminalSymbol token (f ())
+  => TerminalSymbol token (Joker f () ()) where
+    terminal = Joker . terminal @token
diff --git a/src/Control/Lens/Grammar/Token.hs b/src/Control/Lens/Grammar/Token.hs
index 7aaf2bc6..682249ad 100644
--- a/src/Control/Lens/Grammar/Token.hs
+++ b/src/Control/Lens/Grammar/Token.hs
@@ -20,6 +20,7 @@ module Control.Lens.Grammar.Token
 
 import Control.Lens
 import Control.Lens.PartialIso
+import Data.Bifunctor.Joker
 import Data.Char
 import Data.Profunctor
 import Data.Profunctor.Monoidal
@@ -96,14 +97,6 @@ class Categorized token => Tokenized token p | p -> token where
     => Categorize token -> p
   notAsIn = satisfy . notAsIn
 
-instance Categorized token => Tokenized token (token -> Bool) where
-  anyToken _ = True
-  token = (==)
-  oneOf = flip elem
-  notOneOf = flip notElem
-  asIn = lmap categorize . (==)
-  notAsIn = lmap categorize . (/=)
-
 {- | A single token that satisfies a predicate. -}
 satisfy
   :: (Tokenized a (p a a), Choice p, Cochoice p)
@@ -118,3 +111,20 @@ tokens
      )
   => f a -> p s s
 tokens = foldr ((>:<) . token) asEmpty
+
+-- instances
+instance Categorized token => Tokenized token (token -> Bool) where
+  anyToken _ = True
+  token = (==)
+  oneOf = flip elem
+  notOneOf = flip notElem
+  asIn = lmap categorize . (==)
+  notAsIn = lmap categorize . (/=)
+instance Tokenized token (f token)
+  => Tokenized token (Joker f token token) where
+    anyToken = Joker (anyToken @token)
+    token = Joker . token @token
+    oneOf = Joker . oneOf @token
+    notOneOf = Joker . notOneOf @token
+    asIn = Joker . asIn @token
+    notAsIn = Joker . notAsIn @token
diff --git a/src/Control/Lens/PartialIso.hs b/src/Control/Lens/PartialIso.hs
index 95ab57a9..02504cfe 100644
--- a/src/Control/Lens/PartialIso.hs
+++ b/src/Control/Lens/PartialIso.hs
@@ -54,13 +54,18 @@ module Control.Lens.PartialIso
   , module Control.Lens.Prism
   ) where
 
+import Control.Applicative
+import Control.Arrow
 import Control.Lens
 import Control.Lens.Internal.NestedPrismTH
 import Control.Lens.Internal.Profunctor
 import Control.Lens.Iso
 import Control.Lens.Prism
 import Control.Monad
+import Data.Bifunctor.Clown
+import Data.Bifunctor.Joker
 import Data.Functor.Compose
+import Data.Functor.Contravariant.Divisible
 import Data.Profunctor
 import Data.Profunctor.Monad
 import Data.Profunctor.Yoneda
@@ -335,7 +340,6 @@ difoldr pattern
   . difoldr1 pattern
 
 -- Orphanage --
-
 instance (Profunctor p, Functor f)
   => Functor (WrappedPafb f p a) where fmap = rmap
 deriving via Compose (p a) f instance
@@ -357,3 +361,21 @@ instance Filterable (Forget r a) where
   catMaybes (Forget f) = Forget f
 instance Filterable f => Filterable (Star f a) where
   catMaybes (Star f) = Star (catMaybes . f)
+
+instance Monoid r => Applicative (Forget r a) where
+  pure _ = Forget mempty
+  Forget f <*> Forget g = Forget (f <> g)
+instance Decidable f => Applicative (Clown f a) where
+  pure _ = Clown conquer
+  Clown x <*> Clown y = Clown (divide (id &&& id) x y)
+deriving newtype instance Applicative f => Applicative (Joker f a)
+deriving newtype instance Alternative f => Alternative (Joker f a)
+deriving newtype instance Filterable f => Filterable (Joker f a)
+deriving newtype instance Monad m => Monad (Joker m a)
+deriving newtype instance MonadFail m => MonadFail (Joker m a)
+deriving newtype instance MonadPlus m => MonadPlus (Joker m a)
+instance Filterable f => Cochoice (Joker f) where
+  unleft (Joker x) = Joker
+    (mapMaybe (either Just (const Nothing)) x)
+  unright (Joker x) = Joker
+    (mapMaybe (either (const Nothing) Just) x)
diff --git a/src/Control/Monad/Fail/Try.hs b/src/Control/Monad/Fail/Try.hs
index 7420bf43..e4e3b033 100644
--- a/src/Control/Monad/Fail/Try.hs
+++ b/src/Control/Monad/Fail/Try.hs
@@ -20,7 +20,9 @@ module Control.Monad.Fail.Try
   ) where
 
 import Control.Applicative
+import Control.Lens.PartialIso ()
 import Control.Monad
+import Data.Bifunctor.Joker
 
 {- | `MonadTry` is a failure handling interface,
 with `fail` & `try` and redundant alternation operators.
@@ -44,3 +46,6 @@ class (MonadFail m, MonadPlus m) => MonadTry m where
   try :: m a -> m a
   default try :: m a -> m a
   try = id
+
+instance MonadTry m => MonadTry (Joker m a) where
+  try = Joker . try . runJoker
diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index c2df0391..71d40b04 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -276,3 +276,8 @@ instance Alternator p => Alternator (Yoneda p) where
   alternate (Right p) = proreturn (alternate (Right (proextract p)))
   someP = proreturn . someP . proextract
   optionP def = proreturn . optionP def . proextract
+instance Alternative f => Alternator (Joker f) where
+  alternate (Left (Joker x)) = Joker (Left <$> x)
+  alternate (Right (Joker y)) = Joker (Right <$> y)
+  someP (Joker x) = Joker (some x)
+  optionP def (Joker x) = Joker (x <|> withPrism def (\f _ -> pure (f ())))
diff --git a/src/Data/Profunctor/Filtrator.hs b/src/Data/Profunctor/Filtrator.hs
index 5ea8ef7b..43c8c7ab 100644
--- a/src/Data/Profunctor/Filtrator.hs
+++ b/src/Data/Profunctor/Filtrator.hs
@@ -19,6 +19,7 @@ import Control.Arrow
 import Control.Lens.PartialIso
 import Control.Lens.Internal.Profunctor
 import Control.Monad
+import Data.Bifunctor.Joker
 import Data.Profunctor
 import Data.Profunctor.Distributor
 import Data.Profunctor.Monad
@@ -100,3 +101,8 @@ instance Filtrator (PartialExchange a b) where
     ( PartialExchange (f . Left) (either Just (pure Nothing) <=< g)
     , PartialExchange (f . Right) (either (pure Nothing) Just <=< g)
     )
+instance Filterable f => Filtrator (Joker f) where
+  filtrate (Joker x) =
+    ( Joker (mapMaybe (either Just (const Nothing)) x)
+    , Joker (mapMaybe (either (const Nothing) Just) x)
+    )
diff --git a/src/Data/Profunctor/Monoidal.hs b/src/Data/Profunctor/Monoidal.hs
index d19368f8..24d91434 100644
--- a/src/Data/Profunctor/Monoidal.hs
+++ b/src/Data/Profunctor/Monoidal.hs
@@ -28,12 +28,9 @@ import Control.Lens.Internal.Context
 import Control.Lens.Internal.Prism
 import Control.Lens.Internal.Profunctor
 import Control.Lens.PartialIso
-import Data.Bifunctor.Clown
-import Data.Bifunctor.Joker
 import Data.Bifunctor.Product
 import Data.Distributive
 import Data.Functor.Compose
-import Data.Functor.Contravariant.Divisible
 import Data.Profunctor hiding (WrappedArrow)
 import Data.Profunctor qualified as Pro (WrappedArrow)
 import Data.Profunctor.Cayley
@@ -219,14 +216,6 @@ instance Applicative (FunList a b) where
 instance Sellable (->) FunList where sell b = MoreFun b (pure id)
 
 -- Orphanage --
-
-instance Monoid r => Applicative (Forget r a) where
-  pure _ = Forget mempty
-  Forget f <*> Forget g = Forget (f <> g)
-instance Decidable f => Applicative (Clown f a) where
-  pure _ = Clown conquer
-  Clown x <*> Clown y = Clown (divide (id &&& id) x y)
-deriving newtype instance Applicative f => Applicative (Joker f a)
 deriving via Compose (p a) f instance
   (Profunctor p, Applicative (p a), Applicative f)
     => Applicative (WrappedPafb f p a)

From 3b258bc91401554ac1f2d9523cb26123a49c27da Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 14 Apr 2026 21:23:13 -0700
Subject: [PATCH 05/30] Megaparsec example

and make MonadTry imply Filterable
---
 src/Control/Lens/Grammar.hs              | 60 ++++++++++++++++++++++--
 src/Control/Monad/Fail/Try.hs            | 10 ++--
 src/Data/Profunctor/Grammar.hs           |  7 +--
 src/Data/Profunctor/Grammar/Parsector.hs |  1 -
 4 files changed, 68 insertions(+), 10 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 1f4dd488..e92ff910 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -771,7 +771,7 @@ regbnfGrammar :: Grammar Char RegBnf
 regbnfGrammar = rule "regbnf" $ _RegBnf . _Bnf >~
   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,
@@ -883,16 +883,70 @@ applicativeG
   -> f a
 applicativeG joker = runJoker joker
 
+{- | You can generate any parser `Monad` backend
+from a `CtxGrammar` with `monadG`.
+Let's see how to do this without orphan instances,
+using the Megaparsec library.
+
+@
+import qualified Text.Megaparsec as M
+import qualified Text.Megaparsec.Char as M
+import Control.Lens.Grammar
+import GHC.IsList
+
+newtype WrapMega s e m a = WrapMega {unwrapMega :: M.ParsecT s e m a}
+  deriving newtype
+    ( Functor, Applicative, Alternative
+    , Monad, MonadPlus, MonadFail
+    )
+instance (M.Stream s, IsList (M.Tokens s), Item (M.Tokens s) ~ token, Ord e)
+  => TerminalSymbol token (WrapMega e s m ()) where
+  terminal str = WrapMega $ do
+    _ <- M.chunk (fromList str)
+    pure ()
+instance (M.Stream s, token ~ M.Token s, Categorized token, Show token, Show (Categorize token), Ord e)
+  => TokenAlgebra token (WrapMega e s m token) where
+  tokenClass exam = WrapMega $
+    M.label (show exam) (M.satisfy (tokenClass exam))
+instance (M.Stream s, token ~ M.Token s, Categorized token, Show (Categorize token), Ord e)
+  => Tokenized token (WrapMega e s m token) where
+  anyToken = WrapMega M.anySingle
+  token = WrapMega .  M.single
+  oneOf = WrapMega . M.oneOf
+  notOneOf = WrapMega . M.noneOf
+  asIn cat = WrapMega $ M.label ("in category " ++ show cat)
+    (M.satisfy (tokenClass (asIn cat)))
+  notAsIn cat = WrapMega $ M.label ("not in category " ++ show cat)
+    (M.satisfy (tokenClass (notAsIn cat)))
+instance (M.Stream s, Ord e)
+  => BackusNaurForm (WrapMega e s m a) where
+  rule lbl (WrapMega p) = WrapMega (M.label lbl p)
+  ruleRec lbl = rule lbl . fix
+instance M.Stream s => Filterable (WrapMega e s m) where
+  catMaybes m = m >>= maybe (fail "unrestricted filtration") return
+instance (M.Stream s, Ord e) => MonadTry (WrapMega e s m) where
+  try (WrapMega p) = WrapMega (M.try p)
+
+megaparsecG
+  :: ( M.Stream s, IsList (M.Tokens s), token ~ Item (M.Tokens s)
+     , token ~ M.Token s, Categorized token
+     , Show token, Show (Categorize token), Ord e
+     )
+  => CtxGrammar token a
+  -> M.ParsecT e s m a
+megaparsecG = unwrapMega . monadG
+@
+
+-}
 monadG
   :: ( MonadTry f
-     , Filterable f
      , forall x. BackusNaurForm (f x)
      , TokenAlgebra token (f token)
      , TerminalSymbol token (f ())
      )
   => CtxGrammar token a
   -> f a
-monadG joker = runJoker joker 
+monadG joker = runJoker joker
 
 {- | `putStringLn` is a utility that generalizes `putStrLn`
 to string-like interfaces such as `RegString` and `RegBnf`.
diff --git a/src/Control/Monad/Fail/Try.hs b/src/Control/Monad/Fail/Try.hs
index e4e3b033..ad27ef88 100644
--- a/src/Control/Monad/Fail/Try.hs
+++ b/src/Control/Monad/Fail/Try.hs
@@ -17,18 +17,22 @@ module Control.Monad.Fail.Try
   , MonadPlus (..)
     -- * Alternative
   , Alternative (..)
+    -- * Filterable
+  , Filterable (..)
   ) where
 
 import Control.Applicative
 import Control.Lens.PartialIso ()
 import Control.Monad
 import Data.Bifunctor.Joker
+import Witherable
 
-{- | `MonadTry` is a failure handling interface,
-with `fail` & `try` and redundant alternation operators.
+{- | `MonadTry` is a failure handling interface, with `fail` & `try`
+and redundant alternation & filtration operators.
 
 prop> empty = mzero
 prop> (<|>) = mplus
+prop> filter = mfilter
 
 When a `MonadTry` is also a
 `Control.Lens.Grammar.BackusNaur.BackusNaurForm`,
@@ -37,7 +41,7 @@ then the following invariant should hold.
 prop> fail label = rule label empty
 
 -}
-class (MonadFail m, MonadPlus m) => MonadTry m where
+class (MonadFail m, MonadPlus m, Filterable m) => MonadTry m where
 
   {- | A handler for failures.
   Used for backtracking state on failure in
diff --git a/src/Data/Profunctor/Grammar.hs b/src/Data/Profunctor/Grammar.hs
index 30279a2d..b721355d 100644
--- a/src/Data/Profunctor/Grammar.hs
+++ b/src/Data/Profunctor/Grammar.hs
@@ -40,7 +40,6 @@ import Data.Profunctor.Monoidal
 import Data.Void
 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)}
@@ -180,7 +179,8 @@ 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 (Alternative m, Monad m, Filterable m)
+  => MonadTry (Parsor s m a)
 instance AsEmpty s => Matching s (Parsor s [] a b) where
   word =~ p = case
     [ () | (_, remaining) <- runParsor p Nothing word
@@ -289,7 +289,8 @@ 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)
+instance (Alternative m, Monad m, Filterable 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
index e6c438a3..c5bb2b22 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -41,7 +41,6 @@ import Data.Profunctor.Monoidal
 import Data.Tree
 import GHC.Exts
 import Prelude hiding (id, (.))
-import Witherable
 
 {- | `Parsector` is an invertible @LL(1)@ parser which is intended
 to provide detailed error information, based on [Parsec]

From 5c3b5d56630865d5e5e9b316069c4fb83e874b05 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 14 Apr 2026 22:11:32 -0700
Subject: [PATCH 06/30] internalize the orphanage

---
 distributors.cabal                            |   3 +-
 src/Control/Lens/Grammar.hs                   |   9 +-
 src/Control/Lens/Grammar/BackusNaur.hs        |   2 +
 .../{ => Grammar}/Internal/NestedPrismTH.hs   |   4 +-
 .../Lens/Grammar/Internal/Orphanage.hs        | 140 ++++++++++++++++++
 src/Control/Lens/Grammar/Kleene.hs            |   4 +
 src/Control/Lens/Grammar/Symbol.hs            |   6 +
 src/Control/Lens/Grammar/Token.hs             |   9 ++
 src/Control/Lens/PartialIso.hs                |  54 +------
 src/Control/Monad/Fail/Try.hs                 |   2 +
 src/Data/Profunctor/Distributor.hs            |   3 +-
 src/Data/Profunctor/Monoidal.hs               |  76 +---------
 12 files changed, 179 insertions(+), 133 deletions(-)
 rename src/Control/Lens/{ => Grammar}/Internal/NestedPrismTH.hs (99%)
 create mode 100644 src/Control/Lens/Grammar/Internal/Orphanage.hs

diff --git a/distributors.cabal b/distributors.cabal
index 7350ef47..2ec7979b 100644
--- a/distributors.cabal
+++ b/distributors.cabal
@@ -33,11 +33,12 @@ library
       Control.Lens.Grammar
       Control.Lens.Grammar.BackusNaur
       Control.Lens.Grammar.Boole
+      Control.Lens.Grammar.Internal.NestedPrismTH
+      Control.Lens.Grammar.Internal.Orphanage
       Control.Lens.Grammar.Kleene
       Control.Lens.Grammar.Symbol
       Control.Lens.Grammar.Token
       Control.Lens.Grate
-      Control.Lens.Internal.NestedPrismTH
       Control.Lens.Monocle
       Control.Lens.PartialIso
       Control.Lens.Wither
diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index e92ff910..dd01215d 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -20,18 +20,19 @@ module Control.Lens.Grammar
   , regexGrammar
     -- * Context-free grammar
   , Grammar
-  , applicativeG
   , RegBnf (..)
   , regbnfG
   , regbnfGrammar
+  , applicativeG
     -- * Context-sensitive grammar
   , CtxGrammar
-  , monadG
   , printG
   , parseG
   , unparseG
   , parsecG
   , unparsecG
+  , readG
+  , monadG
     -- * Utility
   , putStringLn
     -- * Re-exports
@@ -59,6 +60,7 @@ import Data.Profunctor.Separator
 import Data.String
 import GHC.Exts
 import Prelude hiding (filter)
+import Text.ParserCombinators.ReadP (ReadP)
 import Witherable
 
 -- Re-exports
@@ -883,6 +885,9 @@ applicativeG
   -> f a
 applicativeG joker = runJoker joker
 
+readG :: Grammar Char a -> ReadP a
+readG = monadG
+
 {- | You can generate any parser `Monad` backend
 from a `CtxGrammar` with `monadG`.
 Let's see how to do this without orphan instances,
diff --git a/src/Control/Lens/Grammar/BackusNaur.hs b/src/Control/Lens/Grammar/BackusNaur.hs
index 1132d155..49464426 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -36,6 +36,7 @@ import Data.Function
 import Data.MemoTrie
 import qualified Data.Set as Set
 import Data.Set (Set)
+import Text.ParserCombinators.ReadP (ReadP)
 
 {- | `BackusNaurForm` grammar combinators formalize traced
 `rule` abstraction and general recursion with `ruleRec`,
@@ -185,6 +186,7 @@ instance (forall x. BackusNaurForm (f x))
   => BackusNaurForm (Joker f a b) where
     rule name = Joker . rule name . runJoker
     ruleRec name = Joker . ruleRec name . dimap Joker runJoker
+instance BackusNaurForm (ReadP a)
 instance (Ord rule, TerminalSymbol token rule)
   => TerminalSymbol token (Bnf rule) where
   terminal = liftBnf0 . terminal
diff --git a/src/Control/Lens/Internal/NestedPrismTH.hs b/src/Control/Lens/Grammar/Internal/NestedPrismTH.hs
similarity index 99%
rename from src/Control/Lens/Internal/NestedPrismTH.hs
rename to src/Control/Lens/Grammar/Internal/NestedPrismTH.hs
index f444db3f..773da1b8 100644
--- a/src/Control/Lens/Internal/NestedPrismTH.hs
+++ b/src/Control/Lens/Grammar/Internal/NestedPrismTH.hs
@@ -1,5 +1,5 @@
 {- |
-Module      : Control.Lens.Internal.NestedPrismTH
+Module      : Control.Lens.Grammar.Internal.NestedPrismTH
 Description : nested pair prisms
 Copyright   : (C) 2026 - Eitan Chatav
 License     : BSD-style (see the file LICENSE)
@@ -11,7 +11,7 @@ Code is duplicated from `Control.Lens.Internal.PrismTH`,
 with small tweaks to support nested pairs.
 -}
 
-module Control.Lens.Internal.NestedPrismTH
+module Control.Lens.Grammar.Internal.NestedPrismTH
   ( -- * Nested prisms
     makeNestedPrisms
   ) where
diff --git a/src/Control/Lens/Grammar/Internal/Orphanage.hs b/src/Control/Lens/Grammar/Internal/Orphanage.hs
new file mode 100644
index 00000000..c71fb53e
--- /dev/null
+++ b/src/Control/Lens/Grammar/Internal/Orphanage.hs
@@ -0,0 +1,140 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+{- |
+Module      : Control.Lens.Grammar.Internal.Orphanage
+Description : partial isomorphisms
+Copyright   : (C) 2026 - Eitan Chatav
+License     : BSD-style (see the file LICENSE)
+Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
+Stability   : provisional
+Portability : non-portable
+
+An orphanage for instances without a home.
+-}
+
+module Control.Lens.Grammar.Internal.Orphanage () where
+
+import Control.Applicative hiding (WrappedArrow)
+import Control.Applicative qualified as Ap (WrappedArrow)
+import Control.Arrow
+import Control.Lens
+import Control.Lens.Internal.Prism
+import Control.Lens.Internal.Profunctor
+import Control.Monad
+import Data.Bifunctor.Clown
+import Data.Bifunctor.Joker
+import Data.Bifunctor.Product
+import Data.Distributive
+import Data.Functor.Compose
+import Data.Functor.Contravariant.Divisible
+import Data.Profunctor hiding (WrappedArrow)
+import Data.Profunctor qualified as Pro (WrappedArrow)
+import Data.Profunctor.Cayley
+import Data.Profunctor.Composition
+import Data.Profunctor.Monad
+import Data.Profunctor.Yoneda
+import Text.ParserCombinators.ReadP (ReadP)
+import Witherable
+
+-- Orphanage --
+instance (Profunctor p, Functor f)
+  => Functor (WrappedPafb f p a) where fmap = rmap
+deriving via Compose (p a) f instance
+  (Profunctor p, Functor (p a), Filterable f)
+    => Filterable (WrappedPafb f p a)
+instance (Profunctor p, Filterable f)
+  => Cochoice (WrappedPafb f p) where
+    unleft (WrapPafb p) = WrapPafb $
+      dimap Left (mapMaybe (either Just (const Nothing))) p
+    unright (WrapPafb p) = WrapPafb $
+      dimap Right (mapMaybe (either (const Nothing) Just)) p
+instance (Profunctor p, Filterable (p a))
+  => Filterable (Yoneda p a) where
+    catMaybes = proreturn . catMaybes . proextract
+instance (Profunctor p, Filterable (p a))
+  => Filterable (Coyoneda p a) where
+    catMaybes = proreturn . catMaybes . proextract
+instance Filterable f => Filterable (Star f a) where
+  catMaybes (Star f) = Star (catMaybes . f)
+instance Monoid r => Applicative (Forget r a) where
+  pure _ = Forget mempty
+  Forget f <*> Forget g = Forget (f <> g)
+instance Filterable (Forget r a) where
+  catMaybes (Forget f) = Forget f
+instance Decidable f => Applicative (Clown f a) where
+  pure _ = Clown conquer
+  Clown x <*> Clown y = Clown (divide (id &&& id) x y)
+deriving newtype instance Applicative f => Applicative (Joker f a)
+deriving newtype instance Alternative f => Alternative (Joker f a)
+deriving newtype instance Filterable f => Filterable (Joker f a)
+deriving newtype instance Monad m => Monad (Joker m a)
+deriving newtype instance MonadFail m => MonadFail (Joker m a)
+deriving newtype instance MonadPlus m => MonadPlus (Joker m a)
+instance Filterable f => Cochoice (Joker f) where
+  unleft (Joker x) = Joker
+    (mapMaybe (either Just (const Nothing)) x)
+  unright (Joker x) = Joker
+    (mapMaybe (either (const Nothing) Just) x)
+instance Filterable ReadP where
+  catMaybes m = m >>= maybe empty pure
+deriving via Compose (p a) f instance
+  (Profunctor p, Applicative (p a), Applicative f)
+    => Applicative (WrappedPafb f p a)
+deriving via Compose (p a) f instance
+  (Profunctor p, Alternative (p a), Applicative f)
+    => Alternative (WrappedPafb f p a)
+instance (Closed p, Distributive f)
+  => Closed (WrappedPafb f p) where
+    closed (WrapPafb p) = WrapPafb (rmap distribute (closed p))
+deriving via (Ap.WrappedArrow p a) instance Arrow p
+  => Functor (Pro.WrappedArrow p a)
+deriving via (Ap.WrappedArrow p a) instance Arrow p
+  => Applicative (Pro.WrappedArrow p a)
+deriving via (Pro.WrappedArrow p) instance Arrow p
+  => Profunctor (Ap.WrappedArrow p)
+instance
+  ( forall x. Applicative (p x), Profunctor p
+  , Applicative (q a), Profunctor q
+  ) => Applicative (Procompose p q a) where
+    pure b = Procompose (pure b) (pure b)
+    Procompose wb aw <*> Procompose vb av = Procompose
+      (liftA2 ($) (lmap fst wb) (lmap snd vb))
+      (liftA2 (,) aw av)
+instance (forall x. Applicative (p x), forall x. Applicative (q x))
+  => Applicative (Product p q a) where
+    pure b = Pair (pure b) (pure b)
+    Pair x0 y0 <*> Pair x1 y1 = Pair (x0 <*> x1) (y0 <*> y1)
+instance (Functor f, Functor (p a)) => Functor (Cayley f p a) where
+  fmap f (Cayley x) = Cayley (fmap (fmap f) x)
+instance (Applicative f, Applicative (p a)) => Applicative (Cayley f p a) where
+  pure b = Cayley (pure (pure b))
+  Cayley x <*> Cayley y = Cayley ((<*>) <$> x <*> y)
+instance (Profunctor p, Applicative (p a))
+  => Applicative (Yoneda p a) where
+    pure = proreturn . pure
+    ab <*> cd = proreturn (proextract ab <*> proextract cd)
+instance (Profunctor p, Applicative (p a))
+  => Applicative (Coyoneda p a) where
+    pure = proreturn . pure
+    ab <*> cd = proreturn (proextract ab <*> proextract cd)
+instance (Profunctor p, Alternative (p a))
+  => Alternative (Yoneda p a) where
+    empty = proreturn empty
+    ab <|> cd = proreturn (proextract ab <|> proextract cd)
+    many = proreturn . many . proextract
+instance (Profunctor p, Alternative (p a))
+  => Alternative (Coyoneda p a) where
+    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
+    )
diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index 13c846dd..d86aaab8 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -38,6 +38,8 @@ import Data.Profunctor.Distributor
 import Data.Set (Set)
 import qualified Data.Set as Set
 import GHC.Generics
+import Text.ParserCombinators.ReadP (ReadP)
+import qualified Text.ParserCombinators.ReadP as ReadP
 
 {- | A `KleeneStarAlgebra` is a ring
 with a generally non-commutative multiplication,
@@ -221,6 +223,8 @@ instance Categorized token => TokenAlgebra token (RegEx token) where
 instance TokenAlgebra token (f token)
   => TokenAlgebra token (Joker f token token) where
     tokenClass = Joker . tokenClass
+instance TokenAlgebra Char (ReadP Char) where
+  tokenClass = ReadP.satisfy . tokenClass
 instance Categorized token => Monoid (RegEx token) where
   mempty = SeqEmpty
 instance Categorized token => Semigroup (RegEx token) where
diff --git a/src/Control/Lens/Grammar/Symbol.hs b/src/Control/Lens/Grammar/Symbol.hs
index 1da31de1..b1a01dad 100644
--- a/src/Control/Lens/Grammar/Symbol.hs
+++ b/src/Control/Lens/Grammar/Symbol.hs
@@ -20,6 +20,8 @@ import Control.Lens.Grammar.Token
 import Data.Bifunctor.Joker
 import Data.Profunctor
 import Data.Profunctor.Monoidal
+import Text.ParserCombinators.ReadP (ReadP)
+import qualified Text.ParserCombinators.ReadP as ReadP
 
 -- | A `terminal` symbol in a grammar.
 class TerminalSymbol token s | s -> token where
@@ -37,3 +39,7 @@ class NonTerminalSymbol s where
 instance TerminalSymbol token (f ())
   => TerminalSymbol token (Joker f () ()) where
     terminal = Joker . terminal @token
+instance TerminalSymbol Char (ReadP ()) where
+  terminal str = do
+    _ <- ReadP.string str
+    return ()
diff --git a/src/Control/Lens/Grammar/Token.hs b/src/Control/Lens/Grammar/Token.hs
index 682249ad..884d5963 100644
--- a/src/Control/Lens/Grammar/Token.hs
+++ b/src/Control/Lens/Grammar/Token.hs
@@ -25,6 +25,8 @@ import Data.Char
 import Data.Profunctor
 import Data.Profunctor.Monoidal
 import Data.Word
+import Text.ParserCombinators.ReadP (ReadP)
+import qualified Text.ParserCombinators.ReadP as ReadP
 
 {- | `Categorized` provides a type family `Categorize`
 and a function to `categorize` tokens into disjoint categories.
@@ -128,3 +130,10 @@ instance Tokenized token (f token)
     notOneOf = Joker . notOneOf @token
     asIn = Joker . asIn @token
     notAsIn = Joker . notAsIn @token
+instance Tokenized Char (ReadP Char) where
+  anyToken = ReadP.get
+  token = ReadP.char
+  oneOf = ReadP.satisfy . oneOf
+  notOneOf = ReadP.satisfy . notOneOf
+  asIn = ReadP.satisfy . asIn
+  notAsIn = ReadP.satisfy . notAsIn
diff --git a/src/Control/Lens/PartialIso.hs b/src/Control/Lens/PartialIso.hs
index 02504cfe..fb105e75 100644
--- a/src/Control/Lens/PartialIso.hs
+++ b/src/Control/Lens/PartialIso.hs
@@ -11,8 +11,6 @@ See Rendel & Ostermann,
 [Invertible syntax descriptions](https://www.informatik.uni-marburg.de/~rendel/unparse/)
 -}
 
-{-# OPTIONS_GHC -Wno-orphans #-}
-
 module Control.Lens.PartialIso
   ( -- * PartialIso
     dimapMaybe
@@ -54,21 +52,14 @@ module Control.Lens.PartialIso
   , module Control.Lens.Prism
   ) where
 
-import Control.Applicative
-import Control.Arrow
 import Control.Lens
-import Control.Lens.Internal.NestedPrismTH
+import Control.Lens.Grammar.Internal.Orphanage ()
+import Control.Lens.Grammar.Internal.NestedPrismTH
 import Control.Lens.Internal.Profunctor
 import Control.Lens.Iso
 import Control.Lens.Prism
 import Control.Monad
-import Data.Bifunctor.Clown
-import Data.Bifunctor.Joker
-import Data.Functor.Compose
-import Data.Functor.Contravariant.Divisible
 import Data.Profunctor
-import Data.Profunctor.Monad
-import Data.Profunctor.Yoneda
 import Witherable
 
 {- | The `dimapMaybe` function endows
@@ -338,44 +329,3 @@ difoldr
 difoldr pattern
   = dimap (Empty,) (fmap snd)
   . difoldr1 pattern
-
--- Orphanage --
-instance (Profunctor p, Functor f)
-  => Functor (WrappedPafb f p a) where fmap = rmap
-deriving via Compose (p a) f instance
-  (Profunctor p, Functor (p a), Filterable f)
-    => Filterable (WrappedPafb f p a)
-instance (Profunctor p, Filterable f)
-  => Cochoice (WrappedPafb f p) where
-    unleft (WrapPafb p) = WrapPafb $
-      dimap Left (mapMaybe (either Just (const Nothing))) p
-    unright (WrapPafb p) = WrapPafb $
-      dimap Right (mapMaybe (either (const Nothing) Just)) p
-instance (Profunctor p, Filterable (p a))
-  => Filterable (Yoneda p a) where
-    catMaybes = proreturn . catMaybes . proextract
-instance (Profunctor p, Filterable (p a))
-  => Filterable (Coyoneda p a) where
-    catMaybes = proreturn . catMaybes . proextract
-instance Filterable (Forget r a) where
-  catMaybes (Forget f) = Forget f
-instance Filterable f => Filterable (Star f a) where
-  catMaybes (Star f) = Star (catMaybes . f)
-
-instance Monoid r => Applicative (Forget r a) where
-  pure _ = Forget mempty
-  Forget f <*> Forget g = Forget (f <> g)
-instance Decidable f => Applicative (Clown f a) where
-  pure _ = Clown conquer
-  Clown x <*> Clown y = Clown (divide (id &&& id) x y)
-deriving newtype instance Applicative f => Applicative (Joker f a)
-deriving newtype instance Alternative f => Alternative (Joker f a)
-deriving newtype instance Filterable f => Filterable (Joker f a)
-deriving newtype instance Monad m => Monad (Joker m a)
-deriving newtype instance MonadFail m => MonadFail (Joker m a)
-deriving newtype instance MonadPlus m => MonadPlus (Joker m a)
-instance Filterable f => Cochoice (Joker f) where
-  unleft (Joker x) = Joker
-    (mapMaybe (either Just (const Nothing)) x)
-  unright (Joker x) = Joker
-    (mapMaybe (either (const Nothing) Just) x)
diff --git a/src/Control/Monad/Fail/Try.hs b/src/Control/Monad/Fail/Try.hs
index ad27ef88..6a65f44a 100644
--- a/src/Control/Monad/Fail/Try.hs
+++ b/src/Control/Monad/Fail/Try.hs
@@ -25,6 +25,7 @@ import Control.Applicative
 import Control.Lens.PartialIso ()
 import Control.Monad
 import Data.Bifunctor.Joker
+import Text.ParserCombinators.ReadP (ReadP)
 import Witherable
 
 {- | `MonadTry` is a failure handling interface, with `fail` & `try`
@@ -53,3 +54,4 @@ class (MonadFail m, MonadPlus m, Filterable m) => MonadTry m where
 
 instance MonadTry m => MonadTry (Joker m a) where
   try = Joker . try . runJoker
+instance MonadTry ReadP
diff --git a/src/Data/Profunctor/Distributor.hs b/src/Data/Profunctor/Distributor.hs
index 71d40b04..b7633bf4 100644
--- a/src/Data/Profunctor/Distributor.hs
+++ b/src/Data/Profunctor/Distributor.hs
@@ -280,4 +280,5 @@ instance Alternative f => Alternator (Joker f) where
   alternate (Left (Joker x)) = Joker (Left <$> x)
   alternate (Right (Joker y)) = Joker (Right <$> y)
   someP (Joker x) = Joker (some x)
-  optionP def (Joker x) = Joker (x <|> withPrism def (\f _ -> pure (f ())))
+  optionP def (Joker x) =
+    Joker (x <|> withPrism def (\f _ -> pure (f ())))
diff --git a/src/Data/Profunctor/Monoidal.hs b/src/Data/Profunctor/Monoidal.hs
index 24d91434..958ddbd1 100644
--- a/src/Data/Profunctor/Monoidal.hs
+++ b/src/Data/Profunctor/Monoidal.hs
@@ -20,23 +20,10 @@ module Data.Profunctor.Monoidal
   , meander, eotFunList
   ) where
 
-import Control.Applicative hiding (WrappedArrow)
-import Control.Applicative qualified as Ap (WrappedArrow)
-import Control.Arrow
-import Control.Lens hiding (chosen)
+import Control.Lens
 import Control.Lens.Internal.Context
-import Control.Lens.Internal.Prism
-import Control.Lens.Internal.Profunctor
 import Control.Lens.PartialIso
-import Data.Bifunctor.Product
 import Data.Distributive
-import Data.Functor.Compose
-import Data.Profunctor hiding (WrappedArrow)
-import Data.Profunctor qualified as Pro (WrappedArrow)
-import Data.Profunctor.Cayley
-import Data.Profunctor.Composition
-import Data.Profunctor.Monad
-import Data.Profunctor.Yoneda
 import GHC.IsList
 
 -- Monoidal --
@@ -214,64 +201,3 @@ instance Applicative (FunList a b) where
     MoreFun a h -> \l ->
       MoreFun a (flip <$> h <*> fromFun l)
 instance Sellable (->) FunList where sell b = MoreFun b (pure id)
-
--- Orphanage --
-deriving via Compose (p a) f instance
-  (Profunctor p, Applicative (p a), Applicative f)
-    => Applicative (WrappedPafb f p a)
-deriving via Compose (p a) f instance
-  (Profunctor p, Alternative (p a), Applicative f)
-    => Alternative (WrappedPafb f p a)
-instance (Closed p, Distributive f)
-  => Closed (WrappedPafb f p) where
-    closed (WrapPafb p) = WrapPafb (rmap distribute (closed p))
-deriving via (Ap.WrappedArrow p a) instance Arrow p
-  => Functor (Pro.WrappedArrow p a)
-deriving via (Ap.WrappedArrow p a) instance Arrow p
-  => Applicative (Pro.WrappedArrow p a)
-deriving via (Pro.WrappedArrow p) instance Arrow p
-  => Profunctor (Ap.WrappedArrow p)
-instance (Monoidal p, Applicative (q a))
-  => Applicative (Procompose p q a) where
-    pure b = Procompose (pure b) (pure b)
-    Procompose wb aw <*> Procompose vb av = Procompose
-      (dimap2 fst snd ($) wb vb)
-      (liftA2 (,) aw av)
-instance (Monoidal p, Monoidal q)
-  => Applicative (Product p q a) where
-    pure b = Pair (pure b) (pure b)
-    Pair x0 y0 <*> Pair x1 y1 = Pair (x0 <*> x1) (y0 <*> y1)
-instance (Functor f, Functor (p a)) => Functor (Cayley f p a) where
-  fmap f (Cayley x) = Cayley (fmap (fmap f) x)
-instance (Applicative f, Applicative (p a)) => Applicative (Cayley f p a) where
-  pure b = Cayley (pure (pure b))
-  Cayley x <*> Cayley y = Cayley ((<*>) <$> x <*> y)
-instance (Profunctor p, Applicative (p a))
-  => Applicative (Yoneda p a) where
-    pure = proreturn . pure
-    ab <*> cd = proreturn (proextract ab <*> proextract cd)
-instance (Profunctor p, Applicative (p a))
-  => Applicative (Coyoneda p a) where
-    pure = proreturn . pure
-    ab <*> cd = proreturn (proextract ab <*> proextract cd)
-instance (Profunctor p, Alternative (p a))
-  => Alternative (Yoneda p a) where
-    empty = proreturn empty
-    ab <|> cd = proreturn (proextract ab <|> proextract cd)
-    many = proreturn . many . proextract
-instance (Profunctor p, Alternative (p a))
-  => Alternative (Coyoneda p a) where
-    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 161002a6d7e364b2e3c02042dd96f6f0bc421b3e Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 14 Apr 2026 22:25:13 -0700
Subject: [PATCH 07/30] 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 dd01215d..882a44d0 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -886,7 +886,7 @@ applicativeG
 applicativeG joker = runJoker joker
 
 readG :: Grammar Char a -> ReadP a
-readG = monadG
+readG joker = monadG joker
 
 {- | You can generate any parser `Monad` backend
 from a `CtxGrammar` with `monadG`.

From f6b2119aeb0c82cc80eabb2f4a1de8d04dc419bc Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 14 Apr 2026 23:05:38 -0700
Subject: [PATCH 08/30] docs

---
 src/Control/Lens/Grammar.hs     | 35 +++++++++++++++++++++------------
 src/Data/Profunctor/Monoidal.hs |  4 ++--
 2 files changed, 24 insertions(+), 15 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 882a44d0..489452a0 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -99,7 +99,7 @@ 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,
+You could generate it with the TemplateHaskell combinator,
 `makeNestedPrisms`.
 
 @makeNestedPrisms ''SemVer@
@@ -875,20 +875,27 @@ unparsecG
   -> ParsecState string a
 unparsecG parsector = unparsecP parsector
 
+{- | Generate any `Applicative` parser backend
+from a `Grammar` with `applicativeG`.
+It works the same way as `monadG`,
+for parsers without `Monad` instances.
+That permits backends which can only parse context-free `Grammar`s.
+-}
 applicativeG
   :: ( Alternative f
      , forall x. BackusNaurForm (f x)
      , TokenAlgebra token (f token)
      , TerminalSymbol token (f ())
      )
-  => Grammar token a
+  => Grammar token a -- ^ context-free grammar
   -> f a
 applicativeG joker = runJoker joker
 
-readG :: Grammar Char a -> ReadP a
+{- | Generate a `ReadP` backend from a `CtxGrammar` `Char`. -}
+readG :: CtxGrammar Char a -> ReadP a
 readG joker = monadG joker
 
-{- | You can generate any parser `Monad` backend
+{- | Generate any parser `Monad` backend
 from a `CtxGrammar` with `monadG`.
 Let's see how to do this without orphan instances,
 using the Megaparsec library.
@@ -909,14 +916,16 @@ instance (M.Stream s, IsList (M.Tokens s), Item (M.Tokens s) ~ token, Ord e)
   terminal str = WrapMega $ do
     _ <- M.chunk (fromList str)
     pure ()
-instance (M.Stream s, token ~ M.Token s, Categorized token, Show token, Show (Categorize token), Ord e)
-  => TokenAlgebra token (WrapMega e s m token) where
+instance
+  ( M.Stream s, token ~ M.Token s, Categorized token
+  , Show token, Show (Categorize token), Ord e
+  ) => TokenAlgebra token (WrapMega e s m token) where
   tokenClass exam = WrapMega $
     M.label (show exam) (M.satisfy (tokenClass exam))
 instance (M.Stream s, token ~ M.Token s, Categorized token, Show (Categorize token), Ord e)
   => Tokenized token (WrapMega e s m token) where
   anyToken = WrapMega M.anySingle
-  token = WrapMega .  M.single
+  token = WrapMega . M.single
   oneOf = WrapMega . M.oneOf
   notOneOf = WrapMega . M.noneOf
   asIn cat = WrapMega $ M.label ("in category " ++ show cat)
@@ -944,13 +953,13 @@ megaparsecG = unwrapMega . monadG
 
 -}
 monadG
-  :: ( MonadTry f
-     , forall x. BackusNaurForm (f x)
-     , TokenAlgebra token (f token)
-     , TerminalSymbol token (f ())
+  :: ( MonadTry m
+     , forall x. BackusNaurForm (m x)
+     , TokenAlgebra token (m token)
+     , TerminalSymbol token (m ())
      )
-  => CtxGrammar token a
-  -> f a
+  => CtxGrammar token a -- ^ context-sensitive grammar
+  -> m a
 monadG joker = runJoker joker
 
 {- | `putStringLn` is a utility that generalizes `putStrLn`
diff --git a/src/Data/Profunctor/Monoidal.hs b/src/Data/Profunctor/Monoidal.hs
index 958ddbd1..5b5c7d1b 100644
--- a/src/Data/Profunctor/Monoidal.hs
+++ b/src/Data/Profunctor/Monoidal.hs
@@ -145,11 +145,11 @@ replicateP
 replicateP n _ | n <= 0 = asEmpty
 replicateP n a = a >:< replicateP (n-1) a
 
-{- | For any `Monoidal`, `Choice` & `Strong` `Profunctor`,
+{- | For any `Monoidal`, `Choice` & `Data.Profunctor.Strong` `Profunctor`,
 `meander` is invertible and gives a default implementation for the
 `Data.Profunctor.Traversing.wander`
 method of `Data.Profunctor.Traversing.Traversing`,
-though `Strong` is not needed for its definition.
+though `Data.Profunctor.Strong` is not needed for its definition.
 
 See Pickering, Gibbons & Wu,
 [Profunctor Optics - Modular Data Accessors](https://arxiv.org/abs/1703.10857)

From c74757beb555d6142d9c5693788492adaef52fc6 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 14 Apr 2026 23:10:13 -0700
Subject: [PATCH 09/30] Update Grammar.hs

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

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 489452a0..56fc6cd7 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -918,12 +918,8 @@ instance (M.Stream s, IsList (M.Tokens s), Item (M.Tokens s) ~ token, Ord e)
     pure ()
 instance
   ( M.Stream s, token ~ M.Token s, Categorized token
-  , Show token, Show (Categorize token), Ord e
-  ) => TokenAlgebra token (WrapMega e s m token) where
-  tokenClass exam = WrapMega $
-    M.label (show exam) (M.satisfy (tokenClass exam))
-instance (M.Stream s, token ~ M.Token s, Categorized token, Show (Categorize token), Ord e)
-  => Tokenized token (WrapMega e s m token) where
+  , Show (Categorize token), Ord e
+  ) => Tokenized token (WrapMega e s m token) where
   anyToken = WrapMega M.anySingle
   token = WrapMega . M.single
   oneOf = WrapMega . M.oneOf
@@ -932,12 +928,19 @@ instance (M.Stream s, token ~ M.Token s, Categorized token, Show (Categorize tok
     (M.satisfy (tokenClass (asIn cat)))
   notAsIn cat = WrapMega $ M.label ("not in category " ++ show cat)
     (M.satisfy (tokenClass (notAsIn cat)))
+instance
+  ( M.Stream s, token ~ M.Token s, Categorized token
+  , Show token, Show (Categorize token), Ord e
+  ) => TokenAlgebra token (WrapMega e s m token) where
+  tokenClass exam = WrapMega $
+    M.label (show exam) (M.satisfy (tokenClass exam))
 instance (M.Stream s, Ord e)
   => BackusNaurForm (WrapMega e s m a) where
   rule lbl (WrapMega p) = WrapMega (M.label lbl p)
   ruleRec lbl = rule lbl . fix
 instance M.Stream s => Filterable (WrapMega e s m) where
-  catMaybes m = m >>= maybe (fail "unrestricted filtration") return
+  catMaybes m = m >>=
+    maybe (fail "unrestricted filtration") return
 instance (M.Stream s, Ord e) => MonadTry (WrapMega e s m) where
   try (WrapMega p) = WrapMega (M.try p)
 

From c1e1e66e8c7a21eff66d5adc98393b4b3e5e5a5c Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Tue, 14 Apr 2026 23:58:54 -0700
Subject: [PATCH 10/30] make MonadTry imply BackusNaurForm

---
 src/Control/Lens/Grammar.hs            |  5 ++---
 src/Control/Lens/Grammar/BackusNaur.hs |  5 -----
 src/Control/Monad/Fail/Try.hs          | 11 +++++++----
 3 files changed, 9 insertions(+), 12 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 56fc6cd7..16f22dbd 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -389,7 +389,6 @@ ParsecState {parsecLooked = True, parsecOffset = 2, parsecStream = "ab", parsecE
 -}
 type CtxGrammar token a = forall p.
   ( Lexical token p
-  , forall x. BackusNaurForm (p x x)
   , Alternator p
   , Filtrator p
   , MonadicTry p
@@ -879,7 +878,8 @@ unparsecG parsector = unparsecP parsector
 from a `Grammar` with `applicativeG`.
 It works the same way as `monadG`,
 for parsers without `Monad` instances.
-That permits backends which can only parse context-free `Grammar`s.
+That permits backends to use algorithms
+that can only parse context-free `Grammar`s.
 -}
 applicativeG
   :: ( Alternative f
@@ -957,7 +957,6 @@ megaparsecG = unwrapMega . monadG
 -}
 monadG
   :: ( MonadTry m
-     , forall x. BackusNaurForm (m x)
      , TokenAlgebra token (m token)
      , TerminalSymbol token (m ())
      )
diff --git a/src/Control/Lens/Grammar/BackusNaur.hs b/src/Control/Lens/Grammar/BackusNaur.hs
index 49464426..b611e5b5 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -60,11 +60,6 @@ prop> ruleRec _ = fix
 
 The `BackusNaurForm` interface permits overloading these methods,
 and tracing their occurence with a label.
-When a `BackusNaurForm` is a
-`Control.Monad.Fail.Try.MonadTry`,
-this invariant should hold.
-
-prop> fail label = rule label mzero
 
 Both context-free `Control.Lens.Grammar.Grammar`s
 & `Control.Lens.Grammar.CtxGrammar`s
diff --git a/src/Control/Monad/Fail/Try.hs b/src/Control/Monad/Fail/Try.hs
index 6a65f44a..48fa94a3 100644
--- a/src/Control/Monad/Fail/Try.hs
+++ b/src/Control/Monad/Fail/Try.hs
@@ -22,6 +22,7 @@ module Control.Monad.Fail.Try
   ) where
 
 import Control.Applicative
+import Control.Lens.Grammar.BackusNaur
 import Control.Lens.PartialIso ()
 import Control.Monad
 import Data.Bifunctor.Joker
@@ -35,14 +36,16 @@ prop> empty = mzero
 prop> (<|>) = mplus
 prop> filter = mfilter
 
-When a `MonadTry` is also a
-`Control.Lens.Grammar.BackusNaur.BackusNaurForm`,
-then the following invariant should hold.
+`MonadTry` also supports the `BackusNaurForm` interface
+for tracing failures and the following invariant should hold.
 
 prop> fail label = rule label empty
 
 -}
-class (MonadFail m, MonadPlus m, Filterable m) => MonadTry m where
+class
+  ( MonadFail m, MonadPlus m, Filterable m
+  , forall x. BackusNaurForm (m x)
+  ) => MonadTry m where
 
   {- | A handler for failures.
   Used for backtracking state on failure in

From 28b69566587313760e1774088046b172b231b206 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 15 Apr 2026 00:04:20 -0700
Subject: [PATCH 11/30] 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 16f22dbd..3190136d 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -60,7 +60,7 @@ import Data.Profunctor.Separator
 import Data.String
 import GHC.Exts
 import Prelude hiding (filter)
-import Text.ParserCombinators.ReadP (ReadP)
+import Text.ParserCombinators.ReadP (ReadP, readP_to_S)
 import Witherable
 
 -- Re-exports
@@ -976,7 +976,7 @@ instance IsList RegString where
     = fromMaybe zeroK
     . listToMaybe
     . mapMaybe prsF
-    . parseP regexGrammar
+    . readP_to_S (readG regexGrammar)
     where
       prsF (rex,"") = Just rex
       prsF _ = Nothing
@@ -995,7 +995,7 @@ instance IsList RegBnf where
     = fromMaybe zeroK
     . listToMaybe
     . mapMaybe prsF
-    . parseP regbnfGrammar
+    . readP_to_S (readG regbnfGrammar)
     where
       prsF (regbnf,"") = Just regbnf
       prsF _ = Nothing

From 8b1909ad83c6dca7d17d80330c2d70ec7154003d Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 15 Apr 2026 06:39:23 -0700
Subject: [PATCH 12/30] 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 3190136d..804b3703 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -951,7 +951,7 @@ megaparsecG
      )
   => CtxGrammar token a
   -> M.ParsecT e s m a
-megaparsecG = unwrapMega . monadG
+megaparsecG gram = unwrapMega (monadG gram)
 @
 
 -}

From 9d025954e11d9083398155c204fb6967a015771e Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 15 Apr 2026 07:21:13 -0700
Subject: [PATCH 13/30] megaparsec test

---
 distributors.cabal          |  1 +
 package.yaml                |  1 +
 src/Control/Lens/Grammar.hs | 41 +++++++++++--------------------------
 test/Main.hs                | 32 +++++++++++++++++++++++++++++
 4 files changed, 46 insertions(+), 29 deletions(-)

diff --git a/distributors.cabal b/distributors.cabal
index 2ec7979b..870c75df 100644
--- a/distributors.cabal
+++ b/distributors.cabal
@@ -187,6 +187,7 @@ test-suite test
     , doctest >=0.18 && <1
     , hspec >=2.7 && <3
     , lens >=5.0 && <6
+    , megaparsec >=9.0 && <10
     , mtl >=2.2 && <3
     , profunctors >=5.6 && <6
     , tagged >=0.8 && <1
diff --git a/package.yaml b/package.yaml
index a4bcd1c3..628cc85d 100644
--- a/package.yaml
+++ b/package.yaml
@@ -97,4 +97,5 @@ tests:
       - distributors
       - doctest >= 0.18 && < 1
       - hspec >= 2.7 && < 3
+      - megaparsec >= 9.0 && < 10
       - QuickCheck >= 2.14 && < 3
diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 804b3703..471d7073 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -904,22 +904,17 @@ using the Megaparsec library.
 import qualified Text.Megaparsec as M
 import qualified Text.Megaparsec.Char as M
 import Control.Lens.Grammar
-import GHC.IsList
 
-newtype WrapMega s e m a = WrapMega {unwrapMega :: M.ParsecT s e m a}
+newtype WrapMega a = WrapMega {unwrapMega :: M.Parsec String String a}
   deriving newtype
     ( Functor, Applicative, Alternative
     , Monad, MonadPlus, MonadFail
     )
-instance (M.Stream s, IsList (M.Tokens s), Item (M.Tokens s) ~ token, Ord e)
-  => TerminalSymbol token (WrapMega e s m ()) where
-  terminal str = WrapMega $ do
-    _ <- M.chunk (fromList str)
-    pure ()
-instance
-  ( M.Stream s, token ~ M.Token s, Categorized token
-  , Show (Categorize token), Ord e
-  ) => Tokenized token (WrapMega e s m token) where
+instance TerminalSymbol Char (WrapMega ()) where
+  terminal str = WrapMega (M.chunk str *> pure ())
+instance TokenAlgebra Char (WrapMega Char) where
+  tokenClass exam = WrapMega $ M.label (show exam) (M.satisfy (tokenClass exam))
+instance Tokenized Char (WrapMega Char) where
   anyToken = WrapMega M.anySingle
   token = WrapMega . M.single
   oneOf = WrapMega . M.oneOf
@@ -928,29 +923,17 @@ instance
     (M.satisfy (tokenClass (asIn cat)))
   notAsIn cat = WrapMega $ M.label ("not in category " ++ show cat)
     (M.satisfy (tokenClass (notAsIn cat)))
-instance
-  ( M.Stream s, token ~ M.Token s, Categorized token
-  , Show token, Show (Categorize token), Ord e
-  ) => TokenAlgebra token (WrapMega e s m token) where
-  tokenClass exam = WrapMega $
-    M.label (show exam) (M.satisfy (tokenClass exam))
-instance (M.Stream s, Ord e)
-  => BackusNaurForm (WrapMega e s m a) where
+instance BackusNaurForm (WrapMega a) where
   rule lbl (WrapMega p) = WrapMega (M.label lbl p)
   ruleRec lbl = rule lbl . fix
-instance M.Stream s => Filterable (WrapMega e s m) where
-  catMaybes m = m >>=
-    maybe (fail "unrestricted filtration") return
-instance (M.Stream s, Ord e) => MonadTry (WrapMega e s m) where
+instance Filterable WrapMega where
+  catMaybes m = m >>= maybe (fail "unrestricted filtration") pure
+instance MonadTry WrapMega where
   try (WrapMega p) = WrapMega (M.try p)
 
 megaparsecG
-  :: ( M.Stream s, IsList (M.Tokens s), token ~ Item (M.Tokens s)
-     , token ~ M.Token s, Categorized token
-     , Show token, Show (Categorize token), Ord e
-     )
-  => CtxGrammar token a
-  -> M.ParsecT e s m a
+  :: CtxGrammar Char a
+  -> M.Parsec String String a
 megaparsecG gram = unwrapMega (monadG gram)
 @
 
diff --git a/test/Main.hs b/test/Main.hs
index 0fbb159b..913b277a 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -4,12 +4,14 @@ import Data.Foldable hiding (toList)
 import Control.Lens.Grammar
 import Control.Monad (when)
 import Data.IORef
+import Data.Function (fix)
 import Data.List (genericLength)
 import Data.Maybe (isJust)
 import Data.Profunctor.Types (Star (..))
 import System.Environment (lookupEnv)
 import Test.DocTest
 import Test.Hspec
+import qualified Text.Megaparsec as M
 
 import Examples.Arithmetic
 import Examples.Chain
@@ -148,3 +150,33 @@ testCtxGrammar isLL1 grammar (expectedSyntax, expectedString) = do
       let actualError  = parsecError  actualString
       actualString `shouldBe`
         (ParsecState actualLooked expectedLength expectedString actualError (Just expectedSyntax))
+    it ("should parse with megaparsec to " <> expectedString <> " correctly") $ do
+      let megaparsec = unwrapMega (monadG grammar)
+      let actualSyntax = M.parse megaparsec "<megaparsec>" expectedString
+      actualSyntax `shouldBe` Right expectedSyntax
+
+newtype WrapMega a = WrapMega {unwrapMega :: M.Parsec String String a}
+  deriving newtype
+    ( Functor, Applicative, Alternative
+    , Monad, MonadPlus, MonadFail
+    )
+instance TerminalSymbol Char (WrapMega ()) where
+  terminal str = WrapMega (M.chunk str *> pure ())
+instance TokenAlgebra Char (WrapMega Char) where
+  tokenClass exam = WrapMega $ M.label (show exam) (M.satisfy (tokenClass exam))
+instance Tokenized Char (WrapMega Char) where
+  anyToken = WrapMega M.anySingle
+  token = WrapMega . M.single
+  oneOf = WrapMega . M.oneOf
+  notOneOf = WrapMega . M.noneOf
+  asIn cat = WrapMega $ M.label ("in category " ++ show cat)
+    (M.satisfy (tokenClass (asIn cat)))
+  notAsIn cat = WrapMega $ M.label ("not in category " ++ show cat)
+    (M.satisfy (tokenClass (notAsIn cat)))
+instance BackusNaurForm (WrapMega a) where
+  rule lbl (WrapMega p) = WrapMega (M.label lbl p)
+  ruleRec lbl = rule lbl . fix
+instance Filterable WrapMega where
+  catMaybes m = m >>= maybe (fail "unrestricted filtration") pure
+instance MonadTry WrapMega where
+  try (WrapMega p) = WrapMega (M.try p)

From 1964b81f617a23f236df9ed309e3066f84678bc3 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 15 Apr 2026 09:41:43 -0700
Subject: [PATCH 14/30] 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 471d7073..14e05af9 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -280,8 +280,8 @@ and generator support for `ruleRec`.
 -}
 type Grammar token a = forall p.
   ( Lexical token p
-  , forall x. BackusNaurForm (p x x)
   , Alternator p
+  , forall x. BackusNaurForm (p x x)
   ) => p a a
 
 {- | For context-sensitivity,
@@ -883,9 +883,9 @@ that can only parse context-free `Grammar`s.
 -}
 applicativeG
   :: ( Alternative f
-     , forall x. BackusNaurForm (f x)
      , TokenAlgebra token (f token)
      , TerminalSymbol token (f ())
+     , forall x. BackusNaurForm (f x)
      )
   => Grammar token a -- ^ context-free grammar
   -> f a

From cb409967fc11406bd3504106ab05fd019d030b83 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 15 Apr 2026 09:41:47 -0700
Subject: [PATCH 15/30] Update Filtrator.hs

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

diff --git a/src/Data/Profunctor/Filtrator.hs b/src/Data/Profunctor/Filtrator.hs
index 43c8c7ab..5fc92a62 100644
--- a/src/Data/Profunctor/Filtrator.hs
+++ b/src/Data/Profunctor/Filtrator.hs
@@ -39,8 +39,8 @@ class (Cochoice p, forall x. Filterable (p x))
   => Filtrator p where
 
     {- |
-    prop> unleft = fst . filtrate
-    prop> unright = snd . filtrate
+    prop> unleft = fst . filtrate = mapMaybe (either Just (const Nothing)) . lmap Left
+    prop> unright = snd . filtrate = mapMaybe (either (const Nothing) Just) . lmap Right
 
     `filtrate` is a distant relative to `Data.Either.partitionEithers`.
     `filtrate` can be given a default value for `Monadic`

From 5cb036821d06065afa2d1561525fdbeee3962d57 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Wed, 15 Apr 2026 19:51:07 -0700
Subject: [PATCH 16/30] Update Orphanage.hs

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

diff --git a/src/Control/Lens/Grammar/Internal/Orphanage.hs b/src/Control/Lens/Grammar/Internal/Orphanage.hs
index c71fb53e..bccd3001 100644
--- a/src/Control/Lens/Grammar/Internal/Orphanage.hs
+++ b/src/Control/Lens/Grammar/Internal/Orphanage.hs
@@ -2,7 +2,7 @@
 
 {- |
 Module      : Control.Lens.Grammar.Internal.Orphanage
-Description : partial isomorphisms
+Description : orphanage
 Copyright   : (C) 2026 - Eitan Chatav
 License     : BSD-style (see the file LICENSE)
 Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>

From 1e25ffc13e0b3c9824811e20768e8bcdac53b583 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 16 Apr 2026 06:00:34 -0700
Subject: [PATCH 17/30] names

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

diff --git a/src/Control/Lens/Grammar/Boole.hs b/src/Control/Lens/Grammar/Boole.hs
index 5b6409d8..469420d4 100644
--- a/src/Control/Lens/Grammar/Boole.hs
+++ b/src/Control/Lens/Grammar/Boole.hs
@@ -1,6 +1,6 @@
 {- |
 Module      : Control.Lens.Grammar.Boole
-Description : Boolean algebras & token classes
+Description : Boolean algebras
 Copyright   : (C) 2026 - Eitan Chatav
 License     : BSD-style (see the file LICENSE)
 Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index d86aaab8..52d74473 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -1,6 +1,6 @@
 {- |
 Module      : Control.Lens.Grammar.Kleene
-Description : Kleene star algebras & regular expressions
+Description : Kleene star algebras, regular expressions & token classes
 Copyright   : (C) 2026 - Eitan Chatav
 License     : BSD-style (see the file LICENSE)
 Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>

From c3a6340899288ccb831c92ac8fee46a403de4a76 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 16 Apr 2026 06:36:11 -0700
Subject: [PATCH 18/30] Update Symbol.hs

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

diff --git a/src/Control/Lens/Grammar/Symbol.hs b/src/Control/Lens/Grammar/Symbol.hs
index b1a01dad..a36ec396 100644
--- a/src/Control/Lens/Grammar/Symbol.hs
+++ b/src/Control/Lens/Grammar/Symbol.hs
@@ -20,8 +20,7 @@ import Control.Lens.Grammar.Token
 import Data.Bifunctor.Joker
 import Data.Profunctor
 import Data.Profunctor.Monoidal
-import Text.ParserCombinators.ReadP (ReadP)
-import qualified Text.ParserCombinators.ReadP as ReadP
+import Text.ParserCombinators.ReadP (ReadP, string)
 
 -- | A `terminal` symbol in a grammar.
 class TerminalSymbol token s | s -> token where
@@ -40,6 +39,4 @@ instance TerminalSymbol token (f ())
   => TerminalSymbol token (Joker f () ()) where
     terminal = Joker . terminal @token
 instance TerminalSymbol Char (ReadP ()) where
-  terminal str = do
-    _ <- ReadP.string str
-    return ()
+  terminal str = string str *> pure ()

From 7145045d5bce74940bc31c8578c357fb37d4a044 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 16 Apr 2026 06:41:23 -0700
Subject: [PATCH 19/30] 0.5

---
 CHANGELOG.md       | 21 +++++++++++++++++++++
 distributors.cabal |  2 +-
 package.yaml       |  2 +-
 3 files changed, 23 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index ba221d51..08a8f0d6 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,26 @@
 # Changelog for `distributors`
 
+## 0.5.0.0 - 2026-04-16
+
+### Changes
+
+- `MonadTry` now implies `BackusNaurForm` (so `rule` tracing/failure semantics are available)
+  and `Filtrator` (via `MonadPlus`, with `filtrate = mfiltrate`).
+- Simplified the default implementation of `terminal`.
+- Added `applicativeG` and `monadG` generators via `Joker` orphan and non-orphan instances.
+
+### Internal
+
+- Moved orphan instances and Template Haskell internals to `Control.Lens.Grammar.Internal`.
+
+### Documentation
+
+- Expanded `BackusNaurForm` documentation with separate motivation from:
+  category-theoretic structure and failure-tracing semantics (both called “trace”
+  in different senses, and combined by BNF-style rules).
+- Added a `monadG` Megaparsec example.
+- Fixed typo in the `makeNestedPrisms` example.
+
 ## 0.4.0.0 - 2026-04-10
 
 ### New Modules
diff --git a/distributors.cabal b/distributors.cabal
index 870c75df..546551fa 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.5.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 628cc85d..9f1c9a07 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: distributors
-version: 0.4.0.0
+version: 0.5.0.0
 github: "morphismtech/distributors"
 license: BSD-3-Clause
 author: "Eitan Chatav"

From 3f5926cd25592998d4cd8f1548f88b756a1ca761 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 16 Apr 2026 06:57:45 -0700
Subject: [PATCH 20/30] failure nomenclature

---
 CHANGELOG.md                             |  5 +-
 src/Control/Lens/Grammar.hs              | 10 +--
 src/Data/Profunctor/Grammar/Parsector.hs | 82 ++++++++++++------------
 test/Main.hs                             |  8 +--
 4 files changed, 53 insertions(+), 52 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 08a8f0d6..e610530f 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -8,6 +8,7 @@
   and `Filtrator` (via `MonadPlus`, with `filtrate = mfiltrate`).
 - Simplified the default implementation of `terminal`.
 - Added `applicativeG` and `monadG` generators via `Joker` orphan and non-orphan instances.
+- Made nomenclature consistent with use of "fail" and "failure", not "error".
 
 ### Internal
 
@@ -26,8 +27,8 @@
 ### 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
+- `Data.Profunctor.Grammar.Parsector` - Invertible LL(1) parser with Parsec-style failure reporting:
+  `ParsecState`, `ParsecFailure`, `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`
diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 14e05af9..99e53d8f 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -363,7 +363,7 @@ the context-sensitivity of `CtxGrammar` implies
 unrestricted filtration of grammars by computable predicates,
 which can recognize the larger class of recursively enumerable languages.
 
-Finally, `CtxGrammar`s support error reporting and backtracking.
+Finally, `CtxGrammar`s support failure 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.
@@ -378,13 +378,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", parsecError = ParsecError {parsecExpect = TokenClass (OneOf (fromList "")), parsecLabels = [Node {rootLabel = "foo", subForest = [Node {rootLabel = "bar", subForest = []}]},Node {rootLabel = "baz", subForest = []}]}, parsecResult = Nothing}
+ParsecState {parsecLooked = False, parsecOffset = 0, parsecStream = "abc", parsecFail = ParsecFailure {parsecExpect = TokenClass (OneOf (fromList "")), parsecLabels = [Node {rootLabel = "foo", subForest = [Node {rootLabel = "bar", subForest = []}]},Node {rootLabel = "baz", subForest = []}]}, parsecResult = Nothing}
 
 >>> parsecG (manyP (token 'a') >*< asIn @Char DecimalNumber) "aaab"
-ParsecState {parsecLooked = True, parsecOffset = 3, parsecStream = "b", parsecError = ParsecError {parsecExpect = TokenClass (Alternate (TokenClass (OneOf (fromList "a"))) (TokenClass (NotOneOf (fromList "") (AndAsIn DecimalNumber)))), parsecLabels = []}, parsecResult = Nothing}
+ParsecState {parsecLooked = True, parsecOffset = 3, parsecStream = "b", parsecFail = ParsecFailure {parsecExpect = TokenClass (Alternate (TokenClass (OneOf (fromList "a"))) (TokenClass (NotOneOf (fromList "") (AndAsIn DecimalNumber)))), parsecLabels = []}, parsecResult = Nothing}
 
 >>> unparsecG (tokens "abc") "abx" ""
-ParsecState {parsecLooked = True, parsecOffset = 2, parsecStream = "ab", parsecError = ParsecError {parsecExpect = TokenClass (OneOf (fromList "c")), parsecLabels = []}, parsecResult = Nothing}
+ParsecState {parsecLooked = True, parsecOffset = 2, parsecStream = "ab", parsecFail = ParsecFailure {parsecExpect = TokenClass (OneOf (fromList "c")), parsecLabels = []}, parsecResult = Nothing}
 
 -}
 type CtxGrammar token a = forall p.
@@ -845,7 +845,7 @@ 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 `parsecResult` as `Nothing` on failure or `Just`
-an output syntax value, with parse failure stored in `parsecError`,
+an output syntax value, with parse failure stored in `parsecFail`,
 and a remaining output `parsecStream`.
 -}
 parsecG
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index c5bb2b22..3311afd3 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 : grammar distributor with errors
+Description : grammar distributor with failures
 Copyright   : (C) 2026 - Eitan Chatav
 License     : BSD-style (see the file LICENSE)
 Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
@@ -18,7 +18,7 @@ module Data.Profunctor.Grammar.Parsector
   , parsecP
   , unparsecP
   , ParsecState (..)
-  , ParsecError (..)
+  , ParsecFailure (..)
   ) where
 
 import Control.Applicative
@@ -43,7 +43,7 @@ import GHC.Exts
 import Prelude hiding (id, (.))
 
 {- | `Parsector` is an invertible @LL(1)@ parser which is intended
-to provide detailed error information, based on [Parsec]
+to provide detailed failure 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
@@ -90,11 +90,11 @@ data ParsecState s a = ParsecState
   , parsecOffset :: !Word
     -- ^ Number of tokens consumed from the start of the stream.
   , parsecStream :: s -- ^ stream
-  , parsecError  :: ParsecError s
-    {- ^ `ParsecError` channel.
+  , parsecFail  :: ParsecFailure s
+    {- ^ `ParsecFailure` channel.
 
     * If `parsecResult` is `Nothing`, this is the hard failure.
-    * If `parsecResult` is `Just`, this is deferred error/hint info
+    * If `parsecResult` is `Just`, this is deferred failure/hint info
       from empty-failing alternatives at the current position.
 
     `<|>` and `>>=` propagate and merge this field to preserve
@@ -105,22 +105,22 @@ data ParsecState s a = ParsecState
     As input, `Nothing` means parse mode and
     `Just` means print mode with an input syntax value.
 
-    As output `Nothing` means failure (inspect `parsecError`) and
+    As output `Nothing` means failure (inspect `parsecFail`) and
     `Just` means success with an output syntax value.
     -}
   }
 
-{- | `ParsecError` is the error payload produced by `Parsector`,
-stored in `parsecError`.
-`ParsecError` is a `Monoid` and `Parsector` merges errors/hints
+{- | `ParsecFailure` is the failure payload produced by `Parsector`,
+stored in `parsecFail`.
+`ParsecFailure` is a `Monoid` and `Parsector` merges failures/hints
 when control flow reaches the same offset without commitment.
 -}
-data ParsecError s = ParsecError
+data ParsecFailure s = ParsecFailure
   { parsecExpect :: TokenClass (Item s)
     {- ^ Class of expected token `Item`s at the `parsecOffset`.
     `tokenClass`es and `Tokenized` combinators specify expectations.
     Under `<>`, expectations are combined with disjunction `>||<`.
-    In case of a parse error, contrast with the actual `parsecStream`,
+    In case of a parse failure, contrast with the actual `parsecStream`,
     which is either unexpectedly empty or begins with an unexpected token.
     -}
   , parsecLabels :: [Tree String]
@@ -132,21 +132,21 @@ data ParsecError s = ParsecError
     -}
   }
 
--- ParsecError instances
+-- ParsecFailure instances
 deriving stock instance
   ( Categorized (Item s)
   , Show (Item s), Show (Categorize (Item s))
-  ) => Show (ParsecError s)
+  ) => Show (ParsecFailure 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 []
+  ) => Read (ParsecFailure s)
+deriving stock instance Categorized (Item s) => Eq (ParsecFailure s)
+deriving stock instance Categorized (Item s) => Ord (ParsecFailure s)
+instance Categorized (Item s) => Semigroup (ParsecFailure s) where
+  ParsecFailure e1 l1 <> ParsecFailure e2 l2 = ParsecFailure (e1 >||< e2) (l1 ++ l2)
+instance Categorized (Item s) => Monoid (ParsecFailure s) where
+  mempty = ParsecFailure falseB []
 
 -- ParsecState instances
 deriving stock instance Functor (ParsecState s)
@@ -193,13 +193,13 @@ instance
         offset = parsecOffset query
         replyOk tok str = query
           { parsecLooked = True
-          , parsecError  = mempty
+          , parsecFail  = mempty
           , parsecStream = str
           , parsecOffset = offset + 1
           , parsecResult = Just tok
           }
         replyErr = query
-          { parsecError  = ParsecError test []
+          { parsecFail  = ParsecFailure test []
           , parsecResult = Nothing }
       in
         callback $ case mode of
@@ -220,9 +220,9 @@ instance BackusNaurForm (Parsector s a b) where
     flip (runParsector p) query $ \reply -> callback $
       case parsecResult reply of
         Nothing -> reply
-          { parsecError =
-              let ParsecError expect labels = parsecError reply
-              in ParsecError expect [Node name labels]
+          { parsecFail =
+              let ParsecFailure expect labels = parsecFail reply
+              in ParsecFailure expect [Node name labels]
           }
         Just _ -> reply
   ruleRec name = rule name . fix
@@ -245,10 +245,10 @@ instance Categorized (Item s) => Monad (Parsector s a) where
         Nothing -> callback reply { parsecResult = Nothing }
         Just b ->
           let
-            hintP  = parsecError reply
+            hintP  = parsecFail reply
             fQuery = reply
               { parsecLooked = False
-              , parsecError  = mempty
+              , parsecFail  = mempty
               , parsecResult = parsecResult query
               }
           in
@@ -257,12 +257,12 @@ instance Categorized (Item s) => Monad (Parsector s a) where
                 then fReply
                 else fReply
                   { parsecLooked = parsecLooked reply
-                  , parsecError  = hintP <> parsecError fReply
+                  , parsecFail  = hintP <> parsecFail fReply
                   }
 instance Categorized (Item s) => Alternative (Parsector s a) where
   -- | Always fails without consuming input; expects nothing.
   empty = Parsector $ \callback query ->
-    callback query { parsecError = mempty, parsecResult = Nothing }
+    callback query { parsecFail = mempty, parsecResult = Nothing }
   p <|> q = Parsector $ \callback query ->
     flip (runParsector p) query $ \replyP -> callback $
       case parsecResult replyP of
@@ -272,15 +272,15 @@ instance Categorized (Item s) => Alternative (Parsector s a) where
         Nothing | parsecLooked replyP -> replyP
         -- if p failed without consuming, try q
         Nothing ->
-          let errP = parsecError replyP
+          let errP = parsecFail replyP
           in flip (runParsector q) query $ \replyQ ->
           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, Just _)   -> replyQ { parsecError = errP <> parsecError replyQ }
-            -- both empty fail: merge errors
-            (False, Nothing)  -> replyP { parsecError = errP <> parsecError replyQ }
+            (False, Just _)   -> replyQ { parsecFail = errP <> parsecFail replyQ }
+            -- both empty fail: merge failures
+            (False, Nothing)  -> replyP { parsecFail = errP <> parsecFail replyQ }
 instance Categorized (Item s) => MonadPlus (Parsector s a)
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
@@ -294,7 +294,7 @@ instance Categorized (Item s) => MonadTry (Parsector s a) where
       case parsecResult reply of
         Nothing -> query
           { parsecLooked = False
-          , parsecError  = parsecError reply
+          , parsecFail  = parsecFail reply
           , parsecResult = Nothing
           }
         Just _ -> reply
@@ -347,7 +347,7 @@ instance Categorized (Item s) => Alternator (Parsector s) where
             Just (Left a)   -> Just a
             Just (Right _)  -> Nothing
         }
-      replyErr = query { parsecError = mempty, parsecResult = Nothing }
+      replyErr = query { parsecFail = mempty, parsecResult = Nothing }
     in
       case (parsecResult query, parsecResult replyOk) of
         (Just _, Nothing) -> replyErr
@@ -362,7 +362,7 @@ instance Categorized (Item s) => Alternator (Parsector s) where
             Just (Left _)   -> Nothing
             Just (Right b)  -> Just b
         }
-      replyErr = query { parsecError = mempty, parsecResult = Nothing }
+      replyErr = query { parsecFail = mempty, parsecResult = Nothing }
     in
       case (parsecResult query, parsecResult replyOk) of
         (Just _, Nothing) -> replyErr
@@ -381,18 +381,18 @@ instance Categorized (Item s) => Filtrator (Parsector s) where
     ( Parsector $ \callback query ->
         flip (runParsector p) (Left <$> query) $ \reply ->
           callback reply
-          { parsecError = case parsecResult reply of
+          { parsecFail = case parsecResult reply of
             Just (Right _) -> mempty
-            _ -> parsecError reply
+            _ -> parsecFail reply
           , parsecResult =
             parsecResult reply >>= either Just (const Nothing)
           }
     , Parsector $ \callback query ->
         flip (runParsector p) (Right <$> query) $ \reply ->
           callback reply
-          { parsecError = case parsecResult reply of
+          { parsecFail = case parsecResult reply of
             Just (Left _) -> mempty
-            _ -> parsecError reply
+            _ -> parsecFail reply
           , parsecResult =
             parsecResult reply >>= either (const Nothing) Just
           }
diff --git a/test/Main.hs b/test/Main.hs
index 913b277a..dc06ef41 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -140,16 +140,16 @@ testCtxGrammar isLL1 grammar (expectedSyntax, expectedString) = do
       let actualSyntax = parsecG grammar expectedString
       let expectedLength = genericLength expectedString
       let actualLooked = parsecLooked actualSyntax
-      let actualError  = parsecError  actualSyntax
+      let actualFailure  = parsecFail  actualSyntax
       actualSyntax `shouldBe`
-        (ParsecState actualLooked expectedLength "" actualError (Just expectedSyntax))
+        (ParsecState actualLooked expectedLength "" actualFailure (Just expectedSyntax))
     it ("should unparsecG to " <> expectedString <> " correctly") $ do
       let actualString = unparsecG grammar expectedSyntax ""
       let expectedLength = genericLength expectedString
       let actualLooked = parsecLooked actualString
-      let actualError  = parsecError  actualString
+      let actualFailure  = parsecFail  actualString
       actualString `shouldBe`
-        (ParsecState actualLooked expectedLength expectedString actualError (Just expectedSyntax))
+        (ParsecState actualLooked expectedLength expectedString actualFailure (Just expectedSyntax))
     it ("should parse with megaparsec to " <> expectedString <> " correctly") $ do
       let megaparsec = unwrapMega (monadG grammar)
       let actualSyntax = M.parse megaparsec "<megaparsec>" expectedString

From 6bac64ee322b0c8da7dd54597ce4b763ac7b7202 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 16 Apr 2026 07:11:03 -0700
Subject: [PATCH 21/30] 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 b611e5b5..6e084867 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -45,7 +45,7 @@ related by this invariant.
 prop> rule label bnf = ruleRec label (\_ -> bnf)
 
 The `BackusNaurForm` interface is reminiscent of
-two distinct notions of trace.
+two distinct notions of "trace".
 First as a [traced Cartesian monoidal category]
 (https://ncatlab.org/nlab/show/traced+monoidal+category#in_cartesian_monoidal_categories)
 which models general recursion abstractly,
@@ -59,7 +59,7 @@ prop> rule _ = id
 prop> ruleRec _ = fix
 
 The `BackusNaurForm` interface permits overloading these methods,
-and tracing their occurence with a label.
+and tracing them with a label.
 
 Both context-free `Control.Lens.Grammar.Grammar`s
 & `Control.Lens.Grammar.CtxGrammar`s

From ca832f65536d9eabb5f3ac465691ccc400a85a17 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 16 Apr 2026 07:30:00 -0700
Subject: [PATCH 22/30] Update Bifocal.hs

---
 src/Control/Lens/Bifocal.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/Control/Lens/Bifocal.hs b/src/Control/Lens/Bifocal.hs
index b8e014cc..439a07ff 100644
--- a/src/Control/Lens/Bifocal.hs
+++ b/src/Control/Lens/Bifocal.hs
@@ -59,8 +59,7 @@ type Bifocal s t a b = forall p f.
   (Alternator p, Filtrator p, Alternative f, Filterable f)
     => p a (f b) -> p s (f t)
 
-{- | If you see `ABifocal` in a signature for a function,
-the function is expecting a `Bifocal`. -}
+{- | `ABifocal` is monomorphically a `Bifocal`. -}
 type ABifocal s t a b =
   Binocular a b a (Maybe b) -> Binocular a b s (Maybe t)
 

From 486b6e8980fb7922190175e89dbaaa7c3adcad97 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 16 Apr 2026 10:02:43 -0700
Subject: [PATCH 23/30] Update Grammar.hs

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

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 99e53d8f..58e88b1f 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -919,10 +919,8 @@ instance Tokenized Char (WrapMega Char) where
   token = WrapMega . M.single
   oneOf = WrapMega . M.oneOf
   notOneOf = WrapMega . M.noneOf
-  asIn cat = WrapMega $ M.label ("in category " ++ show cat)
-    (M.satisfy (tokenClass (asIn cat)))
-  notAsIn cat = WrapMega $ M.label ("not in category " ++ show cat)
-    (M.satisfy (tokenClass (notAsIn cat)))
+  asIn cat = WrapMega $ M.label ("in category " ++ show cat) (M.satisfy (asIn cat))
+  notAsIn cat = WrapMega $ M.label ("not in category " ++ show cat) (M.satisfy (notAsIn cat))
 instance BackusNaurForm (WrapMega a) where
   rule lbl (WrapMega p) = WrapMega (M.label lbl p)
   ruleRec lbl = rule lbl . fix

From 03eee3a8505ca268d445791d5ae1681a30bbdc74 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 16 Apr 2026 16:10:48 -0700
Subject: [PATCH 24/30] Update Filtrator.hs

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

diff --git a/src/Data/Profunctor/Filtrator.hs b/src/Data/Profunctor/Filtrator.hs
index 5fc92a62..4adc28df 100644
--- a/src/Data/Profunctor/Filtrator.hs
+++ b/src/Data/Profunctor/Filtrator.hs
@@ -39,8 +39,8 @@ class (Cochoice p, forall x. Filterable (p x))
   => Filtrator p where
 
     {- |
-    prop> unleft = fst . filtrate = mapMaybe (either Just (const Nothing)) . lmap Left
-    prop> unright = snd . filtrate = mapMaybe (either (const Nothing) Just) . lmap Right
+    prop> unleft = fst . filtrate = lmap Left . mapMaybe (either Just (const Nothing))
+    prop> unright = snd . filtrate = lmap Right . mapMaybe (either (const Nothing) Just)
 
     `filtrate` is a distant relative to `Data.Either.partitionEithers`.
     `filtrate` can be given a default value for `Monadic`

From 82bb4c0a3db4ec09015701d8cba4f7ded78401e8 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Thu, 16 Apr 2026 16:41:12 -0700
Subject: [PATCH 25/30] Update Boole.hs

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

diff --git a/src/Control/Lens/Grammar/Boole.hs b/src/Control/Lens/Grammar/Boole.hs
index 469420d4..e1e6da3f 100644
--- a/src/Control/Lens/Grammar/Boole.hs
+++ b/src/Control/Lens/Grammar/Boole.hs
@@ -9,7 +9,6 @@ Portability : non-portable
 
 See Boole, [The Mathematical Analysis of Logic]
 (https://www.gutenberg.org/files/36884/36884-pdf.pdf).
-Categorized token classes form a Boolean algebra.
 -}
 
 module Control.Lens.Grammar.Boole

From 77f9c43b94c34dc5884fb99ca0745db43468e96e Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 17 Apr 2026 07:15:52 -0700
Subject: [PATCH 26/30] Update Kleene.hs

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

diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index 52d74473..25f3d9df 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -194,7 +194,7 @@ 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
+  terminal = mconcat . map token
 instance NonTerminalSymbol (RegEx token) where
   nonTerminal = NonTerminal
 instance Categorized token => Tokenized token (RegEx token) where

From 8972d0dde2bcea9fe434b1fbb33d48737a8a1eac Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 17 Apr 2026 07:19:46 -0700
Subject: [PATCH 27/30] Revert "Update Kleene.hs"

This reverts commit 77f9c43b94c34dc5884fb99ca0745db43468e96e.
---
 src/Control/Lens/Grammar/Kleene.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Control/Lens/Grammar/Kleene.hs b/src/Control/Lens/Grammar/Kleene.hs
index 25f3d9df..52d74473 100644
--- a/src/Control/Lens/Grammar/Kleene.hs
+++ b/src/Control/Lens/Grammar/Kleene.hs
@@ -194,7 +194,7 @@ instance Categorized token
   => TokenAlgebra token (RegExam token (TokenClass token)) where
   tokenClass (TokenClass exam) = exam
 instance Categorized token => TerminalSymbol token (RegEx token) where
-  terminal = mconcat . map token
+  terminal = foldl (\acc t -> acc <> token t) mempty
 instance NonTerminalSymbol (RegEx token) where
   nonTerminal = NonTerminal
 instance Categorized token => Tokenized token (RegEx token) where

From 7b68db0be4bd681c4f583de20c9b0cb81a344a76 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Fri, 17 Apr 2026 14:45:18 -0700
Subject: [PATCH 28/30] parsecFailure

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

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 58e88b1f..9bdc1b0e 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -378,13 +378,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", parsecFail = ParsecFailure {parsecExpect = TokenClass (OneOf (fromList "")), parsecLabels = [Node {rootLabel = "foo", subForest = [Node {rootLabel = "bar", subForest = []}]},Node {rootLabel = "baz", subForest = []}]}, parsecResult = Nothing}
+ParsecState {parsecLooked = False, parsecOffset = 0, parsecStream = "abc", parsecFailure = ParsecFailure {parsecExpect = TokenClass (OneOf (fromList "")), parsecLabels = [Node {rootLabel = "foo", subForest = [Node {rootLabel = "bar", subForest = []}]},Node {rootLabel = "baz", subForest = []}]}, parsecResult = Nothing}
 
 >>> parsecG (manyP (token 'a') >*< asIn @Char DecimalNumber) "aaab"
-ParsecState {parsecLooked = True, parsecOffset = 3, parsecStream = "b", parsecFail = ParsecFailure {parsecExpect = TokenClass (Alternate (TokenClass (OneOf (fromList "a"))) (TokenClass (NotOneOf (fromList "") (AndAsIn DecimalNumber)))), parsecLabels = []}, parsecResult = Nothing}
+ParsecState {parsecLooked = True, parsecOffset = 3, parsecStream = "b", parsecFailure = ParsecFailure {parsecExpect = TokenClass (Alternate (TokenClass (OneOf (fromList "a"))) (TokenClass (NotOneOf (fromList "") (AndAsIn DecimalNumber)))), parsecLabels = []}, parsecResult = Nothing}
 
 >>> unparsecG (tokens "abc") "abx" ""
-ParsecState {parsecLooked = True, parsecOffset = 2, parsecStream = "ab", parsecFail = ParsecFailure {parsecExpect = TokenClass (OneOf (fromList "c")), parsecLabels = []}, parsecResult = Nothing}
+ParsecState {parsecLooked = True, parsecOffset = 2, parsecStream = "ab", parsecFailure = ParsecFailure {parsecExpect = TokenClass (OneOf (fromList "c")), parsecLabels = []}, parsecResult = Nothing}
 
 -}
 type CtxGrammar token a = forall p.
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 3311afd3..0fbfcc38 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -90,7 +90,7 @@ data ParsecState s a = ParsecState
   , parsecOffset :: !Word
     -- ^ Number of tokens consumed from the start of the stream.
   , parsecStream :: s -- ^ stream
-  , parsecFail  :: ParsecFailure s
+  , parsecFailure  :: ParsecFailure s
     {- ^ `ParsecFailure` channel.
 
     * If `parsecResult` is `Nothing`, this is the hard failure.
@@ -193,13 +193,13 @@ instance
         offset = parsecOffset query
         replyOk tok str = query
           { parsecLooked = True
-          , parsecFail  = mempty
+          , parsecFailure  = mempty
           , parsecStream = str
           , parsecOffset = offset + 1
           , parsecResult = Just tok
           }
         replyErr = query
-          { parsecFail  = ParsecFailure test []
+          { parsecFailure  = ParsecFailure test []
           , parsecResult = Nothing }
       in
         callback $ case mode of
@@ -220,8 +220,8 @@ instance BackusNaurForm (Parsector s a b) where
     flip (runParsector p) query $ \reply -> callback $
       case parsecResult reply of
         Nothing -> reply
-          { parsecFail =
-              let ParsecFailure expect labels = parsecFail reply
+          { parsecFailure =
+              let ParsecFailure expect labels = parsecFailure reply
               in ParsecFailure expect [Node name labels]
           }
         Just _ -> reply
@@ -245,10 +245,10 @@ instance Categorized (Item s) => Monad (Parsector s a) where
         Nothing -> callback reply { parsecResult = Nothing }
         Just b ->
           let
-            hintP  = parsecFail reply
+            hintP  = parsecFailure reply
             fQuery = reply
               { parsecLooked = False
-              , parsecFail  = mempty
+              , parsecFailure  = mempty
               , parsecResult = parsecResult query
               }
           in
@@ -257,12 +257,12 @@ instance Categorized (Item s) => Monad (Parsector s a) where
                 then fReply
                 else fReply
                   { parsecLooked = parsecLooked reply
-                  , parsecFail  = hintP <> parsecFail fReply
+                  , parsecFailure  = hintP <> parsecFailure fReply
                   }
 instance Categorized (Item s) => Alternative (Parsector s a) where
   -- | Always fails without consuming input; expects nothing.
   empty = Parsector $ \callback query ->
-    callback query { parsecFail = mempty, parsecResult = Nothing }
+    callback query { parsecFailure = mempty, parsecResult = Nothing }
   p <|> q = Parsector $ \callback query ->
     flip (runParsector p) query $ \replyP -> callback $
       case parsecResult replyP of
@@ -272,15 +272,15 @@ instance Categorized (Item s) => Alternative (Parsector s a) where
         Nothing | parsecLooked replyP -> replyP
         -- if p failed without consuming, try q
         Nothing ->
-          let errP = parsecFail replyP
+          let errP = parsecFailure replyP
           in flip (runParsector q) query $ \replyQ ->
           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, Just _)   -> replyQ { parsecFail = errP <> parsecFail replyQ }
+            (False, Just _)   -> replyQ { parsecFailure = errP <> parsecFailure replyQ }
             -- both empty fail: merge failures
-            (False, Nothing)  -> replyP { parsecFail = errP <> parsecFail replyQ }
+            (False, Nothing)  -> replyP { parsecFailure = errP <> parsecFailure replyQ }
 instance Categorized (Item s) => MonadPlus (Parsector s a)
 instance Categorized (Item s) => MonadFail (Parsector s a) where
   fail msg = rule msg empty
@@ -294,7 +294,7 @@ instance Categorized (Item s) => MonadTry (Parsector s a) where
       case parsecResult reply of
         Nothing -> query
           { parsecLooked = False
-          , parsecFail  = parsecFail reply
+          , parsecFailure  = parsecFailure reply
           , parsecResult = Nothing
           }
         Just _ -> reply
@@ -347,7 +347,7 @@ instance Categorized (Item s) => Alternator (Parsector s) where
             Just (Left a)   -> Just a
             Just (Right _)  -> Nothing
         }
-      replyErr = query { parsecFail = mempty, parsecResult = Nothing }
+      replyErr = query { parsecFailure = mempty, parsecResult = Nothing }
     in
       case (parsecResult query, parsecResult replyOk) of
         (Just _, Nothing) -> replyErr
@@ -362,7 +362,7 @@ instance Categorized (Item s) => Alternator (Parsector s) where
             Just (Left _)   -> Nothing
             Just (Right b)  -> Just b
         }
-      replyErr = query { parsecFail = mempty, parsecResult = Nothing }
+      replyErr = query { parsecFailure = mempty, parsecResult = Nothing }
     in
       case (parsecResult query, parsecResult replyOk) of
         (Just _, Nothing) -> replyErr
@@ -381,18 +381,18 @@ instance Categorized (Item s) => Filtrator (Parsector s) where
     ( Parsector $ \callback query ->
         flip (runParsector p) (Left <$> query) $ \reply ->
           callback reply
-          { parsecFail = case parsecResult reply of
+          { parsecFailure = case parsecResult reply of
             Just (Right _) -> mempty
-            _ -> parsecFail reply
+            _ -> parsecFailure reply
           , parsecResult =
             parsecResult reply >>= either Just (const Nothing)
           }
     , Parsector $ \callback query ->
         flip (runParsector p) (Right <$> query) $ \reply ->
           callback reply
-          { parsecFail = case parsecResult reply of
+          { parsecFailure = case parsecResult reply of
             Just (Left _) -> mempty
-            _ -> parsecFail reply
+            _ -> parsecFailure reply
           , parsecResult =
             parsecResult reply >>= either (const Nothing) Just
           }
diff --git a/test/Main.hs b/test/Main.hs
index dc06ef41..9398364f 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -140,14 +140,14 @@ testCtxGrammar isLL1 grammar (expectedSyntax, expectedString) = do
       let actualSyntax = parsecG grammar expectedString
       let expectedLength = genericLength expectedString
       let actualLooked = parsecLooked actualSyntax
-      let actualFailure  = parsecFail  actualSyntax
+      let actualFailure  = parsecFailure  actualSyntax
       actualSyntax `shouldBe`
         (ParsecState actualLooked expectedLength "" actualFailure (Just expectedSyntax))
     it ("should unparsecG to " <> expectedString <> " correctly") $ do
       let actualString = unparsecG grammar expectedSyntax ""
       let expectedLength = genericLength expectedString
       let actualLooked = parsecLooked actualString
-      let actualFailure  = parsecFail  actualString
+      let actualFailure  = parsecFailure  actualString
       actualString `shouldBe`
         (ParsecState actualLooked expectedLength expectedString actualFailure (Just expectedSyntax))
     it ("should parse with megaparsec to " <> expectedString <> " correctly") $ do

From a107cb0d7ea11503c4bab26fc879e05d10f608c0 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sun, 19 Apr 2026 09:10:13 -0700
Subject: [PATCH 29/30] failure

---
 src/Control/Lens/Grammar.hs              | 2 +-
 src/Data/Profunctor/Grammar/Parsector.hs | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Control/Lens/Grammar.hs b/src/Control/Lens/Grammar.hs
index 9bdc1b0e..0cf344f7 100644
--- a/src/Control/Lens/Grammar.hs
+++ b/src/Control/Lens/Grammar.hs
@@ -845,7 +845,7 @@ 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 `parsecResult` as `Nothing` on failure or `Just`
-an output syntax value, with parse failure stored in `parsecFail`,
+an output syntax value, with parse failure stored in `parsecFailure`,
 and a remaining output `parsecStream`.
 -}
 parsecG
diff --git a/src/Data/Profunctor/Grammar/Parsector.hs b/src/Data/Profunctor/Grammar/Parsector.hs
index 0fbfcc38..bf00e228 100644
--- a/src/Data/Profunctor/Grammar/Parsector.hs
+++ b/src/Data/Profunctor/Grammar/Parsector.hs
@@ -105,13 +105,13 @@ data ParsecState s a = ParsecState
     As input, `Nothing` means parse mode and
     `Just` means print mode with an input syntax value.
 
-    As output `Nothing` means failure (inspect `parsecFail`) and
+    As output `Nothing` means failure (inspect `parsecFailure`) and
     `Just` means success with an output syntax value.
     -}
   }
 
 {- | `ParsecFailure` is the failure payload produced by `Parsector`,
-stored in `parsecFail`.
+stored in `parsecFailure`.
 `ParsecFailure` is a `Monoid` and `Parsector` merges failures/hints
 when control flow reaches the same offset without commitment.
 -}

From ccf708e8c1ed9c6db649fecbd057af7f05541b03 Mon Sep 17 00:00:00 2001
From: Eitan Chatav <eitan.chatav@gmail.com>
Date: Sun, 19 Apr 2026 09:30:10 -0700
Subject: [PATCH 30/30] 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 6e084867..bd47607e 100644
--- a/src/Control/Lens/Grammar/BackusNaur.hs
+++ b/src/Control/Lens/Grammar/BackusNaur.hs
@@ -51,8 +51,8 @@ First as a [traced Cartesian monoidal category]
 which models general recursion abstractly,
 and second as a `Debug.Trace.trace`-like label for `rule` abstraction.
 The category @(->)@ already has a traced @(,)@-monoidal structure
-in the form of `Data.Profunctor.unfirst` or `Control.Arrow.loop`
-and the general recursion function `fix`,
+in the form of `Data.Profunctor.unfirst` @=@ `Control.Arrow.loop`
+or equivalently the fixpoint function `fix`,
 determining default methods for a `BackusNaurForm`.
 
 prop> rule _ = id