{- |
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
    -- * Matching
  , Matching (..)
  , diffB
  ) where

import Control.Lens
import Control.Lens.Extras
import Control.Lens.Grammar.Boole
import Control.Lens.Grammar.Kleene
import Control.Lens.Grammar.Token
import Control.Lens.Grammar.Symbol
import Data.Coerce
import Data.Foldable
import Data.Function
import Data.MemoTrie
import qualified Data.Set as Set
import Data.Set (Set)

{- | `BackusNaurForm` grammar combinators formalize
`rule` abstraction and general recursion. Context-free
`Control.Lens.Grammar.Grammar`s support the `BackusNaurForm` interface.
-}
class BackusNaurForm bnf where

  {- | For a `BackusNaurForm` parser instance,
  `rule` can be used to detail parse errors.

  prop> rule name bnf = ruleRec name (\_ -> bnf)
  -}
  rule :: String -> bnf -> bnf
  rule String
_ = bnf -> bnf
forall a. a -> a
id

  {- | General recursion, using `ruleRec`, rules can refer to themselves. -}
  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, supporting the `BackusNaurForm` interface. -}
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)

-- | Does a word match a pattern?
class Matching word pattern | pattern -> word where
  (=~) :: word -> pattern -> Bool
  infix 2 =~

{- |
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
-}
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
      Terminal [] -> RegEx token
forall k. KleeneStarAlgebra k => k
zeroK
      Terminal (token
tokenY:[token]
streamY) ->
        if token
x token -> token -> Bool
forall a. Eq a => a -> a -> Bool
== token
tokenY then [token] -> RegEx token
forall token s. TerminalSymbol token s => [token] -> s
terminal [token]
streamY else 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 RegExam token (RegEx token)
Fail -> RegEx token
forall k. KleeneStarAlgebra k => k
zeroK
      RegExam RegExam token (RegEx token)
Pass -> RegEx token
forall a. Monoid a => a
mempty
      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 (AsIn 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 (NotAsIn 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
    Terminal [] -> 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
name = String -> (Bnf rule -> Bnf rule) -> Bnf rule
forall bnf. BackusNaurForm bnf => String -> (bnf -> bnf) -> bnf
ruleRec String
name ((Bnf rule -> Bnf rule) -> Bnf rule)
-> (Bnf rule -> Bnf rule -> Bnf rule) -> Bnf rule -> Bnf rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bnf rule -> Bnf rule -> Bnf rule
forall a b. a -> b -> a
const
    ruleRec :: String -> (Bnf rule -> Bnf rule) -> Bnf rule
ruleRec String
name Bnf rule -> Bnf rule
f =
      let
        newStart :: rule
newStart = String -> rule
forall s. NonTerminalSymbol s => String -> s
nonTerminal String
name
        Bnf rule
newRule Set (String, rule)
oldRules = Bnf rule -> Bnf rule
f (rule -> Set (String, rule) -> Bnf rule
forall rule. rule -> Set (String, rule) -> Bnf rule
Bnf rule
newStart Set (String, rule)
forall a. Monoid a => a
mempty)
        newRules :: Set (String, rule)
newRules = (String, rule) -> Set (String, rule) -> Set (String, rule)
forall a. Ord a => a -> Set a -> Set a
Set.insert (String
name, rule
newRule) Set (String, rule)
oldRules
      in
        rule -> Set (String, rule) -> Bnf rule
forall rule. rule -> Set (String, rule) -> Bnf rule
Bnf rule
newStart Set (String, rule)
newRules
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 :: TokenTest token -> Bnf rule
tokenClass = rule -> Bnf rule
forall a. Ord a => a -> Bnf a
liftBnf0 (rule -> Bnf rule)
-> (TokenTest token -> rule) -> TokenTest token -> Bnf rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenTest token -> rule
forall token p. TokenAlgebra token p => TokenTest 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
(<>)
instance (Categorized token, HasTrie token)
  => Matching [token] (Bnf (RegEx token)) where
    =~ :: [token] -> Bnf (RegEx token) -> Bool
(=~) [token]
word = Bnf (RegEx token) -> Bool
forall token.
(Categorized token, HasTrie token) =>
Bnf (RegEx token) -> Bool
δ (Bnf (RegEx token) -> Bool)
-> (Bnf (RegEx token) -> Bnf (RegEx token))
-> Bnf (RegEx token)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [token] -> Bnf (RegEx token) -> Bnf (RegEx token)
forall token.
(Categorized token, HasTrie token) =>
[token] -> Bnf (RegEx token) -> Bnf (RegEx token)
diffB [token]
word
instance (Categorized token, HasTrie token)
  => Matching [token] (RegEx token) where
    [token]
word =~ :: [token] -> RegEx token -> Bool
=~ RegEx token
pattern = [token]
word [token] -> Bnf (RegEx token) -> Bool
forall word pattern.
Matching word pattern =>
word -> pattern -> Bool
=~ RegEx token -> Bnf (RegEx token)
forall a. Ord a => a -> Bnf a
liftBnf0 RegEx token
pattern
instance Matching s (APrism s t a b) where
  s
word =~ :: s -> APrism s t a b -> Bool
=~ APrism s t a b
pattern = APrism s t a b -> s -> Bool
forall s t a b. APrism s t a b -> s -> Bool
is APrism s t a b
pattern s
word