{- |
Module      : Control.Lens.Grammar
Description : grammar hierarchy
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 Chomsky, [On Certain Formal Properties of Grammars]
(https://somr.info/lib/Chomsky_1959.pdf)
-}

module Control.Lens.Grammar
  ( -- * Regular grammar
    RegGrammar
  , Lexical
  , RegString (..)
  , regstringG
  , regexGrammar
    -- * Context-free grammar
  , Grammar
  , RegBnf (..)
  , regbnfG
  , regbnfGrammar
  , applicativeG
  , transducerG
    -- * Context-sensitive grammar
  , CtxGrammar
  , printG
  , parseG
  , unparseG
  , parsecG
  , unparsecG
  , readG
  , monadG
    -- * Utility
  , putStringLn
    -- * Re-exports
  , module X
  ) where

import Control.Applicative
import Control.Lens
import Control.Lens.PartialIso
import Control.Lens.Grammar.BackusNaur
import Control.Lens.Grammar.Boole
import Control.Lens.Grammar.Kleene
import Control.Lens.Grammar.Machine
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
import Data.Profunctor.Filtrator
import Data.Profunctor.Monadic
import Data.Profunctor.Monoidal
import Data.Profunctor.Grammar
import Data.Profunctor.Grammar.Parsector
import Data.Profunctor.Separator
import Data.String
import GHC.Exts
import Prelude hiding (filter)
import Text.ParserCombinators.ReadP (ReadP, readP_to_S)
import Witherable

-- Re-exports
import Control.Lens.Grammar.BackusNaur as X
import Control.Lens.Grammar.Boole as X
import Control.Lens.Grammar.Kleene as X
import Control.Lens.Grammar.Machine as X
import Control.Lens.Grammar.Symbol as X
import Control.Lens.Grammar.Token as X
import Control.Lens.PartialIso as X
import Control.Monad.Fail.Try as X
import Data.Profunctor.Distributor as X
import Data.Profunctor.Filtrator as X
import Data.Profunctor.Grammar as X
import Data.Profunctor.Grammar.Parsector as X
import Data.Profunctor.Monoidal as X
import Data.Profunctor.Separator as X
import Data.Traversable.Homogeneous as X

{- |
A regular grammar may be constructed using
`Lexical` and `Alternator` combinators.
Let's see an example using
[semantic versioning](https://semver.org/) syntax.

>>> import Numeric.Natural (Natural)
>>> :{
data SemVer = SemVer          -- e.g., 2.1.5-rc.1+build.123
  { major         :: Natural  -- e.g., 1
  , minor         :: Natural  -- e.g., 2
  , patch         :: Natural  -- e.g., 3
  , preRelease    :: [String] -- e.g., "alpha.1", "rc.2"
  , buildMetadata :: [String] -- e.g., "build.123", "20130313144700"
  }
  deriving (Eq, Ord, Show, Read)
:}

We'd like to define an optic @_SemVer@,
corresponding to the constructor pattern @SemVer@.
You could generate it with the TemplateHaskell combinator,
`makeNestedPrisms`.

@makeNestedPrisms ''SemVer@

Unfortunately, we can't use TemplateHaskell to generate it in [GHCi]
(https://wiki.haskell.org/GHC/GHCi),
which is used to test this documenation.
Here is equivalent Haskell code instead.
Since @SemVer@ has only one constructor,
@_SemVer@ can be an `Control.Lens.Iso.Iso`.

>>> :set -XRecordWildCards
>>> import Control.Lens (Iso', iso)
>>> :{
_SemVer :: Iso' SemVer (Natural, (Natural, (Natural, ([String], [String]))))
_SemVer = iso
  (\SemVer {..} -> (major, (minor, (patch, (preRelease, buildMetadata)))))
  (\(major, (minor, (patch, (preRelease, buildMetadata)))) -> SemVer {..})
:}

Now we can build a `RegGrammar` for @SemVer@ using the "idiom" style of
`Applicative` parsing with a couple modifications.

>>> :{
semverGrammar :: RegGrammar Char SemVer
semverGrammar = _SemVer
  >?  numberG
  >*< terminal "." >* numberG
  >*< terminal "." >* numberG
  >*< optionP _Empty (terminal "-" >* identifiersG)
  >*< optionP _Empty (terminal "+" >* identifiersG)
  where
    numberG = iso show read >~ someP (asIn @Char DecimalNumber)
    identifiersG = several1 (sepWith ".") (someP charG)
    charG = asIn LowercaseLetter
      <|> asIn UppercaseLetter
      <|> asIn DecimalNumber
      <|> token '-'
:}

Instead of using the constructor @SemVer@ with the `Functor` applicator `<$>`,
we use the optic @_SemVer@ we defined and the `Choice` applicator `>?`;
although, we could have used the `Profunctor` applicator `>~` instead,
because @_SemVer@ is an `Control.Lens.Iso.Iso`. A few `Alternative`
combinators like `<|>` work both `Functor`ially and `Profunctor`ially.

+------------+---------------+
| Functorial | Profunctorial |
+============+===============+
| @SemVer@   | @_SemVer@     |
+------------+---------------+
| `<$>`      | `>?`          |
+------------+---------------+
| `pure`     | `pureP`       |
+------------+---------------+
| `*>`       | `>*`          |
+------------+---------------+
| `<*`       | `*<`          |
+------------+---------------+
| `<*>`      | `>*<`         |
+------------+---------------+
| `empty`    | `empty`       |
+------------+---------------+
| `<|>`      | `<|>`         |
+------------+---------------+
| `choice`   | `choice`      |
+------------+---------------+
| `many`     | `manyP`       |
+------------+---------------+
| `some`     | `someP`       |
+------------+---------------+
| `optional` | `optionalP`   |
+------------+---------------+

You can generate a `RegString` from a `RegGrammar` with `regstringG`.

>>> putStringLn (regstringG semverGrammar)
\p{Nd}+(.\p{Nd}+(.\p{Nd}+((-((\p{Ll}|\p{Lu}|\p{Nd}|-)+(.(\p{Ll}|\p{Lu}|\p{Nd}|-)+)*))?(\+((\p{Ll}|\p{Lu}|\p{Nd}|-)+(.(\p{Ll}|\p{Lu}|\p{Nd}|-)+)*))?)))

You can also generate parsers and printers.

>>> [parsed | (parsed, "") <- parseG semverGrammar "2.1.5-rc.1+build.123"]
[SemVer {major = 2, minor = 1, patch = 5, preRelease = ["rc","1"], buildMetadata = ["build","123"]}]

Parsing `uncons`es tokens left-to-right, from the beginning of a string.
Unparsing, on the other hand, `snoc`s tokens left-to-right, to the end of a string.

>>> unparseG semverGrammar (SemVer 1 0 0 ["alpha"] []) "SemVer: " :: Maybe String
Just "SemVer: 1.0.0-alpha"

Printing, on the gripping hand, `cons`es tokens right-to-left, to the beginning of a string.

>>> ($ " is the SemVer.") <$> printG semverGrammar (SemVer 1 2 3 [] []) :: Maybe String
Just "1.2.3 is the SemVer."

`Profunctor`ial combinators give us correct-by-construction invertible parsers.
New `RegGrammar` generators can be defined with new instances of `Lexical` `Alternator`s.
-}
type RegGrammar token a = forall p.
  ( Lexical token p
  , Alternator p
  ) => p a a

{- | Context-free `Grammar`s add two capabilities to `RegGrammar`s,
coming from the `BackusNaurForm` interface

* `rule` abstraction,
* and general recursion.

`regexGrammar` and `regbnfGrammar` are examples of context-free
`Grammar`s. Regular expressions are a form of expression algebra.
Let's see a similar but simpler example,
the algebra of arithmetic expressions of natural numbers.

>>> import Numeric.Natural (Natural)
>>> :{
data Arith
  = Num Natural
  | Add Arith Arith
  | Mul Arith Arith
  deriving stock (Eq, Ord, Show, Read)
:}

Here are `Control.Lens.Prism.Prism`s for the constructor patterns.

>>> import Control.Lens (Prism', prism')
>>> :{
_Num :: Prism' Arith Natural
_Num = prism' Num (\case Num n -> Just n; _ -> Nothing)
_Add, _Mul :: Prism' Arith (Arith, Arith)
_Add = prism' (uncurry Add) (\case Add x y -> Just (x,y); _ -> Nothing)
_Mul = prism' (uncurry Mul) (\case Mul x y -> Just (x,y); _ -> Nothing)
:}

Now we can build a `Grammar` for @Arith@
by combining "idiom" style with named `rule`s,
and tying the recursive loop
(caused by parenthesization)
with `ruleRec`.

>>> :{
arithGrammar :: Grammar Char Arith
arithGrammar = ruleRec "arith" sumG
  where
    sumG arith = rule "sum" $
      chain1 Left _Add (sepWith "+") (prodG arith)
    prodG arith = rule "product" $
      chain1 Left _Mul (sepWith "*") (factorG arith)
    factorG arith = rule "factor" $
      numberG <|> terminal "(" >* arith *< terminal ")"
    numberG = rule "number" $
      _Num . iso show read >? someP (asIn @Char DecimalNumber)
:}

We can generate grammar strings, printers and parsers from @arithGrammar@.

>>> putStringLn (regbnfG arithGrammar)
{start} = \q{arith}
{arith} = \q{sum}
{factor} = \q{number}|\(\q{arith}\)
{number} = \p{Nd}+
{product} = \q{factor}(\*\q{factor})*
{sum} = \q{product}(\+\q{product})*
>>> [x | (x,"") <- parseG arithGrammar "1+2*3+4"]
[Add (Add (Num 1) (Mul (Num 2) (Num 3))) (Num 4)]
>>> unparseG arithGrammar (Add (Num 1) (Mul (Num 2) (Num 3))) "" :: Maybe String
Just "1+2*3"
>>> do pr <- printG arithGrammar (Num 69); pure (pr "") :: Maybe String
Just "69"

If all `rule`s are non-recursive, then a `Grammar`
can be rewritten as a `RegGrammar`.
Since Haskell permits general recursion, and `RegGrammar`s are
embedded in Haskell, you can define context-free grammars with them.
But it's recommended to use `Grammar`s for `rule` abstraction
and generator support for `ruleRec`.

-}
type Grammar token a = forall p.
  ( Lexical token p
  , Alternator p
  , forall x. BackusNaurForm (p x x)
  ) => p a a

{- | For context-sensitivity,
the `Monadic` interface is used by importing "Data.Profunctor.Monadic"
qualified and using a "bonding" notation which mixes
"idiom" style with qualified do-notation.
Let's use length-encoded vectors of numbers as an example.

>>> import Numeric.Natural (Natural)
>>> import Control.Lens.Iso (Iso', iso)
>>> :set -XRecordWildCards
>>> :{
data LenVec = LenVec {length :: Natural, vector :: [Natural]}
  deriving (Eq, Ord, Show, Read)
_LenVec :: Iso' LenVec (Natural, [Natural])
_LenVec = iso (\LenVec {..} -> (length, vector)) (\(length, vector) -> LenVec {..})
:}

>>> :set -XQualifiedDo
>>> import qualified Data.Profunctor.Monadic as P
>>> :{
lenvecGrammar :: CtxGrammar Char LenVec
lenvecGrammar = _LenVec >? P.do
  let
    numberG = iso show read >~ someP (asIn @Char DecimalNumber)
    vectorG n = intercalateP n (sepWith ",") numberG
  len <- numberG             -- bonds to _LenVec
  terminal ";"               -- doesn't bond
  vectorG (fromIntegral len) -- bonds to _LenVec
:}

The qualified do-notation changes the signature of
@P.@`Data.Profunctor.Monadic.>>=`,
so that we must apply the constructor pattern @_LenVec@
to the do-block with the `>?` applicator.
Any scoped bound action, @var <- action@,
gets "bonded" to the constructor pattern.
Any unbound actions, except for the last action in the do-block,
does not get bonded to the pattern.
The last action does get bonded to the pattern.
Any unscoped bound action, @_ <- action@,
also gets bonded to the pattern,
but being unscoped means it isn't added to the context.
If all bound actions are unscoped,
and filtration & failure handling aren't used,
then a `CtxGrammar` can be rewritten as a `Grammar` since it is context-free.
We can't generate a `RegBnf` from a `CtxGrammar` since the `rule`s
aren't static, but dynamic and contextual.
We can generate parsers and printers as expected.

>>> [vec | (vec, "") <- parseG lenvecGrammar "3;1,2,3"] :: [LenVec]
[LenVec {length = 3, vector = [1,2,3]}]
>>> [vec | (vec, "") <- parseG lenvecGrammar "0;1,2,3"] :: [LenVec]
[]
>>> [pr "" | pr <- printG lenvecGrammar (LenVec 2 [6,7])] :: [String]
["2;6,7"]
>>> [pr "" | pr <- printG lenvecGrammar (LenVec 200 [100])] :: [String]
[]

In addition to context-sensitivity via `Monadic` combinators,
`CtxGrammar`s add unrestricted filtration to `Grammar`s.
The `satisfy` combinator is an unrestricted token filter.
And the `satisfied` pattern is used together with the `Choice` &
`Data.Profunctor.Cochoice` applicator `>?<` for unrestricted filtration.

>>> :{
palindromeG :: CtxGrammar Char String
palindromeG = rule "palindrome" $
  satisfied (\wrd -> reverse wrd == wrd) >?< manyP (anyToken @Char)
:}

>>> [pal | word <- ["racecar", "word"], (pal, "") <- parseG palindromeG word]
["racecar"]

Since `CtxGrammar`s are embedded in Haskell,
permitting computable predicates,
and `Filtrator` has a default definition for `Monadic` `Alternator`s,
the context-sensitivity of `CtxGrammar` implies
unrestricted filtration of grammars by computable predicates,
which can recognize the larger class of recursively enumerable languages.

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.
An @LL@ parser (un)parses from left to right,
and constucts leftmost derivations.
An @LL(k)@ parser can look @k@ tokens ahead.
`Parsor` is an @LL(∞)@ parser.
`Parsector` is an @LL(1)@ parser.
The backtracking `try` combinator
restores full lookahead to `Parsector`.
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", 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", 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", parsecFailure = ParsecFailure {parsecExpect = TokenClass (OneOf (fromList "c")), parsecLabels = []}, parsecResult = Nothing}

-}
type CtxGrammar token a = forall p.
  ( Lexical token p
  , Alternator p
  , Filtrator p
  , MonadicTry p
  ) => p a a

{- |
`Lexical` combinators include `terminal` symbols,
`Tokenized` combinators and `tokenClass`es.
-}
type Lexical token p =
  ( forall x y. (x ~ (), y ~ ()) => TerminalSymbol token (p x y)
  , forall x y. (x ~ token, y ~ token) => TokenAlgebra token (p x y)
  ) :: Constraint

{- | `RegString`s are an embedded domain specific language
of regular expression strings.

Since they are strings, they have a string-like interface.

>>> let rex = fromString "ab|c" :: RegString
>>> putStringLn rex
ab|c
>>> rex
"ab|c"

`RegString`s can be generated from `RegGrammar`s with `regstringG`.

>>> regstringG (terminal "a" >* terminal "b" <|> terminal "c")
"ab|c"

`RegString`s are actually stored as an algebraic datatype, `RegEx`.

>>> runRegString rex
RegExam (Alternate (Sequence (RegExam (OneOf (fromList "a"))) (RegExam (OneOf (fromList "b")))) (RegExam (OneOf (fromList "c"))))

`RegString`s are similar to regular expression strings in many other
programming languages. We can use them to see if a word and pattern
are `Matching`.

>>> "ab" =~ rex
True
>>> "c" =~ rex
True
>>> "xyz" =~ rex
False

Like `RegGrammar`s, `RegString`s can use all the `Lexical` combinators.
Unlike `RegGrammar`s, instead of using `Monoidal` and `Alternator` combinators,
`RegString`s use `Monoid` and `KleeneStarAlgebra` combinators.

>>> terminal "a" <> terminal "b" >|< terminal "c" :: RegString
"ab|c"
>>> mempty :: RegString
""

Since `RegString`s are a `KleeneStarAlgebra`,
they support Kleene quantifiers.

>>> starK rex
"(ab|c)*"
>>> plusK rex
"(ab|c)+"
>>> optK rex
"(ab|c)?"

Like other regular expression languages, `RegString`s support
character classes.

>>> oneOf "abc" :: RegString
"[abc]"
>>> notOneOf "abc" :: RegString
"[^abc]"

The character classes are used for failure, matching no character or string,
as well as the wildcard, matching any single character.

>>> zeroK :: RegString
"[]"
>>> anyToken :: RegString
"[^]"

Additional forms of character classes test for a character's `GeneralCategory`.

>>> asIn LowercaseLetter :: RegString
"\\p{Ll}"
>>> notAsIn Control :: RegString
"\\P{Cc}"

`KleeneStarAlgebra`s support alternation `>|<`,
and the `Tokenized` combinators are all negatable.
However, we'd like to be able to take the
intersection of character classes as well.
`RegString`s can combine characters' `tokenClass`es
using `BooleanAlgebra` combinators.

>>> tokenClass (notOneOf "abc" >&&< notOneOf "xyz") :: RegString
"[^abcxyz]"
>>> tokenClass (oneOf "abcxyz" >&&< notOneOf "xyz") :: RegString
"[abc]"
>>> tokenClass (notOneOf "#$%" >&&< notAsIn Control) :: RegString
"[^#$%\\P{Cc}]"
>>> tokenClass (allB notAsIn [MathSymbol, Control]) :: RegString
"\\P{Sm|Cc}"
>>> tokenClass (notB (oneOf "xyz")) :: RegString
"[^xyz]"

Ill-formed `RegString`s normalize to failure.

>>> fromString ")(" :: RegString
"[]"
-}
newtype RegString = RegString {RegString -> RegEx Char
runRegString :: RegEx Char}
  deriving newtype
    ( RegString -> RegString -> Bool
(RegString -> RegString -> Bool)
-> (RegString -> RegString -> Bool) -> Eq RegString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegString -> RegString -> Bool
== :: RegString -> RegString -> Bool
$c/= :: RegString -> RegString -> Bool
/= :: RegString -> RegString -> Bool
Eq, Eq RegString
Eq RegString =>
(RegString -> RegString -> Ordering)
-> (RegString -> RegString -> Bool)
-> (RegString -> RegString -> Bool)
-> (RegString -> RegString -> Bool)
-> (RegString -> RegString -> Bool)
-> (RegString -> RegString -> RegString)
-> (RegString -> RegString -> RegString)
-> Ord RegString
RegString -> RegString -> Bool
RegString -> RegString -> Ordering
RegString -> RegString -> RegString
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
$ccompare :: RegString -> RegString -> Ordering
compare :: RegString -> RegString -> Ordering
$c< :: RegString -> RegString -> Bool
< :: RegString -> RegString -> Bool
$c<= :: RegString -> RegString -> Bool
<= :: RegString -> RegString -> Bool
$c> :: RegString -> RegString -> Bool
> :: RegString -> RegString -> Bool
$c>= :: RegString -> RegString -> Bool
>= :: RegString -> RegString -> Bool
$cmax :: RegString -> RegString -> RegString
max :: RegString -> RegString -> RegString
$cmin :: RegString -> RegString -> RegString
min :: RegString -> RegString -> RegString
Ord
    , NonEmpty RegString -> RegString
RegString -> RegString -> RegString
(RegString -> RegString -> RegString)
-> (NonEmpty RegString -> RegString)
-> (forall b. Integral b => b -> RegString -> RegString)
-> Semigroup RegString
forall b. Integral b => b -> RegString -> RegString
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: RegString -> RegString -> RegString
<> :: RegString -> RegString -> RegString
$csconcat :: NonEmpty RegString -> RegString
sconcat :: NonEmpty RegString -> RegString
$cstimes :: forall b. Integral b => b -> RegString -> RegString
stimes :: forall b. Integral b => b -> RegString -> RegString
Semigroup, Semigroup RegString
RegString
Semigroup RegString =>
RegString
-> (RegString -> RegString -> RegString)
-> ([RegString] -> RegString)
-> Monoid RegString
[RegString] -> RegString
RegString -> RegString -> RegString
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: RegString
mempty :: RegString
$cmappend :: RegString -> RegString -> RegString
mappend :: RegString -> RegString -> RegString
$cmconcat :: [RegString] -> RegString
mconcat :: [RegString] -> RegString
Monoid, Monoid RegString
RegString
Monoid RegString =>
(RegString -> RegString)
-> (RegString -> RegString)
-> (RegString -> RegString)
-> (RegString -> RegString -> RegString)
-> RegString
-> KleeneStarAlgebra RegString
RegString -> RegString
RegString -> RegString -> RegString
forall k.
Monoid k =>
(k -> k)
-> (k -> k)
-> (k -> k)
-> (k -> k -> k)
-> k
-> KleeneStarAlgebra k
$cstarK :: RegString -> RegString
starK :: RegString -> RegString
$cplusK :: RegString -> RegString
plusK :: RegString -> RegString
$coptK :: RegString -> RegString
optK :: RegString -> RegString
$c>|< :: RegString -> RegString -> RegString
>|< :: RegString -> RegString -> RegString
$czeroK :: RegString
zeroK :: RegString
KleeneStarAlgebra
    , Tokenized Char, TokenAlgebra Char
    , TerminalSymbol Char, [Char] -> RegString
([Char] -> RegString) -> NonTerminalSymbol RegString
forall s. ([Char] -> s) -> NonTerminalSymbol s
$cnonTerminal :: [Char] -> RegString
nonTerminal :: [Char] -> RegString
NonTerminalSymbol
    , Matching String
    )

{- | `RegBnf`s are an embedded domain specific language
of Backus-Naur forms extended by regular expression strings.

A `RegBnf` consists of a distinguished `RegString` "start" rule,
and a set of named `RegString` `rule`s.

>>> putStringLn (rule "baz" (terminal "foo" >|< terminal "bar") :: RegBnf)
{start} = \q{baz}
{baz} = foo|bar

Like `RegString`s they have a string-like interface.

>>> let bnf = fromString "{start} = foo|bar" :: RegBnf
>>> putStringLn bnf
{start} = foo|bar
>>> bnf
"{start} = foo|bar"
>>> :type toList bnf
toList bnf :: [Char]

`RegBnf`s can be generated from context-free `Grammar`s with `regbnfG`.

>>> :type regbnfG regbnfGrammar
regbnfG regbnfGrammar :: RegBnf

Like `RegString`s, `RegBnf`s can be constructed using
`Lexical`, `Monoid` and `KleeneStarAlgebra` combinators.
But they also support `BackusNaurForm` `rule`s and `ruleRec`s.

>>> putStringLn (rule "baz" (bnf >|< terminal "baz"))
{start} = \q{baz}
{baz} = foo|bar|baz
>>> putStringLn (ruleRec "∞-loop" (\x -> x) :: RegBnf)
{start} = \q{∞-loop}
{∞-loop} = \q{∞-loop}
-}
newtype RegBnf = RegBnf {RegBnf -> Bnf RegString
runRegBnf :: Bnf RegString}
  deriving newtype
    ( RegBnf -> RegBnf -> Bool
(RegBnf -> RegBnf -> Bool)
-> (RegBnf -> RegBnf -> Bool) -> Eq RegBnf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegBnf -> RegBnf -> Bool
== :: RegBnf -> RegBnf -> Bool
$c/= :: RegBnf -> RegBnf -> Bool
/= :: RegBnf -> RegBnf -> Bool
Eq, Eq RegBnf
Eq RegBnf =>
(RegBnf -> RegBnf -> Ordering)
-> (RegBnf -> RegBnf -> Bool)
-> (RegBnf -> RegBnf -> Bool)
-> (RegBnf -> RegBnf -> Bool)
-> (RegBnf -> RegBnf -> Bool)
-> (RegBnf -> RegBnf -> RegBnf)
-> (RegBnf -> RegBnf -> RegBnf)
-> Ord RegBnf
RegBnf -> RegBnf -> Bool
RegBnf -> RegBnf -> Ordering
RegBnf -> RegBnf -> RegBnf
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
$ccompare :: RegBnf -> RegBnf -> Ordering
compare :: RegBnf -> RegBnf -> Ordering
$c< :: RegBnf -> RegBnf -> Bool
< :: RegBnf -> RegBnf -> Bool
$c<= :: RegBnf -> RegBnf -> Bool
<= :: RegBnf -> RegBnf -> Bool
$c> :: RegBnf -> RegBnf -> Bool
> :: RegBnf -> RegBnf -> Bool
$c>= :: RegBnf -> RegBnf -> Bool
>= :: RegBnf -> RegBnf -> Bool
$cmax :: RegBnf -> RegBnf -> RegBnf
max :: RegBnf -> RegBnf -> RegBnf
$cmin :: RegBnf -> RegBnf -> RegBnf
min :: RegBnf -> RegBnf -> RegBnf
Ord
    , NonEmpty RegBnf -> RegBnf
RegBnf -> RegBnf -> RegBnf
(RegBnf -> RegBnf -> RegBnf)
-> (NonEmpty RegBnf -> RegBnf)
-> (forall b. Integral b => b -> RegBnf -> RegBnf)
-> Semigroup RegBnf
forall b. Integral b => b -> RegBnf -> RegBnf
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: RegBnf -> RegBnf -> RegBnf
<> :: RegBnf -> RegBnf -> RegBnf
$csconcat :: NonEmpty RegBnf -> RegBnf
sconcat :: NonEmpty RegBnf -> RegBnf
$cstimes :: forall b. Integral b => b -> RegBnf -> RegBnf
stimes :: forall b. Integral b => b -> RegBnf -> RegBnf
Semigroup, Semigroup RegBnf
RegBnf
Semigroup RegBnf =>
RegBnf
-> (RegBnf -> RegBnf -> RegBnf)
-> ([RegBnf] -> RegBnf)
-> Monoid RegBnf
[RegBnf] -> RegBnf
RegBnf -> RegBnf -> RegBnf
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: RegBnf
mempty :: RegBnf
$cmappend :: RegBnf -> RegBnf -> RegBnf
mappend :: RegBnf -> RegBnf -> RegBnf
$cmconcat :: [RegBnf] -> RegBnf
mconcat :: [RegBnf] -> RegBnf
Monoid, Monoid RegBnf
RegBnf
Monoid RegBnf =>
(RegBnf -> RegBnf)
-> (RegBnf -> RegBnf)
-> (RegBnf -> RegBnf)
-> (RegBnf -> RegBnf -> RegBnf)
-> RegBnf
-> KleeneStarAlgebra RegBnf
RegBnf -> RegBnf
RegBnf -> RegBnf -> RegBnf
forall k.
Monoid k =>
(k -> k)
-> (k -> k)
-> (k -> k)
-> (k -> k -> k)
-> k
-> KleeneStarAlgebra k
$cstarK :: RegBnf -> RegBnf
starK :: RegBnf -> RegBnf
$cplusK :: RegBnf -> RegBnf
plusK :: RegBnf -> RegBnf
$coptK :: RegBnf -> RegBnf
optK :: RegBnf -> RegBnf
$c>|< :: RegBnf -> RegBnf -> RegBnf
>|< :: RegBnf -> RegBnf -> RegBnf
$czeroK :: RegBnf
zeroK :: RegBnf
KleeneStarAlgebra
    , Tokenized Char, TokenAlgebra Char
    , TerminalSymbol Char, [Char] -> RegBnf
([Char] -> RegBnf) -> NonTerminalSymbol RegBnf
forall s. ([Char] -> s) -> NonTerminalSymbol s
$cnonTerminal :: [Char] -> RegBnf
nonTerminal :: [Char] -> RegBnf
NonTerminalSymbol
    , [Char] -> RegBnf -> RegBnf
[Char] -> (RegBnf -> RegBnf) -> RegBnf
([Char] -> RegBnf -> RegBnf)
-> ([Char] -> (RegBnf -> RegBnf) -> RegBnf)
-> BackusNaurForm RegBnf
forall bnf.
([Char] -> bnf -> bnf)
-> ([Char] -> (bnf -> bnf) -> bnf) -> BackusNaurForm bnf
$crule :: [Char] -> RegBnf -> RegBnf
rule :: [Char] -> RegBnf -> RegBnf
$cruleRec :: [Char] -> (RegBnf -> RegBnf) -> RegBnf
ruleRec :: [Char] -> (RegBnf -> RegBnf) -> RegBnf
BackusNaurForm
    )
instance Matching String RegBnf where
  [Char]
word =~ :: [Char] -> RegBnf -> Bool
=~ RegBnf
pattern = [Char]
word [Char] -> Bnf (RegEx Char) -> Bool
forall word pattern.
Matching word pattern =>
word -> pattern -> Bool
=~ (RegString -> RegEx Char) -> Bnf RegString -> Bnf (RegEx Char)
forall a b. (Coercible a b, Ord b) => (a -> b) -> Bnf a -> Bnf b
liftBnf1 RegString -> RegEx Char
runRegString (RegBnf -> Bnf RegString
runRegBnf RegBnf
pattern)

makeNestedPrisms ''Bnf
makeNestedPrisms ''RegEx
makeNestedPrisms ''RegExam
makeNestedPrisms ''CategoryTest
makeNestedPrisms ''GeneralCategory
makeNestedPrisms ''RegString
makeNestedPrisms ''RegBnf

{- | `regexGrammar` is a context-free `Grammar` for `RegString`s.
It can't be a `RegGrammar`, since `RegString`s include parenthesization.
But [balanced parentheses](https://en.wikipedia.org/wiki/Dyck_language)
are a context-free language.

>>> putStringLn (regbnfG regexGrammar)
{start} = \q{regex}
{alternate} = \q{sequence}(\|\q{sequence})*
{atom} = \\q\q{nonterminal}|\q{class}|\(\q{regex}\)
{category} = Ll|Lu|Lt|Lm|Lo|Mn|Mc|Me|Nd|Nl|No|Pc|Pd|Ps|Pe|Pi|Pf|Po|Sm|Sc|Sk|So|Zs|Zl|Zp|Cc|Cf|Cs|Co|Cn
{char} = [^\(\)\*\+\?\[\\\]\^\{\|\}\P{Cc}]|\\\q{char-escaped}
{char-control} = NUL|SOH|STX|ETX|EOT|ENQ|ACK|BEL|BS|HT|LF|VT|FF|CR|SO|SI|DLE|DC1|DC2|DC3|DC4|NAK|SYN|ETB|CAN|EM|SUB|ESC|FS|GS|RS|US|DEL|PAD|HOP|BPH|NBH|IND|NEL|SSA|ESA|HTS|HTJ|VTS|PLD|PLU|RI|SS2|SS3|DCS|PU1|PU2|STS|CCH|MW|SPA|EPA|SOS|SGCI|SCI|CSI|ST|OSC|PM|APC
{char-escaped} = [\(\)\*\+\?\[\\\]\^\{\|\}]|\q{char-control}
{class} = \q{class-one-of}|\q{class-not-one-of}
{class-category} = \\p\{\q{category}\}|\\P\{(\q{category}(\|\q{category})*)\}
{class-not-one-of} = \q{class-category}|\[\^\q{char}*(\q{class-category}?\])
{class-one-of} = \q{char}|\[\q{char}*\]
{expression} = \q{atom}\?|\q{atom}\*|\q{atom}\+|\q{atom}
{nonterminal} = \{\q{char}*\}
{regex} = \q{alternate}
{sequence} = \q{expression}*
-}
regexGrammar :: Grammar Char RegString
regexGrammar :: Grammar Char RegString
regexGrammar = Exchange
  (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char))
-> Exchange
     (RegEx Char) (RegEx Char) RegString (Identity RegString)
Iso' RegString (RegEx Char)
_RegString (Exchange
   (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char))
 -> Exchange
      (RegEx Char) (RegEx Char) RegString (Identity RegString))
-> p (RegEx Char) (RegEx Char) -> p RegString RegString
forall (p :: * -> * -> *) s t a b.
Profunctor p =>
AnIso s t a b -> p a b -> p s t
>~ [Char]
-> (p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char))
-> p (RegEx Char) (RegEx Char)
forall bnf. BackusNaurForm bnf => [Char] -> (bnf -> bnf) -> bnf
ruleRec [Char]
"regex" p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
altG
  where
    altG :: p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
altG p (RegEx Char) (RegEx Char)
rex = [Char]
-> p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"alternate" (p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char))
-> p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
forall a b. (a -> b) -> a -> b
$
      (forall x. x -> Either x x)
-> APartialIso
     (RegEx Char)
     (RegEx Char)
     (RegEx Char, RegEx Char)
     (RegEx Char, RegEx Char)
-> SepBy (p () ())
-> p (RegEx Char) (RegEx Char)
-> p (RegEx Char) (RegEx Char)
forall (p :: * -> * -> *) a b.
(Distributor p, Choice p) =>
(forall x. x -> Either x x)
-> APartialIso a b (a, a) (b, b)
-> SepBy (p () ())
-> p a b
-> p a b
chain1 x -> Either x x
forall x. x -> Either x x
forall a b. a -> Either a b
Left (PartialExchange
  (RegEx Char, RegEx Char)
  (RegEx Char, RegEx Char)
  (RegExam Char (RegEx Char))
  (Maybe (RegExam Char (RegEx Char)))
-> PartialExchange
     (RegEx Char, RegEx Char)
     (RegEx Char, RegEx Char)
     (RegEx Char)
     (Maybe (RegEx Char))
forall token (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (RegExam token (RegEx token)) (f (RegExam token (RegEx token)))
-> p (RegEx token) (f (RegEx token))
_RegExam (PartialExchange
   (RegEx Char, RegEx Char)
   (RegEx Char, RegEx Char)
   (RegExam Char (RegEx Char))
   (Maybe (RegExam Char (RegEx Char)))
 -> PartialExchange
      (RegEx Char, RegEx Char)
      (RegEx Char, RegEx Char)
      (RegEx Char)
      (Maybe (RegEx Char)))
-> (PartialExchange
      (RegEx Char, RegEx Char)
      (RegEx Char, RegEx Char)
      (RegEx Char, RegEx Char)
      (Maybe (RegEx Char, RegEx Char))
    -> PartialExchange
         (RegEx Char, RegEx Char)
         (RegEx Char, RegEx Char)
         (RegExam Char (RegEx Char))
         (Maybe (RegExam Char (RegEx Char))))
-> APartialIso
     (RegEx Char)
     (RegEx Char)
     (RegEx Char, RegEx Char)
     (RegEx Char, RegEx Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialExchange
  (RegEx Char, RegEx Char)
  (RegEx Char, RegEx Char)
  (RegEx Char, RegEx Char)
  (Maybe (RegEx Char, RegEx Char))
-> PartialExchange
     (RegEx Char, RegEx Char)
     (RegEx Char, RegEx Char)
     (RegExam Char (RegEx Char))
     (Maybe (RegExam Char (RegEx Char)))
forall token alg alg (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (alg, alg) (f (alg, alg))
-> p (RegExam token alg) (f (RegExam token alg))
_Alternate) ([Char] -> SepBy (p () ())
forall (p :: * -> *) c.
(Applicative p, TerminalSymbol c (p ())) =>
[c] -> SepBy (p ())
sepWith [Char]
"|") (p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
seqG p (RegEx Char) (RegEx Char)
rex)

    seqG :: p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
seqG p (RegEx Char) (RegEx Char)
rex = [Char]
-> p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"sequence" (p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char))
-> p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
forall a b. (a -> b) -> a -> b
$
      (forall x. x -> Either x x)
-> APartialIso
     (RegEx Char)
     (RegEx Char)
     (RegEx Char, RegEx Char)
     (RegEx Char, RegEx Char)
-> APrism (RegEx Char) (RegEx Char) () ()
-> SepBy (p () ())
-> p (RegEx Char) (RegEx Char)
-> p (RegEx Char) (RegEx Char)
forall (p :: * -> * -> *) a b.
Alternator p =>
(forall x. x -> Either x x)
-> APartialIso a b (a, a) (b, b)
-> APrism a b () ()
-> SepBy (p () ())
-> p a b
-> p a b
chain x -> Either x x
forall x. x -> Either x x
forall a b. a -> Either a b
Left APartialIso
  (RegEx Char)
  (RegEx Char)
  (RegEx Char, RegEx Char)
  (RegEx Char, RegEx Char)
forall token (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (RegEx token, RegEx token) (f (RegEx token, RegEx token))
-> p (RegEx token) (f (RegEx token))
_Sequence APrism (RegEx Char) (RegEx Char) () ()
forall token (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p () (f ()) -> p (RegEx token) (f (RegEx token))
_SeqEmpty SepBy (p () ())
forall (p :: * -> *). Applicative p => SepBy (p ())
noSep (p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
exprG p (RegEx Char) (RegEx Char)
rex)

    exprG :: p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
exprG p (RegEx Char) (RegEx Char)
rex = [Char]
-> p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"expression" (p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char))
-> p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
forall a b. (a -> b) -> a -> b
$ [p (RegEx Char) (RegEx Char)] -> p (RegEx Char) (RegEx Char)
forall (f :: * -> *) (p :: * -> *) a.
(Foldable f, Alternative p) =>
f (p a) -> p a
choice
      [ Market
  (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char))
-> Market
     (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char))
forall token (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (RegEx token) (f (RegEx token))
-> p (RegEx token) (f (RegEx token))
_KleeneOpt (Market
   (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char))
 -> Market
      (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char)))
-> p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
atomG p (RegEx Char) (RegEx Char)
rex p (RegEx Char) (RegEx Char)
-> p () () -> p (RegEx Char) (RegEx Char)
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"?"
      , Market
  (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char))
-> Market
     (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char))
forall token (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (RegEx token) (f (RegEx token))
-> p (RegEx token) (f (RegEx token))
_KleeneStar (Market
   (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char))
 -> Market
      (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char)))
-> p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
atomG p (RegEx Char) (RegEx Char)
rex p (RegEx Char) (RegEx Char)
-> p () () -> p (RegEx Char) (RegEx Char)
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"*"
      , Market
  (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char))
-> Market
     (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char))
forall token (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (RegEx token) (f (RegEx token))
-> p (RegEx token) (f (RegEx token))
_KleenePlus (Market
   (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char))
 -> Market
      (RegEx Char) (RegEx Char) (RegEx Char) (Identity (RegEx Char)))
-> p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
atomG p (RegEx Char) (RegEx Char)
rex p (RegEx Char) (RegEx Char)
-> p () () -> p (RegEx Char) (RegEx Char)
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"+"
      , p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
atomG p (RegEx Char) (RegEx Char)
rex
      ]

    atomG :: p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
atomG p (RegEx Char) (RegEx Char)
rex = [Char]
-> p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"atom" (p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char))
-> p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
forall a b. (a -> b) -> a -> b
$ [p (RegEx Char) (RegEx Char)] -> p (RegEx Char) (RegEx Char)
forall (f :: * -> *) (p :: * -> *) a.
(Foldable f, Alternative p) =>
f (p a) -> p a
choice
      [ Market [Char] [Char] [Char] (Identity [Char])
-> Market [Char] [Char] (RegEx Char) (Identity (RegEx Char))
forall token (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p [Char] (f [Char]) -> p (RegEx token) (f (RegEx token))
_NonTerminal (Market [Char] [Char] [Char] (Identity [Char])
 -> Market [Char] [Char] (RegEx Char) (Identity (RegEx Char)))
-> p [Char] [Char] -> p (RegEx Char) (RegEx Char)
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"\\q" p () () -> p [Char] [Char] -> p [Char] [Char]
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p [Char] [Char]
Grammar Char [Char]
nonterminalG
      , Market
  (RegExam Char (RegEx Char))
  (RegExam Char (RegEx Char))
  (RegExam Char (RegEx Char))
  (Identity (RegExam Char (RegEx Char)))
-> Market
     (RegExam Char (RegEx Char))
     (RegExam Char (RegEx Char))
     (RegEx Char)
     (Identity (RegEx Char))
forall token (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (RegExam token (RegEx token)) (f (RegExam token (RegEx token)))
-> p (RegEx token) (f (RegEx token))
_RegExam (Market
   (RegExam Char (RegEx Char))
   (RegExam Char (RegEx Char))
   (RegExam Char (RegEx Char))
   (Identity (RegExam Char (RegEx Char)))
 -> Market
      (RegExam Char (RegEx Char))
      (RegExam Char (RegEx Char))
      (RegEx Char)
      (Identity (RegEx Char)))
-> p (RegExam Char (RegEx Char)) (RegExam Char (RegEx Char))
-> p (RegEx Char) (RegEx Char)
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? p (RegExam Char (RegEx Char)) (RegExam Char (RegEx Char))
classG
      , [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"(" p () ()
-> p (RegEx Char) (RegEx Char) -> p (RegEx Char) (RegEx Char)
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p (RegEx Char) (RegEx Char)
rex p (RegEx Char) (RegEx Char)
-> p () () -> p (RegEx Char) (RegEx Char)
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
")"
      ]

    categoryG :: p GeneralCategory GeneralCategory
categoryG = [Char]
-> p GeneralCategory GeneralCategory
-> p GeneralCategory GeneralCategory
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"category" (p GeneralCategory GeneralCategory
 -> p GeneralCategory GeneralCategory)
-> p GeneralCategory GeneralCategory
-> p GeneralCategory GeneralCategory
forall a b. (a -> b) -> a -> b
$ [p GeneralCategory GeneralCategory]
-> p GeneralCategory GeneralCategory
forall (f :: * -> *) (p :: * -> *) a.
(Foldable f, Alternative p) =>
f (p a) -> p a
choice
      [ Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_LowercaseLetter (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Ll"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_UppercaseLetter (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Lu"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_TitlecaseLetter (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Lt"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_ModifierLetter (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Lm"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_OtherLetter (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Lo"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_NonSpacingMark (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Mn"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_SpacingCombiningMark (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Mc"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_EnclosingMark (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Me"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_DecimalNumber (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Nd"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_LetterNumber (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Nl"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_OtherNumber (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"No"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_ConnectorPunctuation (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Pc"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_DashPunctuation (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Pd"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_OpenPunctuation (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Ps"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_ClosePunctuation (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Pe"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_InitialQuote (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Pi"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_FinalQuote (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Pf"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_OtherPunctuation (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Po"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_MathSymbol (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Sm"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_CurrencySymbol (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Sc"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_ModifierSymbol (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Sk"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_OtherSymbol (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"So"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_Space (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Zs"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_LineSeparator (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Zl"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_ParagraphSeparator (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Zp"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_Control (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Cc"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_Format (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Cf"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_Surrogate (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Cs"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_PrivateUse (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Co"
      , Market () () () (Identity ())
-> Market () () GeneralCategory (Identity GeneralCategory)
Prism' GeneralCategory ()
_NotAssigned (Market () () () (Identity ())
 -> Market () () GeneralCategory (Identity GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"Cn"
      ]

    classG :: p (RegExam Char (RegEx Char)) (RegExam Char (RegEx Char))
classG = [Char]
-> p (RegExam Char (RegEx Char)) (RegExam Char (RegEx Char))
-> p (RegExam Char (RegEx Char)) (RegExam Char (RegEx Char))
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"class" (p (RegExam Char (RegEx Char)) (RegExam Char (RegEx Char))
 -> p (RegExam Char (RegEx Char)) (RegExam Char (RegEx Char)))
-> p (RegExam Char (RegEx Char)) (RegExam Char (RegEx Char))
-> p (RegExam Char (RegEx Char)) (RegExam Char (RegEx Char))
forall a b. (a -> b) -> a -> b
$ [p (RegExam Char (RegEx Char)) (RegExam Char (RegEx Char))]
-> p (RegExam Char (RegEx Char)) (RegExam Char (RegEx Char))
forall (f :: * -> *) (p :: * -> *) a.
(Foldable f, Alternative p) =>
f (p a) -> p a
choice
      [ Market (Set Char) (Set Char) (Set Char) (Identity (Set Char))
-> Market
     (Set Char)
     (Set Char)
     (RegExam Char (RegEx Char))
     (Identity (RegExam Char (RegEx Char)))
forall token alg (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Set token) (f (Set token))
-> p (RegExam token alg) (f (RegExam token alg))
_OneOf (Market (Set Char) (Set Char) (Set Char) (Identity (Set Char))
 -> Market
      (Set Char)
      (Set Char)
      (RegExam Char (RegEx Char))
      (Identity (RegExam Char (RegEx Char))))
-> p (Set Char) (Set Char)
-> p (RegExam Char (RegEx Char)) (RegExam Char (RegEx Char))
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? p (Set Char) (Set Char)
classOneOfG
      , Market
  (Set Char, CategoryTest Char)
  (Set Char, CategoryTest Char)
  (Set Char, CategoryTest Char)
  (Identity (Set Char, CategoryTest Char))
-> Market
     (Set Char, CategoryTest Char)
     (Set Char, CategoryTest Char)
     (RegExam Char (RegEx Char))
     (Identity (RegExam Char (RegEx Char)))
forall token alg (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Set token, CategoryTest token)
  (f (Set token, CategoryTest token))
-> p (RegExam token alg) (f (RegExam token alg))
_NotOneOf (Market
   (Set Char, CategoryTest Char)
   (Set Char, CategoryTest Char)
   (Set Char, CategoryTest Char)
   (Identity (Set Char, CategoryTest Char))
 -> Market
      (Set Char, CategoryTest Char)
      (Set Char, CategoryTest Char)
      (RegExam Char (RegEx Char))
      (Identity (RegExam Char (RegEx Char))))
-> p (Set Char, CategoryTest Char) (Set Char, CategoryTest Char)
-> p (RegExam Char (RegEx Char)) (RegExam Char (RegEx Char))
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? p (Set Char, CategoryTest Char) (Set Char, CategoryTest Char)
classNotOneOfG
      ]

    classCatG :: p (CategoryTest Char) (CategoryTest Char)
classCatG = [Char]
-> p (CategoryTest Char) (CategoryTest Char)
-> p (CategoryTest Char) (CategoryTest Char)
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"class-category" (p (CategoryTest Char) (CategoryTest Char)
 -> p (CategoryTest Char) (CategoryTest Char))
-> p (CategoryTest Char) (CategoryTest Char)
-> p (CategoryTest Char) (CategoryTest Char)
forall a b. (a -> b) -> a -> b
$ [p (CategoryTest Char) (CategoryTest Char)]
-> p (CategoryTest Char) (CategoryTest Char)
forall (f :: * -> *) (p :: * -> *) a.
(Foldable f, Alternative p) =>
f (p a) -> p a
choice
      [ Market
  (Categorize Char)
  (Categorize Char)
  (Categorize Char)
  (Identity (Categorize Char))
-> Market
     (Categorize Char)
     (Categorize Char)
     (CategoryTest Char)
     (Identity (CategoryTest Char))
forall token (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Categorize token) (f (Categorize token))
-> p (CategoryTest token) (f (CategoryTest token))
_AndAsIn (Market
   (Categorize Char)
   (Categorize Char)
   (Categorize Char)
   (Identity (Categorize Char))
 -> Market
      (Categorize Char)
      (Categorize Char)
      (CategoryTest Char)
      (Identity (CategoryTest Char)))
-> p (Categorize Char) (Categorize Char)
-> p (CategoryTest Char) (CategoryTest Char)
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"\\p{" p () ()
-> p GeneralCategory GeneralCategory
-> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p GeneralCategory GeneralCategory
categoryG p GeneralCategory GeneralCategory
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"}"
      , Market
  (Set (Categorize Char))
  (Set (Categorize Char))
  (Set (Categorize Char))
  (Identity (Set (Categorize Char)))
-> Market
     (Set (Categorize Char))
     (Set (Categorize Char))
     (CategoryTest Char)
     (Identity (CategoryTest Char))
forall token (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Set (Categorize token)) (f (Set (Categorize token)))
-> p (CategoryTest token) (f (CategoryTest token))
_AndNotAsIn (Market
   (Set (Categorize Char))
   (Set (Categorize Char))
   (Set (Categorize Char))
   (Identity (Set (Categorize Char)))
 -> Market
      (Set (Categorize Char))
      (Set (Categorize Char))
      (CategoryTest Char)
      (Identity (CategoryTest Char)))
-> p (Set (Categorize Char)) (Set (Categorize Char))
-> p (CategoryTest Char) (CategoryTest Char)
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? SepBy (p () ())
-> p (Item (Set (Categorize Char))) (Item (Set (Categorize Char)))
-> p (Set (Categorize Char)) (Set (Categorize Char))
forall s t (p :: * -> * -> *).
(IsList s, IsList t, Distributor p, Choice p) =>
SepBy (p () ()) -> p (Item s) (Item t) -> p s t
several1
          ([Char] -> SepBy (p () ())
forall (p :: * -> *) c.
(Applicative p, TerminalSymbol c (p ())) =>
[c] -> SepBy (p ())
sepWith [Char]
"|" SepBy (p () ())
-> (SepBy (p () ()) -> SepBy (p () ())) -> SepBy (p () ())
forall a b. a -> (a -> b) -> b
& [Char] -> SepBy (p () ()) -> SepBy (p () ())
forall c p. TerminalSymbol c p => [c] -> SepBy p -> SepBy p
beginWith [Char]
"\\P{" SepBy (p () ())
-> (SepBy (p () ()) -> SepBy (p () ())) -> SepBy (p () ())
forall a b. a -> (a -> b) -> b
& [Char] -> SepBy (p () ()) -> SepBy (p () ())
forall c p. TerminalSymbol c p => [c] -> SepBy p -> SepBy p
endWith [Char]
"}")
          p GeneralCategory GeneralCategory
p (Item (Set (Categorize Char))) (Item (Set (Categorize Char)))
categoryG
      ]

    classOneOfG :: p (Set Char) (Set Char)
classOneOfG = [Char] -> p (Set Char) (Set Char) -> p (Set Char) (Set Char)
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"class-one-of" (p (Set Char) (Set Char) -> p (Set Char) (Set Char))
-> p (Set Char) (Set Char) -> p (Set Char) (Set Char)
forall a b. (a -> b) -> a -> b
$ [p (Set Char) (Set Char)] -> p (Set Char) (Set Char)
forall (f :: * -> *) (p :: * -> *) a.
(Foldable f, Alternative p) =>
f (p a) -> p a
choice
      [ p (Item (Set Char)) (Item (Set Char)) -> p (Set Char) (Set Char)
forall (p :: * -> * -> *) s.
(Monoidal p, Choice p, IsList s) =>
p (Item s) (Item s) -> p s s
onlyOne p Char Char
p (Item (Set Char)) (Item (Set Char))
Grammar Char Char
charG
      , [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"[" p () () -> p (Set Char) (Set Char) -> p (Set Char) (Set Char)
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* SepBy (p () ())
-> p (Item (Set Char)) (Item (Set Char)) -> p (Set Char) (Set Char)
forall s t (p :: * -> * -> *).
(IsList s, IsList t, Distributor p) =>
SepBy (p () ()) -> p (Item s) (Item t) -> p s t
several SepBy (p () ())
forall (p :: * -> *). Applicative p => SepBy (p ())
noSep p Char Char
p (Item (Set Char)) (Item (Set Char))
Grammar Char Char
charG p (Set Char) (Set Char) -> p () () -> p (Set Char) (Set Char)
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"]"
      ]

    classNotOneOfG :: p (Set Char, CategoryTest Char) (Set Char, CategoryTest Char)
classNotOneOfG = [Char]
-> p (Set Char, CategoryTest Char) (Set Char, CategoryTest Char)
-> p (Set Char, CategoryTest Char) (Set Char, CategoryTest Char)
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"class-not-one-of" (p (Set Char, CategoryTest Char) (Set Char, CategoryTest Char)
 -> p (Set Char, CategoryTest Char) (Set Char, CategoryTest Char))
-> p (Set Char, CategoryTest Char) (Set Char, CategoryTest Char)
-> p (Set Char, CategoryTest Char) (Set Char, CategoryTest Char)
forall a b. (a -> b) -> a -> b
$ [p (Set Char, CategoryTest Char) (Set Char, CategoryTest Char)]
-> p (Set Char, CategoryTest Char) (Set Char, CategoryTest Char)
forall (f :: * -> *) (p :: * -> *) a.
(Foldable f, Alternative p) =>
f (p a) -> p a
choice
      [ p (Set Char) (Set Char)
forall s (p :: * -> * -> *).
(AsEmpty s, Monoidal p, Choice p) =>
p s s
asEmpty p (Set Char) (Set Char)
-> p (CategoryTest Char) (CategoryTest Char)
-> p (Set Char, CategoryTest Char) (Set Char, CategoryTest Char)
forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
>*< p (CategoryTest Char) (CategoryTest Char)
classCatG
      , [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"[^" p () () -> p (Set Char) (Set Char) -> p (Set Char) (Set Char)
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* SepBy (p () ())
-> p (Item (Set Char)) (Item (Set Char)) -> p (Set Char) (Set Char)
forall s t (p :: * -> * -> *).
(IsList s, IsList t, Distributor p) =>
SepBy (p () ()) -> p (Item s) (Item t) -> p s t
several SepBy (p () ())
forall (p :: * -> *). Applicative p => SepBy (p ())
noSep p Char Char
p (Item (Set Char)) (Item (Set Char))
Grammar Char Char
charG p (Set Char) (Set Char)
-> p (CategoryTest Char) (CategoryTest Char)
-> p (Set Char, CategoryTest Char) (Set Char, CategoryTest Char)
forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
>*<
          APrism (CategoryTest Char) (CategoryTest Char) () ()
-> p (CategoryTest Char) (CategoryTest Char)
-> p (CategoryTest Char) (CategoryTest Char)
forall a b. APrism a b () () -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Alternator p =>
APrism a b () () -> p a b -> p a b
optionP (Market
  () () (Set (Categorize Char)) (Identity (Set (Categorize Char)))
-> Market () () (CategoryTest Char) (Identity (CategoryTest Char))
forall token (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Set (Categorize token)) (f (Set (Categorize token)))
-> p (CategoryTest token) (f (CategoryTest token))
_AndNotAsIn (Market
   () () (Set (Categorize Char)) (Identity (Set (Categorize Char)))
 -> Market () () (CategoryTest Char) (Identity (CategoryTest Char)))
-> (Market () () () (Identity ())
    -> Market
         () () (Set (Categorize Char)) (Identity (Set (Categorize Char))))
-> APrism (CategoryTest Char) (CategoryTest Char) () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Market () () () (Identity ())
-> Market
     () () (Set (Categorize Char)) (Identity (Set (Categorize Char)))
forall a. AsEmpty a => Prism' a ()
Prism' (Set (Categorize Char)) ()
_Empty) p (CategoryTest Char) (CategoryTest Char)
classCatG p (CategoryTest Char) (CategoryTest Char)
-> p () () -> p (CategoryTest Char) (CategoryTest Char)
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"]"
      ]

nonterminalG :: Grammar Char String
nonterminalG :: Grammar Char [Char]
nonterminalG = [Char] -> p [Char] [Char] -> p [Char] [Char]
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"nonterminal" (p [Char] [Char] -> p [Char] [Char])
-> p [Char] [Char] -> p [Char] [Char]
forall a b. (a -> b) -> a -> b
$
  [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"{" p () () -> p [Char] [Char] -> p [Char] [Char]
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p Char Char -> p [Char] [Char]
forall a b. p a b -> p [a] [b]
forall (p :: * -> * -> *) a b. Distributor p => p a b -> p [a] [b]
manyP p Char Char
Grammar Char Char
charG p [Char] [Char] -> p () () -> p [Char] [Char]
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"}"

charG :: Grammar Char Char
charG :: Grammar Char Char
charG = [Char] -> p Char Char -> p Char Char
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"char" (p Char Char -> p Char Char) -> p Char Char -> p Char Char
forall a b. (a -> b) -> a -> b
$
  TokenClass Char -> p Char Char
forall token p. TokenAlgebra token p => TokenClass token -> p
tokenClass ([Char] -> TokenClass Char
forall token p (f :: * -> *).
(Tokenized token p, Foldable f) =>
f token -> p
forall (f :: * -> *). Foldable f => f Char -> TokenClass Char
notOneOf [Char]
charsReserved TokenClass Char -> TokenClass Char -> TokenClass Char
forall b. BooleanAlgebra b => b -> b -> b
>&&< Categorize Char -> TokenClass Char
forall token p. Tokenized token p => Categorize token -> p
notAsIn GeneralCategory
Categorize Char
Control)
  p Char Char -> p Char Char -> p Char Char
forall a. p Char a -> p Char a -> p Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"\\" p () () -> p Char Char -> p Char Char
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p Char Char
charEscapedG
  where
    charEscapedG :: p Char Char
charEscapedG = [Char] -> p Char Char -> p Char Char
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"char-escaped" (p Char Char -> p Char Char) -> p Char Char -> p Char Char
forall a b. (a -> b) -> a -> b
$
      [Char] -> p Char Char
forall token p (f :: * -> *).
(Tokenized token p, Foldable f) =>
f token -> p
forall (f :: * -> *). Foldable f => f Char -> p Char Char
oneOf [Char]
charsReserved p Char Char -> p Char Char -> p Char Char
forall a. p Char a -> p Char a -> p Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p Char Char
charControlG

    charsReserved :: [Char]
charsReserved = [Char]
"()*+?[\\]^{|}"

    charControlG :: p Char Char
charControlG = [Char] -> p Char Char -> p Char Char
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"char-control" (p Char Char -> p Char Char) -> p Char Char -> p Char Char
forall a b. (a -> b) -> a -> b
$ [p Char Char] -> p Char Char
forall (f :: * -> *) (p :: * -> *) a.
(Foldable f, Alternative p) =>
f (p a) -> p a
choice
      [ Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\NUL' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"NUL"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\SOH' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"SOH"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\STX' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"STX"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\ETX' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"ETX"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\EOT' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"EOT"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\ENQ' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"ENQ"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\ACK' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"ACK"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\BEL' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"BEL"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\BS' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"BS"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\HT' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"HT"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\LF' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"LF"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\VT' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"VT"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\FF' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"FF"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\CR' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"CR"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\SO' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"SO"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\SI' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"SI"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\DLE' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"DLE"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\DC1' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"DC1"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\DC2' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"DC2"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\DC3' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"DC3"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\DC4' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"DC4"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\NAK' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"NAK"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\SYN' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"SYN"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\ETB' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"ETB"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\CAN' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"CAN"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\EM' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"EM"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\SUB' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"SUB"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\ESC' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"ESC"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\FS' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"FS"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\GS' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"GS"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\RS' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"RS"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\US' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"US"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\DEL' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"DEL"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x80' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"PAD"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x81' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"HOP"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x82' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"BPH"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x83' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"NBH"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x84' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"IND"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x85' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"NEL"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x86' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"SSA"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x87' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"ESA"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x88' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"HTS"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x89' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"HTJ"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x8A' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"VTS"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x8B' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"PLD"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x8C' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"PLU"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x8D' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"RI"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x8E' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"SS2"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x8F' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"SS3"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x90' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"DCS"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x91' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"PU1"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x92' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"PU2"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x93' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"STS"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x94' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"CCH"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x95' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"MW"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x96' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"SPA"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x97' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"EPA"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x98' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"SOS"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x99' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"SGCI"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x9A' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"SCI"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x9B' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"CSI"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x9C' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"ST"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x9D' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"OSC"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x9E' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"PM"
      , Char -> Prism' Char ()
forall a. Eq a => a -> Prism' a ()
only Char
'\x9F' (Market () () () (Identity ())
 -> Market () () Char (Identity Char))
-> p () () -> p Char Char
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"APC"
      ]

{- |
`regbnfGrammar` is a context-free `Grammar` for `RegBnf`s.
That means that it can generate a self-hosted definition.

>>> putStringLn (regbnfG regbnfGrammar)
{start} = \q{regbnf}
{alternate} = \q{sequence}(\|\q{sequence})*
{atom} = \\q\q{nonterminal}|\q{class}|\(\q{regex}\)
{category} = Ll|Lu|Lt|Lm|Lo|Mn|Mc|Me|Nd|Nl|No|Pc|Pd|Ps|Pe|Pi|Pf|Po|Sm|Sc|Sk|So|Zs|Zl|Zp|Cc|Cf|Cs|Co|Cn
{char} = [^\(\)\*\+\?\[\\\]\^\{\|\}\P{Cc}]|\\\q{char-escaped}
{char-control} = NUL|SOH|STX|ETX|EOT|ENQ|ACK|BEL|BS|HT|LF|VT|FF|CR|SO|SI|DLE|DC1|DC2|DC3|DC4|NAK|SYN|ETB|CAN|EM|SUB|ESC|FS|GS|RS|US|DEL|PAD|HOP|BPH|NBH|IND|NEL|SSA|ESA|HTS|HTJ|VTS|PLD|PLU|RI|SS2|SS3|DCS|PU1|PU2|STS|CCH|MW|SPA|EPA|SOS|SGCI|SCI|CSI|ST|OSC|PM|APC
{char-escaped} = [\(\)\*\+\?\[\\\]\^\{\|\}]|\q{char-control}
{class} = \q{class-one-of}|\q{class-not-one-of}
{class-category} = \\p\{\q{category}\}|\\P\{(\q{category}(\|\q{category})*)\}
{class-not-one-of} = \q{class-category}|\[\^\q{char}*(\q{class-category}?\])
{class-one-of} = \q{char}|\[\q{char}*\]
{expression} = \q{atom}\?|\q{atom}\*|\q{atom}\+|\q{atom}
{nonterminal} = \{\q{char}*\}
{regbnf} = \{start\} = \q{regex}(\LF\q{nonterminal}( = )\q{regex})*
{regex} = \q{alternate}
{sequence} = \q{expression}*
-}
regbnfGrammar :: Grammar Char RegBnf
regbnfGrammar :: Grammar Char RegBnf
regbnfGrammar = [Char] -> p RegBnf RegBnf -> p RegBnf RegBnf
forall bnf. BackusNaurForm bnf => [Char] -> bnf -> bnf
rule [Char]
"regbnf" (p RegBnf RegBnf -> p RegBnf RegBnf)
-> p RegBnf RegBnf -> p RegBnf RegBnf
forall a b. (a -> b) -> a -> b
$ Exchange
  (RegString, Set ([Char], RegString))
  (RegString, Set ([Char], RegString))
  (Bnf RegString)
  (Identity (Bnf RegString))
-> Exchange
     (RegString, Set ([Char], RegString))
     (RegString, Set ([Char], RegString))
     RegBnf
     (Identity RegBnf)
Iso' RegBnf (Bnf RegString)
_RegBnf (Exchange
   (RegString, Set ([Char], RegString))
   (RegString, Set ([Char], RegString))
   (Bnf RegString)
   (Identity (Bnf RegString))
 -> Exchange
      (RegString, Set ([Char], RegString))
      (RegString, Set ([Char], RegString))
      RegBnf
      (Identity RegBnf))
-> (Exchange
      (RegString, Set ([Char], RegString))
      (RegString, Set ([Char], RegString))
      (RegString, Set ([Char], RegString))
      (Identity (RegString, Set ([Char], RegString)))
    -> Exchange
         (RegString, Set ([Char], RegString))
         (RegString, Set ([Char], RegString))
         (Bnf RegString)
         (Identity (Bnf RegString)))
-> Exchange
     (RegString, Set ([Char], RegString))
     (RegString, Set ([Char], RegString))
     (RegString, Set ([Char], RegString))
     (Identity (RegString, Set ([Char], RegString)))
-> Exchange
     (RegString, Set ([Char], RegString))
     (RegString, Set ([Char], RegString))
     RegBnf
     (Identity RegBnf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exchange
  (RegString, Set ([Char], RegString))
  (RegString, Set ([Char], RegString))
  (RegString, Set ([Char], RegString))
  (Identity (RegString, Set ([Char], RegString)))
-> Exchange
     (RegString, Set ([Char], RegString))
     (RegString, Set ([Char], RegString))
     (Bnf RegString)
     (Identity (Bnf RegString))
forall rule rule (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (rule, Set ([Char], rule)) (f (rule, Set ([Char], rule)))
-> p (Bnf rule) (f (Bnf rule))
_Bnf (Exchange
   (RegString, Set ([Char], RegString))
   (RegString, Set ([Char], RegString))
   (RegString, Set ([Char], RegString))
   (Identity (RegString, Set ([Char], RegString)))
 -> Exchange
      (RegString, Set ([Char], RegString))
      (RegString, Set ([Char], RegString))
      RegBnf
      (Identity RegBnf))
-> p (RegString, Set ([Char], RegString))
     (RegString, Set ([Char], RegString))
-> p RegBnf RegBnf
forall (p :: * -> * -> *) s t a b.
Profunctor p =>
AnIso s t a b -> p a b -> p s t
>~
  [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"{start} = " p () () -> p RegString RegString -> p RegString RegString
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p RegString RegString
Grammar Char RegString
regexGrammar p RegString RegString
-> p (Set ([Char], RegString)) (Set ([Char], RegString))
-> p (RegString, Set ([Char], RegString))
     (RegString, Set ([Char], RegString))
forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
>*< SepBy (p () ())
-> p (Item (Set ([Char], RegString)))
     (Item (Set ([Char], RegString)))
-> p (Set ([Char], RegString)) (Set ([Char], RegString))
forall s t (p :: * -> * -> *).
(IsList s, IsList t, Distributor p) =>
SepBy (p () ()) -> p (Item s) (Item t) -> p s t
several SepBy (p () ())
forall (p :: * -> *). Applicative p => SepBy (p ())
noSep
    ([Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
"\n" p () () -> p [Char] [Char] -> p [Char] [Char]
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p [Char] [Char]
Grammar Char [Char]
nonterminalG p [Char] [Char] -> p () () -> p [Char] [Char]
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< [Char] -> p () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal [Char]
" = " p [Char] [Char]
-> p RegString RegString
-> p ([Char], RegString) ([Char], RegString)
forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
>*< p RegString RegString
Grammar Char RegString
regexGrammar)


{- | `regstringG` generates a `RegString` from a regular grammar.
Since context-free `Grammar`s and `CtxGrammar`s aren't necessarily regular,
the type system will prevent `regstringG` from being applied to them.
-}
regstringG :: RegGrammar Char a -> RegString
regstringG :: forall a. RegGrammar Char a -> RegString
regstringG RegGrammar Char a
rex = Grammor RegString a a -> RegString
forall k a b. Grammor k a b -> k
runGrammor Grammor RegString a a
RegGrammar Char a
rex

{- | `regbnfG` generates a `RegBnf` from a context-free `Grammar`.
Since `CtxGrammar`s aren't context-free,
the type system will prevent `regbnfG` from being applied to a `CtxGrammar`.
It can apply to a `RegGrammar`.
-}
regbnfG :: Grammar Char a -> RegBnf
regbnfG :: forall a. Grammar Char a -> RegBnf
regbnfG Grammar Char a
bnf = Grammor RegBnf a a -> RegBnf
forall k a b. Grammor k a b -> k
runGrammor Grammor RegBnf a a
Grammar Char a
bnf

{- | Compile a `Grammar` into a `Transducer`.

>>> let regexMachine = transducerG @Char regexGrammar

A transducer is a form of finite state machine,
usable as an intermediary for further generators like
`=~`, `expectNext`, `languageSample`, `parseForest` & `unreachableRules`.

>>> import Test.QuickCheck
>>> let regexLang = languageSample @Char regexMachine
>>> words100 <- generate (take 100 <$> regexLang)
>>> quickCheck (property (all (=~ regexMachine) words100))
+++ OK, passed 1 test.
>>> import Control.Monad.State
>>> import System.Random
>>> let gen = mkStdGen 69
>>> evalState (take 15 <$> regexLang) gen
["","|","\776269","()","[]","\\[","||","|\249908","\770923*","\1008821+","\318904?","\845807|","\477898\1026934","()*","()+"]

>>> import Data.Tree (drawForest)

@>>> let (forest, _) = parseForest regexMachine "xy|z" in putStr (drawForest (map (fmap show) forest))
("regex",0,4,"xy|z")
|
`- ("alternate",0,4,"xy|z")
   |
   +- ("sequence",0,2,"xy")
   |  |
   |  +- ("expression",0,1,"x")
   |  |  |
   |  |  `- ("atom",0,1,"x")
   |  |     |
   |  |     `- ("class",0,1,"x")
   |  |        |
   |  |        `- ("class-one-of",0,1,"x")
   |  |           |
   |  |           `- ("char",0,1,"x")
   |  |
   |  `- ("expression",1,2,"y")
   |     |
   |     `- ("atom",1,2,"y")
   |        |
   |        `- ("class",1,2,"y")
   |           |
   |           `- ("class-one-of",1,2,"y")
   |              |
   |              `- ("char",1,2,"y")
   |
   `- ("sequence",3,4,"z")
      |
      `- ("expression",3,4,"z")
         |
         `- ("atom",3,4,"z")
            |
            `- ("class",3,4,"z")
               |
               `- ("class-one-of",3,4,"z")
                  |
                  `- ("char",3,4,"z")
@

-}
transducerG :: Categorized token => Grammar token a -> Transducer token
transducerG :: forall token a.
Categorized token =>
Grammar token a -> Transducer token
transducerG Grammar token a
bnf = Bnf (RegEx token) -> Transducer token
forall token. Bnf (RegEx token) -> Transducer token
transducer (Grammor (Bnf (RegEx token)) a a -> Bnf (RegEx token)
forall k a b. Grammor k a b -> k
runGrammor Grammor (Bnf (RegEx token)) a a
Grammar token a
bnf)

{- | `printG` generates a printer from a `CtxGrammar`.
Since both `RegGrammar`s and context-free `Grammar`s are `CtxGrammar`s,
the type system will allow `printG` to be applied to them.
Running the printer on a syntax value returns a function
that `cons`es tokens at the beginning of an input string,
from right to left.
-}
printG
  :: Cons string string token token
  => (IsList string, Item string ~ token, Categorized token)
  => (Alternative m, Monad m, Filterable m)
  => CtxGrammar token a
  -> a {- ^ syntax -}
  -> m (string -> string)
printG :: forall string token (m :: * -> *) a.
(Cons string string token token, IsList string,
 Item string ~ token, Categorized token, Alternative m, Monad m,
 Filterable m) =>
CtxGrammar token a -> a -> m (string -> string)
printG CtxGrammar token a
printor = Printor string m a a -> a -> m (string -> string)
forall (f :: * -> *) s a b.
Functor f =>
Printor s f a b -> a -> f (s -> s)
printP Printor string m a a
CtxGrammar token a
printor

{- | `parseG` generates a parser from a @LL(∞)@ `CtxGrammar`.
Since both `RegGrammar`s and context-free `Grammar`s are `CtxGrammar`s,
the type system will allow `parseG` to be applied to them.
Running the parser on an input string value `uncons`es
tokens from the beginning of an input string from left to right,
returning a syntax value and the remaining output string.
-}
parseG
  :: (Cons string string token token, Snoc string string token token)
  => (IsList string, Item string ~ token, Categorized token)
  => (Alternative m, Monad m, Filterable m)
  => CtxGrammar token a
  -> string {- ^ input -}
  -> m (a, string)
parseG :: forall string token (m :: * -> *) a.
(Cons string string token token, Snoc string string token token,
 IsList string, Item string ~ token, Categorized token,
 Alternative m, Monad m, Filterable m) =>
CtxGrammar token a -> string -> m (a, string)
parseG CtxGrammar token a
parsor = Parsor string m a a -> string -> m (a, string)
forall s (f :: * -> *) a b. Parsor s f a b -> s -> f (b, s)
parseP Parsor string m a a
CtxGrammar token a
parsor

{- | `unparseG` generates a printer from a @LL(∞)@ `CtxGrammar`.
Since both `RegGrammar`s and context-free `Grammar`s are `CtxGrammar`s,
the type system will allow `unparseG` to be applied to them.
Running the printer on a syntax value and an input string
`snoc`s tokens at the end of the string, from left to right,
returning the output string.
-}
unparseG
  :: (Cons string string token token, Snoc string string token token)
  => (IsList string, Item string ~ token, Categorized token)
  => (Alternative m, Monad m, Filterable m)
  => CtxGrammar token a
  -> a {- ^ syntax -}
  -> string {- ^ input -}
  -> m string
unparseG :: forall string token (m :: * -> *) a.
(Cons string string token token, Snoc string string token token,
 IsList string, Item string ~ token, Categorized token,
 Alternative m, Monad m, Filterable m) =>
CtxGrammar token a -> a -> string -> m string
unparseG CtxGrammar token a
parsor = Parsor string m a a -> a -> string -> m string
forall (f :: * -> *) s a b.
Functor f =>
Parsor s f a b -> a -> s -> f s
unparseP Parsor string m a a
CtxGrammar token a
parsor

{- | `parsecG` generates a parser from a @LL(1)@ `CtxGrammar`,
with `try` for restoring full @LL(∞)@ lookahead.
Since both `RegGrammar`s and context-free `Grammar`s are `CtxGrammar`s,
the type system will allow `parsecG` to be applied to them.
Running the parser on an input string value `uncons`es
tokens from the beginning of an input string from left to right,
returning `parsecResult` as `Nothing` on failure or `Just`
an output syntax value, with parse failure stored in `parsecFailure`,
and a remaining output `parsecStream`.
-}
parsecG
  :: (Cons string string token token, Snoc string string token token)
  => (Item string ~ token, Categorized token)
  => CtxGrammar token a
  -> string {- ^ input -}
  -> ParsecState string a
parsecG :: forall string token a.
(Cons string string token token, Snoc string string token token,
 Item string ~ token, Categorized token) =>
CtxGrammar token a -> string -> ParsecState string a
parsecG CtxGrammar token a
parsector = Parsector string a a -> string -> ParsecState string a
forall s a b.
Categorized (Item s) =>
Parsector s a b -> s -> ParsecState s b
parsecP Parsector string a a
CtxGrammar token a
parsector

{- | `unparsecG` generates a printer from a @LL(1)@ `CtxGrammar`,
with `try` for restoring full @LL(∞)@ lookahead.
Since both `RegGrammar`s and context-free `Grammar`s are `CtxGrammar`s,
the type system will allow `unparsecG` to be applied to them.
Running the printer on a syntax value and an input string
`snoc`s tokens at the end of the string, from left to right,
returning `parsecResult` as `Nothing` on failure or `Just`
the input syntax value, with print success stored in `parsecStream`.
-}
unparsecG
  :: (Cons string string token token, Snoc string string token token)
  => (Item string ~ token, Categorized token)
  => CtxGrammar token a
  -> a {- ^ syntax -}
  -> string {- ^ input -}
  -> ParsecState string a
unparsecG :: forall string token a.
(Cons string string token token, Snoc string string token token,
 Item string ~ token, Categorized token) =>
CtxGrammar token a -> a -> string -> ParsecState string a
unparsecG CtxGrammar token a
parsector = Parsector string a a -> a -> string -> ParsecState string a
forall s a b.
Categorized (Item s) =>
Parsector s a b -> a -> s -> ParsecState s b
unparsecP Parsector string a a
CtxGrammar token a
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 to use algorithms
that can only parse context-free `Grammar`s.
-}
applicativeG
  :: ( Alternative f
     , TokenAlgebra token (f token)
     , TerminalSymbol token (f ())
     , forall x. BackusNaurForm (f x)
     )
  => Grammar token a -- ^ context-free grammar
  -> f a
applicativeG :: forall (f :: * -> *) token a.
(Alternative f, TokenAlgebra token (f token),
 TerminalSymbol token (f ()), forall x. BackusNaurForm (f x)) =>
Grammar token a -> f a
applicativeG Grammar token a
joker = Joker f a a -> f a
forall {k1} {k2} (g :: k1 -> *) (a :: k2) (b :: k1).
Joker g a b -> g b
runJoker Joker f a a
Grammar token a
joker

{- | Generate a `ReadP` backend from a `CtxGrammar` `Char`. -}
readG :: CtxGrammar Char a -> ReadP a
readG :: forall a. CtxGrammar Char a -> ReadP a
readG CtxGrammar Char a
joker = CtxGrammar Char a -> ReadP a
forall (m :: * -> *) token a.
(MonadTry m, TokenAlgebra token (m token),
 TerminalSymbol token (m ())) =>
CtxGrammar token a -> m a
monadG p a a
CtxGrammar Char a
joker

{- | 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

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 (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
instance Filterable WrapMega where
  catMaybes m = m >>= maybe (fail "unrestricted filtration") pure
instance MonadTry WrapMega where
  try (WrapMega p) = WrapMega (M.try p)

megaparsecG
  :: CtxGrammar Char a
  -> M.Parsec String String a
megaparsecG gram = unwrapMega (monadG gram)
@

-}
monadG
  :: ( MonadTry m
     , TokenAlgebra token (m token)
     , TerminalSymbol token (m ())
     )
  => CtxGrammar token a -- ^ context-sensitive grammar
  -> m a
monadG :: forall (m :: * -> *) token a.
(MonadTry m, TokenAlgebra token (m token),
 TerminalSymbol token (m ())) =>
CtxGrammar token a -> m a
monadG CtxGrammar token a
joker = Joker m a a -> m a
forall {k1} {k2} (g :: k1 -> *) (a :: k2) (b :: k1).
Joker g a b -> g b
runJoker Joker m a a
CtxGrammar token a
joker

{- | `putStringLn` is a utility that generalizes `putStrLn`
to string-like interfaces such as `RegString` and `RegBnf`.
-}
putStringLn :: (IsList string, Item string ~ Char) => string -> IO ()
putStringLn :: forall string.
(IsList string, Item string ~ Char) =>
string -> IO ()
putStringLn = [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (string -> [Char]) -> string -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. string -> [Char]
string -> [Item string]
forall l. IsList l => l -> [Item l]
toList

instance IsList RegString where
  type Item RegString = Char
  fromList :: [Item RegString] -> RegString
fromList
    = RegString -> Maybe RegString -> RegString
forall a. a -> Maybe a -> a
fromMaybe RegString
forall k. KleeneStarAlgebra k => k
zeroK
    (Maybe RegString -> RegString)
-> ([Char] -> Maybe RegString) -> [Char] -> RegString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RegString] -> Maybe RegString
forall a. [a] -> Maybe a
listToMaybe
    ([RegString] -> Maybe RegString)
-> ([Char] -> [RegString]) -> [Char] -> Maybe RegString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RegString, [Char]) -> Maybe RegString)
-> [(RegString, [Char])] -> [RegString]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (RegString, [Char]) -> Maybe RegString
forall {a}. (a, [Char]) -> Maybe a
prsF
    ([(RegString, [Char])] -> [RegString])
-> ([Char] -> [(RegString, [Char])]) -> [Char] -> [RegString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP RegString -> [Char] -> [(RegString, [Char])]
forall a. ReadP a -> ReadS a
readP_to_S (CtxGrammar Char RegString -> ReadP RegString
forall a. CtxGrammar Char a -> ReadP a
readG p RegString RegString
CtxGrammar Char RegString
Grammar Char RegString
regexGrammar)
    where
      prsF :: (a, [Char]) -> Maybe a
prsF (a
rex,[Char]
"") = a -> Maybe a
forall a. a -> Maybe a
Just a
rex
      prsF (a, [Char])
_ = Maybe a
forall a. Maybe a
Nothing
  toList :: RegString -> [Item RegString]
toList
    = [Item RegString]
-> (([Item RegString] -> [Item RegString]) -> [Item RegString])
-> Maybe ([Item RegString] -> [Item RegString])
-> [Item RegString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
[Item RegString]
"[]" (([Item RegString] -> [Item RegString])
-> [Item RegString] -> [Item RegString]
forall a b. (a -> b) -> a -> b
$ [Char]
[Item RegString]
"")
    (Maybe ([Item RegString] -> [Item RegString]) -> [Item RegString])
-> (RegString -> Maybe ([Item RegString] -> [Item RegString]))
-> RegString
-> [Item RegString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printor [Item RegString] Maybe RegString RegString
-> RegString -> Maybe ([Item RegString] -> [Item RegString])
forall (f :: * -> *) s a b.
Functor f =>
Printor s f a b -> a -> f (s -> s)
printP Printor [Item RegString] Maybe RegString RegString
Grammar Char RegString
regexGrammar
instance IsString RegString where
  fromString :: [Char] -> RegString
fromString = [Char] -> RegString
[Item RegString] -> RegString
forall l. IsList l => [Item l] -> l
fromList
instance Show RegString where
  showsPrec :: Int -> RegString -> ShowS
showsPrec Int
precision = Int -> [Item RegString] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precision ([Item RegString] -> ShowS)
-> (RegString -> [Item RegString]) -> RegString -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegString -> [Item RegString]
forall l. IsList l => l -> [Item l]
toList
instance Read RegString where
  readsPrec :: Int -> [Char] -> [(RegString, [Char])]
readsPrec Int
_ [Char]
str = [([Item RegString] -> RegString
forall l. IsList l => [Item l] -> l
fromList [Char]
[Item RegString]
str, [Char]
"")]
instance IsList RegBnf where
  type Item RegBnf = Char
  fromList :: [Item RegBnf] -> RegBnf
fromList
    = RegBnf -> Maybe RegBnf -> RegBnf
forall a. a -> Maybe a -> a
fromMaybe RegBnf
forall k. KleeneStarAlgebra k => k
zeroK
    (Maybe RegBnf -> RegBnf)
-> ([Char] -> Maybe RegBnf) -> [Char] -> RegBnf
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RegBnf] -> Maybe RegBnf
forall a. [a] -> Maybe a
listToMaybe
    ([RegBnf] -> Maybe RegBnf)
-> ([Char] -> [RegBnf]) -> [Char] -> Maybe RegBnf
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RegBnf, [Char]) -> Maybe RegBnf)
-> [(RegBnf, [Char])] -> [RegBnf]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (RegBnf, [Char]) -> Maybe RegBnf
forall {a}. (a, [Char]) -> Maybe a
prsF
    ([(RegBnf, [Char])] -> [RegBnf])
-> ([Char] -> [(RegBnf, [Char])]) -> [Char] -> [RegBnf]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP RegBnf -> [Char] -> [(RegBnf, [Char])]
forall a. ReadP a -> ReadS a
readP_to_S (CtxGrammar Char RegBnf -> ReadP RegBnf
forall a. CtxGrammar Char a -> ReadP a
readG p RegBnf RegBnf
CtxGrammar Char RegBnf
Grammar Char RegBnf
regbnfGrammar)
    where
      prsF :: (a, [Char]) -> Maybe a
prsF (a
regbnf,[Char]
"") = a -> Maybe a
forall a. a -> Maybe a
Just a
regbnf
      prsF (a, [Char])
_ = Maybe a
forall a. Maybe a
Nothing
  toList :: RegBnf -> [Item RegBnf]
toList
    = [Item RegBnf]
-> (([Item RegBnf] -> [Item RegBnf]) -> [Item RegBnf])
-> Maybe ([Item RegBnf] -> [Item RegBnf])
-> [Item RegBnf]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
[Item RegBnf]
"{start} = []" (([Item RegBnf] -> [Item RegBnf]) -> [Item RegBnf] -> [Item RegBnf]
forall a b. (a -> b) -> a -> b
$ [Char]
[Item RegBnf]
"")
    (Maybe ([Item RegBnf] -> [Item RegBnf]) -> [Item RegBnf])
-> (RegBnf -> Maybe ([Item RegBnf] -> [Item RegBnf]))
-> RegBnf
-> [Item RegBnf]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printor [Item RegBnf] Maybe RegBnf RegBnf
-> RegBnf -> Maybe ([Item RegBnf] -> [Item RegBnf])
forall (f :: * -> *) s a b.
Functor f =>
Printor s f a b -> a -> f (s -> s)
printP Printor [Item RegBnf] Maybe RegBnf RegBnf
Grammar Char RegBnf
regbnfGrammar
instance IsString RegBnf where
  fromString :: [Char] -> RegBnf
fromString = [Char] -> RegBnf
[Item RegBnf] -> RegBnf
forall l. IsList l => [Item l] -> l
fromList
instance Show RegBnf where
  showsPrec :: Int -> RegBnf -> ShowS
showsPrec Int
precision = Int -> [Item RegBnf] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precision ([Item RegBnf] -> ShowS)
-> (RegBnf -> [Item RegBnf]) -> RegBnf -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegBnf -> [Item RegBnf]
forall l. IsList l => l -> [Item l]
toList
instance Read RegBnf where
  readsPrec :: Int -> [Char] -> [(RegBnf, [Char])]
readsPrec Int
_ [Char]
str = [([Item RegBnf] -> RegBnf
forall l. IsList l => [Item l] -> l
fromList [Char]
[Item RegBnf]
str, [Char]
"")]