{- |
Module      : Control.Lens.Grammar.BackusNaur
Description : Backus-Naur forms & pattern matching
Copyright   : (C) 2026 - Eitan Chatav
License     : BSD-style (see the file LICENSE)
Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
Stability   : provisional
Portability : non-portable

See Naur & Backus, et al.
[Report on the Algorithmic Language ALGOL 60]
(https://softwarepreservation.computerhistory.org/ALGOL/report/Algol60_report_CACM_1960_June.pdf).
-}

module Control.Lens.Grammar.BackusNaur
  ( -- * BackusNaurForm
    BackusNaurForm (..)
  , Bnf (..)
  , liftBnf0
  , liftBnf1
  , liftBnf2
  , diffB
  ) where

import Control.Lens
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
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`,
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` @=@ `Control.Arrow.loop`
or equivalently the fixpoint function `fix`,
determining default methods for a `BackusNaurForm`.

prop> rule _ = id
prop> ruleRec _ = fix

The `BackusNaurForm` interface permits overloading these methods,
and tracing them with a label.

Both context-free `Control.Lens.Grammar.Grammar`s
& `Control.Lens.Grammar.CtxGrammar`s
support the `BackusNaurForm` interface.
See Breitner, [Showcasing Applicative]
(https://www.joachim-breitner.de/blog/710-Showcasing_Applicative),
for the original interface.

-}
class BackusNaurForm bnf where

  {- | Rule abstraction. -}
  rule :: String -> bnf -> bnf
  rule String
_ = bnf -> bnf
forall a. a -> a
id

  {- | General recursion. -}
  ruleRec :: String -> (bnf -> bnf) -> bnf
  ruleRec String
_ = (bnf -> bnf) -> bnf
forall a. (a -> a) -> a
fix

{- | A `Bnf` consists of a distinguished starting rule
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
  { forall rule. Bnf rule -> rule
startBnf :: rule
  , forall rule. Bnf rule -> Set (String, rule)
rulesBnf :: Set (String, rule)
  } deriving stock (Bnf rule -> Bnf rule -> Bool
(Bnf rule -> Bnf rule -> Bool)
-> (Bnf rule -> Bnf rule -> Bool) -> Eq (Bnf rule)
forall rule. Eq rule => Bnf rule -> Bnf rule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall rule. Eq rule => Bnf rule -> Bnf rule -> Bool
== :: Bnf rule -> Bnf rule -> Bool
$c/= :: forall rule. Eq rule => Bnf rule -> Bnf rule -> Bool
/= :: Bnf rule -> Bnf rule -> Bool
Eq, Eq (Bnf rule)
Eq (Bnf rule) =>
(Bnf rule -> Bnf rule -> Ordering)
-> (Bnf rule -> Bnf rule -> Bool)
-> (Bnf rule -> Bnf rule -> Bool)
-> (Bnf rule -> Bnf rule -> Bool)
-> (Bnf rule -> Bnf rule -> Bool)
-> (Bnf rule -> Bnf rule -> Bnf rule)
-> (Bnf rule -> Bnf rule -> Bnf rule)
-> Ord (Bnf rule)
Bnf rule -> Bnf rule -> Bool
Bnf rule -> Bnf rule -> Ordering
Bnf rule -> Bnf rule -> Bnf rule
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall rule. Ord rule => Eq (Bnf rule)
forall rule. Ord rule => Bnf rule -> Bnf rule -> Bool
forall rule. Ord rule => Bnf rule -> Bnf rule -> Ordering
forall rule. Ord rule => Bnf rule -> Bnf rule -> Bnf rule
$ccompare :: forall rule. Ord rule => Bnf rule -> Bnf rule -> Ordering
compare :: Bnf rule -> Bnf rule -> Ordering
$c< :: forall rule. Ord rule => Bnf rule -> Bnf rule -> Bool
< :: Bnf rule -> Bnf rule -> Bool
$c<= :: forall rule. Ord rule => Bnf rule -> Bnf rule -> Bool
<= :: Bnf rule -> Bnf rule -> Bool
$c> :: forall rule. Ord rule => Bnf rule -> Bnf rule -> Bool
> :: Bnf rule -> Bnf rule -> Bool
$c>= :: forall rule. Ord rule => Bnf rule -> Bnf rule -> Bool
>= :: Bnf rule -> Bnf rule -> Bool
$cmax :: forall rule. Ord rule => Bnf rule -> Bnf rule -> Bnf rule
max :: Bnf rule -> Bnf rule -> Bnf rule
$cmin :: forall rule. Ord rule => Bnf rule -> Bnf rule -> Bnf rule
min :: Bnf rule -> Bnf rule -> Bnf rule
Ord, Int -> Bnf rule -> ShowS
[Bnf rule] -> ShowS
Bnf rule -> String
(Int -> Bnf rule -> ShowS)
-> (Bnf rule -> String) -> ([Bnf rule] -> ShowS) -> Show (Bnf rule)
forall rule. Show rule => Int -> Bnf rule -> ShowS
forall rule. Show rule => [Bnf rule] -> ShowS
forall rule. Show rule => Bnf rule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall rule. Show rule => Int -> Bnf rule -> ShowS
showsPrec :: Int -> Bnf rule -> ShowS
$cshow :: forall rule. Show rule => Bnf rule -> String
show :: Bnf rule -> String
$cshowList :: forall rule. Show rule => [Bnf rule] -> ShowS
showList :: [Bnf rule] -> ShowS
Show, ReadPrec [Bnf rule]
ReadPrec (Bnf rule)
Int -> ReadS (Bnf rule)
ReadS [Bnf rule]
(Int -> ReadS (Bnf rule))
-> ReadS [Bnf rule]
-> ReadPrec (Bnf rule)
-> ReadPrec [Bnf rule]
-> Read (Bnf rule)
forall rule. (Read rule, Ord rule) => ReadPrec [Bnf rule]
forall rule. (Read rule, Ord rule) => ReadPrec (Bnf rule)
forall rule. (Read rule, Ord rule) => Int -> ReadS (Bnf rule)
forall rule. (Read rule, Ord rule) => ReadS [Bnf rule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall rule. (Read rule, Ord rule) => Int -> ReadS (Bnf rule)
readsPrec :: Int -> ReadS (Bnf rule)
$creadList :: forall rule. (Read rule, Ord rule) => ReadS [Bnf rule]
readList :: ReadS [Bnf rule]
$creadPrec :: forall rule. (Read rule, Ord rule) => ReadPrec (Bnf rule)
readPrec :: ReadPrec (Bnf rule)
$creadListPrec :: forall rule. (Read rule, Ord rule) => ReadPrec [Bnf rule]
readListPrec :: ReadPrec [Bnf rule]
Read)

{- | Lift a rule to a `Bnf`. -}
liftBnf0 :: Ord a => a -> Bnf a
liftBnf0 :: forall a. Ord a => a -> Bnf a
liftBnf0 a
a = a -> Set (String, a) -> Bnf a
forall rule. rule -> Set (String, rule) -> Bnf rule
Bnf a
a Set (String, a)
forall a. Monoid a => a
mempty

{- | Lift a function of rules to `Bnf`s. -}
liftBnf1 :: (Coercible a b, Ord b) => (a -> b) -> Bnf a -> Bnf b
liftBnf1 :: forall a b. (Coercible a b, Ord b) => (a -> b) -> Bnf a -> Bnf b
liftBnf1 a -> b
f (Bnf a
start Set (String, a)
rules) = b -> Set (String, b) -> Bnf b
forall rule. rule -> Set (String, rule) -> Bnf rule
Bnf (a -> b
f a
start) (((String, a) -> (String, b)) -> Set (String, a) -> Set (String, b)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (String, a) -> (String, b)
forall a b. Coercible a b => a -> b
coerce Set (String, a)
rules)

{- | Lift a binary function of rules to `Bnf`s. -}
liftBnf2
  :: (Coercible a c, Coercible b c, Ord c)
  => (a -> b -> c) -> Bnf a -> Bnf b -> Bnf c
liftBnf2 :: forall a c b.
(Coercible a c, Coercible b c, Ord c) =>
(a -> b -> c) -> Bnf a -> Bnf b -> Bnf c
liftBnf2 a -> b -> c
f (Bnf a
start0 Set (String, a)
rules0) (Bnf b
start1 Set (String, b)
rules1) =
  c -> Set (String, c) -> Bnf c
forall rule. rule -> Set (String, rule) -> Bnf rule
Bnf (a -> b -> c
f a
start0 b
start1) (((String, a) -> (String, c)) -> Set (String, a) -> Set (String, c)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (String, a) -> (String, c)
forall a b. Coercible a b => a -> b
coerce Set (String, a)
rules0 Set (String, c) -> Set (String, c) -> Set (String, c)
forall a. Semigroup a => a -> a -> a
<> ((String, b) -> (String, c)) -> Set (String, b) -> Set (String, c)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (String, b) -> (String, c)
forall a b. Coercible a b => a -> b
coerce Set (String, b)
rules1)

{- |
The [Brzozowski derivative]
(https://dl.acm.org/doi/pdf/10.1145/321239.321249) of a
`RegEx`tended `Bnf`, with memoization.

prop> word =~ diffB prefix pattern = prefix <> word =~ pattern

Unfortunately, despite elegance & optimization, Brzozowski's
pattern matching algorithm is worst case exponential in grammar size.
See Might, Darais & Spiewak, [Parsing With Derivatives]
(https://matt.might.net/papers/might2011derivatives.pdf).
-}
diffB
  :: (Categorized token, HasTrie token)
  => [token] -> Bnf (RegEx token) -> Bnf (RegEx token)
diffB :: forall token.
(Categorized token, HasTrie token) =>
[token] -> Bnf (RegEx token) -> Bnf (RegEx token)
diffB [token]
prefix (Bnf RegEx token
start Set (String, RegEx token)
rules) =
  RegEx token -> Set (String, RegEx token) -> Bnf (RegEx token)
forall rule. rule -> Set (String, rule) -> Bnf rule
Bnf ((RegEx token -> token -> RegEx token)
-> RegEx token -> [token] -> RegEx token
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((token -> RegEx token -> RegEx token)
-> RegEx token -> token -> RegEx token
forall a b c. (a -> b -> c) -> b -> a -> c
flip token -> RegEx token -> RegEx token
diff1B) RegEx token
start [token]
prefix) Set (String, RegEx token)
rules
  where
    -- derivative wrt 1 token, memoized
    diff1B :: token -> RegEx token -> RegEx token
diff1B = (token -> RegEx token -> RegEx token)
-> token -> RegEx token -> RegEx token
forall s t a.
(HasTrie s, HasTrie t) =>
(s -> t -> a) -> s -> t -> a
memo2 ((token -> RegEx token -> RegEx token)
 -> token -> RegEx token -> RegEx token)
-> (token -> RegEx token -> RegEx token)
-> token
-> RegEx token
-> RegEx token
forall a b. (a -> b) -> a -> b
$ \token
x -> \case
      RegEx token
SeqEmpty -> RegEx token
forall k. KleeneStarAlgebra k => k
zeroK
      NonTerminal String
nameY -> (RegEx token -> RegEx token) -> Set (RegEx token) -> RegEx token
forall (f :: * -> *) k a.
(Foldable f, KleeneStarAlgebra k) =>
(a -> k) -> f a -> k
anyK (token -> RegEx token -> RegEx token
diff1B token
x) (String -> Set (String, RegEx token) -> Set (RegEx token)
forall rule. Ord rule => String -> Set (String, rule) -> Set rule
rulesNamed String
nameY Set (String, RegEx token)
rules)
      Sequence RegEx token
y1 RegEx token
y2 ->
        if Bnf (RegEx token) -> Bool
forall token.
(Categorized token, HasTrie token) =>
Bnf (RegEx token) -> Bool
δ (RegEx token -> Set (String, RegEx token) -> Bnf (RegEx token)
forall rule. rule -> Set (String, rule) -> Bnf rule
Bnf RegEx token
y1 Set (String, RegEx token)
rules) then RegEx token
y1'y2 RegEx token -> RegEx token -> RegEx token
forall k. KleeneStarAlgebra k => k -> k -> k
>|< RegEx token
y1y2' else RegEx token
y1'y2
        where
          y1'y2 :: RegEx token
y1'y2 = token -> RegEx token -> RegEx token
diff1B token
x RegEx token
y1 RegEx token -> RegEx token -> RegEx token
forall a. Semigroup a => a -> a -> a
<> RegEx token
y2
          y1y2' :: RegEx token
y1y2' = RegEx token
y1 RegEx token -> RegEx token -> RegEx token
forall a. Semigroup a => a -> a -> a
<> token -> RegEx token -> RegEx token
diff1B token
x RegEx token
y2
      KleeneStar RegEx token
y -> token -> RegEx token -> RegEx token
diff1B token
x RegEx token
y RegEx token -> RegEx token -> RegEx token
forall a. Semigroup a => a -> a -> a
<> RegEx token -> RegEx token
forall k. KleeneStarAlgebra k => k -> k
starK RegEx token
y
      KleeneOpt RegEx token
y -> token -> RegEx token -> RegEx token
diff1B token
x RegEx token
y
      KleenePlus RegEx token
y -> token -> RegEx token -> RegEx token
diff1B token
x RegEx token
y RegEx token -> RegEx token -> RegEx token
forall a. Semigroup a => a -> a -> a
<> RegEx token -> RegEx token
forall k. KleeneStarAlgebra k => k -> k
starK RegEx token
y
      RegExam (OneOf Set token
chars) ->
        if token
x token -> Set token -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set token
chars then RegEx token
forall a. Monoid a => a
mempty else RegEx token
forall k. KleeneStarAlgebra k => k
zeroK
      RegExam (NotOneOf Set token
chars (AndAsIn Categorize token
cat)) ->
        if token -> Set token -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem token
x Set token
chars Bool -> Bool -> Bool
|| token -> Categorize token
forall token. Categorized token => token -> Categorize token
categorize token
x Categorize token -> Categorize token -> Bool
forall a. Eq a => a -> a -> Bool
/= Categorize token
cat
          then RegEx token
forall k. KleeneStarAlgebra k => k
zeroK else RegEx token
forall a. Monoid a => a
mempty
      RegExam (NotOneOf Set token
chars (AndNotAsIn Set (Categorize token)
cats)) ->
        if token -> Set token -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem token
x Set token
chars Bool -> Bool -> Bool
|| Categorize token -> Set (Categorize token) -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (token -> Categorize token
forall token. Categorized token => token -> Categorize token
categorize token
x) Set (Categorize token)
cats
          then RegEx token
forall k. KleeneStarAlgebra k => k
zeroK else RegEx token
forall a. Monoid a => a
mempty
      RegExam (Alternate RegEx token
y1 RegEx token
y2) -> token -> RegEx token -> RegEx token
diff1B token
x RegEx token
y1 RegEx token -> RegEx token -> RegEx token
forall k. KleeneStarAlgebra k => k -> k -> k
>|< token -> RegEx token -> RegEx token
diff1B token
x RegEx token
y2

-- | Does a pattern match the empty word?
δ :: (Categorized token, HasTrie token)
  => Bnf (RegEx token) -> Bool
δ :: forall token.
(Categorized token, HasTrie token) =>
Bnf (RegEx token) -> Bool
δ (Bnf RegEx token
start Set (String, RegEx token)
rules) = RegEx token -> Bool
ν RegEx token
start where
  ν :: RegEx token -> Bool
ν = (RegEx token -> Bool) -> RegEx token -> Bool
forall t a. HasTrie t => (t -> a) -> t -> a
memo ((RegEx token -> Bool) -> RegEx token -> Bool)
-> (RegEx token -> Bool) -> RegEx token -> Bool
forall a b. (a -> b) -> a -> b
$ \case
    RegEx token
SeqEmpty -> Bool
True
    KleeneStar RegEx token
_ -> Bool
True
    KleeneOpt RegEx token
_ -> Bool
True
    KleenePlus RegEx token
y -> RegEx token -> Bool
ν RegEx token
y
    Sequence RegEx token
y1 RegEx token
y2 -> RegEx token -> Bool
ν RegEx token
y1 Bool -> Bool -> Bool
&& RegEx token -> Bool
ν RegEx token
y2
    RegExam (Alternate RegEx token
y1 RegEx token
y2) -> RegEx token -> Bool
ν RegEx token
y1 Bool -> Bool -> Bool
|| RegEx token -> Bool
ν RegEx token
y2
    NonTerminal String
nameY -> (RegEx token -> Bool) -> Set (RegEx token) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RegEx token -> Bool
ν (String -> Set (String, RegEx token) -> Set (RegEx token)
forall rule. Ord rule => String -> Set (String, rule) -> Set rule
rulesNamed String
nameY Set (String, RegEx token)
rules)
    RegEx token
_ -> Bool
False

rulesNamed :: Ord rule => String -> Set (String, rule) -> Set rule
rulesNamed :: forall rule. Ord rule => String -> Set (String, rule) -> Set rule
rulesNamed String
nameX = (Set rule -> (String, rule) -> Set rule)
-> Set rule -> Set (String, rule) -> Set rule
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((String, rule) -> Set rule -> Set rule)
-> Set rule -> (String, rule) -> Set rule
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String, rule) -> Set rule -> Set rule
inserter) Set rule
forall a. Set a
Set.empty where
  inserter :: (String, rule) -> Set rule -> Set rule
inserter (String
nameY,rule
y) =
    if String
nameX String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
nameY then rule -> Set rule -> Set rule
forall a. Ord a => a -> Set a -> Set a
Set.insert rule
y else Set rule -> Set rule
forall a. a -> a
id

-- instances
instance (Ord rule, NonTerminalSymbol rule)
  => BackusNaurForm (Bnf rule) where
    rule :: String -> Bnf rule -> Bnf rule
rule String
label (Bnf rule
newRule Set (String, rule)
oldRules) = (String -> Bnf rule
forall s. NonTerminalSymbol s => String -> s
nonTerminal String
label)
      {rulesBnf = Set.insert (label, newRule) oldRules}
    ruleRec :: String -> (Bnf rule -> Bnf rule) -> Bnf rule
ruleRec String
label Bnf rule -> Bnf rule
f = String -> Bnf rule -> Bnf rule
forall bnf. BackusNaurForm bnf => String -> bnf -> bnf
rule String
label (Bnf rule -> Bnf rule
f (String -> Bnf rule
forall s. NonTerminalSymbol s => String -> s
nonTerminal String
label))
instance (forall x. BackusNaurForm (f x))
  => BackusNaurForm (Joker f a b) where
    rule :: String -> Joker f a b -> Joker f a b
rule String
name = f b -> Joker f a b
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (f b -> Joker f a b)
-> (Joker f a b -> f b) -> Joker f a b -> Joker f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> f b -> f b
forall bnf. BackusNaurForm bnf => String -> bnf -> bnf
rule String
name (f b -> f b) -> (Joker f a b -> f b) -> Joker f a b -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joker f a b -> f b
forall {k1} {k2} (g :: k1 -> *) (a :: k2) (b :: k1).
Joker g a b -> g b
runJoker
    ruleRec :: String -> (Joker f a b -> Joker f a b) -> Joker f a b
ruleRec String
name = f b -> Joker f a b
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (f b -> Joker f a b)
-> ((Joker f a b -> Joker f a b) -> f b)
-> (Joker f a b -> Joker f a b)
-> Joker f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (f b -> f b) -> f b
forall bnf. BackusNaurForm bnf => String -> (bnf -> bnf) -> bnf
ruleRec String
name ((f b -> f b) -> f b)
-> ((Joker f a b -> Joker f a b) -> f b -> f b)
-> (Joker f a b -> Joker f a b)
-> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f b -> Joker f a b)
-> (Joker f a b -> f b)
-> (Joker f a b -> Joker f a b)
-> f b
-> f b
forall a b c d. (a -> b) -> (c -> d) -> (b -> c) -> a -> d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap f b -> Joker f a b
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker Joker f a b -> f b
forall {k1} {k2} (g :: k1 -> *) (a :: k2) (b :: k1).
Joker g a b -> g b
runJoker
instance BackusNaurForm (ReadP a)
instance (Ord rule, TerminalSymbol token rule)
  => TerminalSymbol token (Bnf rule) where
  terminal :: [token] -> Bnf rule
terminal = rule -> Bnf rule
forall a. Ord a => a -> Bnf a
liftBnf0 (rule -> Bnf rule) -> ([token] -> rule) -> [token] -> Bnf rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [token] -> rule
forall token s. TerminalSymbol token s => [token] -> s
terminal
instance (Ord rule, NonTerminalSymbol rule)
  => NonTerminalSymbol (Bnf rule) where
  nonTerminal :: String -> Bnf rule
nonTerminal = rule -> Bnf rule
forall a. Ord a => a -> Bnf a
liftBnf0 (rule -> Bnf rule) -> (String -> rule) -> String -> Bnf rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> rule
forall s. NonTerminalSymbol s => String -> s
nonTerminal
instance (Ord rule, Tokenized token rule)
  => Tokenized token (Bnf rule) where
  anyToken :: Bnf rule
anyToken = rule -> Bnf rule
forall a. Ord a => a -> Bnf a
liftBnf0 rule
forall token p. Tokenized token p => p
anyToken
  token :: token -> Bnf rule
token = rule -> Bnf rule
forall a. Ord a => a -> Bnf a
liftBnf0 (rule -> Bnf rule) -> (token -> rule) -> token -> Bnf rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. token -> rule
forall token p. Tokenized token p => token -> p
token
  oneOf :: forall (f :: * -> *). Foldable f => f token -> Bnf rule
oneOf = rule -> Bnf rule
forall a. Ord a => a -> Bnf a
liftBnf0 (rule -> Bnf rule) -> (f token -> rule) -> f token -> Bnf rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f token -> rule
forall token p (f :: * -> *).
(Tokenized token p, Foldable f) =>
f token -> p
forall (f :: * -> *). Foldable f => f token -> rule
oneOf
  notOneOf :: forall (f :: * -> *). Foldable f => f token -> Bnf rule
notOneOf = rule -> Bnf rule
forall a. Ord a => a -> Bnf a
liftBnf0 (rule -> Bnf rule) -> (f token -> rule) -> f token -> Bnf rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f token -> rule
forall token p (f :: * -> *).
(Tokenized token p, Foldable f) =>
f token -> p
forall (f :: * -> *). Foldable f => f token -> rule
notOneOf
  asIn :: Categorize token -> Bnf rule
asIn = rule -> Bnf rule
forall a. Ord a => a -> Bnf a
liftBnf0 (rule -> Bnf rule)
-> (Categorize token -> rule) -> Categorize token -> Bnf rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Categorize token -> rule
forall token p. Tokenized token p => Categorize token -> p
asIn
  notAsIn :: Categorize token -> Bnf rule
notAsIn = rule -> Bnf rule
forall a. Ord a => a -> Bnf a
liftBnf0 (rule -> Bnf rule)
-> (Categorize token -> rule) -> Categorize token -> Bnf rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Categorize token -> rule
forall token p. Tokenized token p => Categorize token -> p
notAsIn
instance (Ord rule, TokenAlgebra token rule)
  => TokenAlgebra token (Bnf rule) where
  tokenClass :: TokenClass token -> Bnf rule
tokenClass = rule -> Bnf rule
forall a. Ord a => a -> Bnf a
liftBnf0 (rule -> Bnf rule)
-> (TokenClass token -> rule) -> TokenClass token -> Bnf rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenClass token -> rule
forall token p. TokenAlgebra token p => TokenClass token -> p
tokenClass
instance (Ord rule, KleeneStarAlgebra rule)
  => KleeneStarAlgebra (Bnf rule) where
  starK :: Bnf rule -> Bnf rule
starK = (rule -> rule) -> Bnf rule -> Bnf rule
forall a b. (Coercible a b, Ord b) => (a -> b) -> Bnf a -> Bnf b
liftBnf1 rule -> rule
forall k. KleeneStarAlgebra k => k -> k
starK
  plusK :: Bnf rule -> Bnf rule
plusK = (rule -> rule) -> Bnf rule -> Bnf rule
forall a b. (Coercible a b, Ord b) => (a -> b) -> Bnf a -> Bnf b
liftBnf1 rule -> rule
forall k. KleeneStarAlgebra k => k -> k
plusK
  optK :: Bnf rule -> Bnf rule
optK = (rule -> rule) -> Bnf rule -> Bnf rule
forall a b. (Coercible a b, Ord b) => (a -> b) -> Bnf a -> Bnf b
liftBnf1 rule -> rule
forall k. KleeneStarAlgebra k => k -> k
optK
  zeroK :: Bnf rule
zeroK = rule -> Bnf rule
forall a. Ord a => a -> Bnf a
liftBnf0 rule
forall k. KleeneStarAlgebra k => k
zeroK
  >|< :: Bnf rule -> Bnf rule -> Bnf rule
(>|<) = (rule -> rule -> rule) -> Bnf rule -> Bnf rule -> Bnf rule
forall a c b.
(Coercible a c, Coercible b c, Ord c) =>
(a -> b -> c) -> Bnf a -> Bnf b -> Bnf c
liftBnf2 rule -> rule -> rule
forall k. KleeneStarAlgebra k => k -> k -> k
(>|<)
instance (Ord rule, Monoid rule) => Monoid (Bnf rule) where
  mempty :: Bnf rule
mempty = rule -> Bnf rule
forall a. Ord a => a -> Bnf a
liftBnf0 rule
forall a. Monoid a => a
mempty
instance (Ord rule, Semigroup rule) => Semigroup (Bnf rule) where
  <> :: Bnf rule -> Bnf rule -> Bnf rule
(<>) = (rule -> rule -> rule) -> Bnf rule -> Bnf rule -> Bnf rule
forall a c b.
(Coercible a c, Coercible b c, Ord c) =>
(a -> b -> c) -> Bnf a -> Bnf b -> Bnf c
liftBnf2 rule -> rule -> rule
forall a. Semigroup a => a -> a -> a
(<>)