{-|
Module      : Text.Grammar.Distributor
Description : grammars
Copyright   : (C) 2025 - Eitan Chatav
License     : BSD-style (see the file LICENSE)
Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
Stability   : provisional
Portability : non-portable

See Joachim Breitner,
[Showcasing Applicative]
(https://www.joachim-breitner.de/blog/710-Showcasing_Applicative)
for idea to unify grammars.
-}

module Text.Grammar.Distributor
  ( -- * Grammar
    Grammar, Grammarr, Grammatical (..)
    -- * RegEx
  , RegEx (..), regexString, regexGrammar
    -- * Generators
  , genReadS
  , readGrammar
  , genShowS
  , showGrammar
  , genRegEx
  , genGrammar
  , printGrammar
  ) where

import Control.Applicative
import Control.Lens
import Control.Lens.PartialIso
import Data.Char
import Data.Coerce
import Data.Foldable
import Data.Function
import Data.Profunctor
import Data.Profunctor.Distributor
import Data.Set (Set, insert)
import Data.String
import GHC.Generics
import Witherable

{- | `Grammar` is a Backus-Naur form grammar,
extended by regular expressions,
embedded in Haskell.

To see an example of a `Grammar`, look at `regexGrammar`.
-}
type Grammar a = forall p. Grammatical p => p a a

{- | A `Grammarr` is just a function of `Grammar`s,
useful for expressing one in terms of another `Grammar`.
-}
type Grammarr a b = forall p. Grammatical p => p a a -> p b b

{- | The `Grammatical` class extends `Alternator` & `Filtrator`
which gives it Kleene's regular expression combinators. It also has
`rule` and `ruleRec` for defining grammar rules and
recursive grammar rules, i.e. nonterminal expressions. Finally,
terminal expressions can be expressed as string literals since
`Grammatical` also implies `IsString`.

`Control.Lens.Prism.Prism`s and `PartialIso`s can act
on `Grammatical` terms via the `>?<` combinator,
analogously to how constructors act on `Applicative` parsers
with `<$>`.

One can create new "generators" from a `Grammar` by defining
instances of `Grammatical`. For instance, one could create
generators for Parsec style parsers, and use `rule` for
labeling of parse errors.
-}
class
  ( Alternator p
  , Filtrator p
  , Tokenized Char Char p
  , forall t. t ~ p () () => IsString t
  ) => Grammatical p where

    {- | Only characters which are in the given `String`.-}
    inClass :: String -> p Char Char
    inClass String
str = (Char -> Bool) -> p Char Char
forall (p :: * -> * -> *) c.
(Choice p, Cochoice p, Tokenized c c p) =>
(c -> Bool) -> p c c
satisfy ((Char -> Bool) -> p Char Char) -> (Char -> Bool) -> p Char Char
forall a b. (a -> b) -> a -> b
$ \Char
ch -> Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
ch String
str

    {- | Only characters which are not in the given `String`.-}
    notInClass :: String -> p Char Char
    notInClass String
str = (Char -> Bool) -> p Char Char
forall (p :: * -> * -> *) c.
(Choice p, Cochoice p, Tokenized c c p) =>
(c -> Bool) -> p c c
satisfy ((Char -> Bool) -> p Char Char) -> (Char -> Bool) -> p Char Char
forall a b. (a -> b) -> a -> b
$ \Char
ch -> Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Char
ch String
str

    {- | Only characters which are in the given `GeneralCategory`.-}
    inCategory :: GeneralCategory -> p Char Char
    inCategory GeneralCategory
cat = (Char -> Bool) -> p Char Char
forall (p :: * -> * -> *) c.
(Choice p, Cochoice p, Tokenized c c p) =>
(c -> Bool) -> p c c
satisfy ((Char -> Bool) -> p Char Char) -> (Char -> Bool) -> p Char Char
forall a b. (a -> b) -> a -> b
$ \Char
ch -> GeneralCategory
cat GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> GeneralCategory
generalCategory Char
ch

    {- | Only characters which are not in the given `GeneralCategory`.-}
    notInCategory :: GeneralCategory -> p Char Char
    notInCategory GeneralCategory
cat = (Char -> Bool) -> p Char Char
forall (p :: * -> * -> *) c.
(Choice p, Cochoice p, Tokenized c c p) =>
(c -> Bool) -> p c c
satisfy ((Char -> Bool) -> p Char Char) -> (Char -> Bool) -> p Char Char
forall a b. (a -> b) -> a -> b
$ \Char
ch -> GeneralCategory
cat GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> GeneralCategory
generalCategory Char
ch

    {- | A nonterminal rule. -}
    rule :: String -> p a b -> p a b
    rule String
_ = p a b -> p a b
forall a. a -> a
id

    {- | A recursive, nonterminal rule. -}
    ruleRec :: String -> (p a b -> p a b) -> p a b
    ruleRec String
name = String -> p a b -> p a b
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
name (p a b -> p a b)
-> ((p a b -> p a b) -> p a b) -> (p a b -> p a b) -> p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p a b -> p a b) -> p a b
forall a. (a -> a) -> a
fix

instance (Alternative f, Cons s s Char Char)
  => Grammatical (Printor s f)
instance (Monad f, Alternative f, Filterable f, Cons s s Char Char)
  => Grammatical (Parsor s f)

-- RegEx --

{- | A version of regular expressions extended by nonterminals. -}
data RegEx
  = Terminal String -- ^ @abc123etc\\.@
  | Sequence RegEx RegEx -- ^ @xy@
  | Fail -- ^ @\\q@
  | Alternate RegEx RegEx -- ^ @x|y@
  | KleeneOpt RegEx -- ^ @x?@
  | KleeneStar RegEx -- ^ @x*@
  | KleenePlus RegEx -- ^ @x+@
  | AnyChar -- ^ @.@
  | InClass String -- ^ @[abc]@
  | NotInClass String -- ^ @[^abc]@
  | InCategory GeneralCategory -- ^ @\\p{Lu}@
  | NotInCategory GeneralCategory -- ^ @\\P{Ll}@
  | NonTerminal String -- ^ @\\q{rule-name}@
  deriving stock (RegEx -> RegEx -> Bool
(RegEx -> RegEx -> Bool) -> (RegEx -> RegEx -> Bool) -> Eq RegEx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegEx -> RegEx -> Bool
== :: RegEx -> RegEx -> Bool
$c/= :: RegEx -> RegEx -> Bool
/= :: RegEx -> RegEx -> Bool
Eq, Eq RegEx
Eq RegEx =>
(RegEx -> RegEx -> Ordering)
-> (RegEx -> RegEx -> Bool)
-> (RegEx -> RegEx -> Bool)
-> (RegEx -> RegEx -> Bool)
-> (RegEx -> RegEx -> Bool)
-> (RegEx -> RegEx -> RegEx)
-> (RegEx -> RegEx -> RegEx)
-> Ord RegEx
RegEx -> RegEx -> Bool
RegEx -> RegEx -> Ordering
RegEx -> RegEx -> RegEx
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 :: RegEx -> RegEx -> Ordering
compare :: RegEx -> RegEx -> Ordering
$c< :: RegEx -> RegEx -> Bool
< :: RegEx -> RegEx -> Bool
$c<= :: RegEx -> RegEx -> Bool
<= :: RegEx -> RegEx -> Bool
$c> :: RegEx -> RegEx -> Bool
> :: RegEx -> RegEx -> Bool
$c>= :: RegEx -> RegEx -> Bool
>= :: RegEx -> RegEx -> Bool
$cmax :: RegEx -> RegEx -> RegEx
max :: RegEx -> RegEx -> RegEx
$cmin :: RegEx -> RegEx -> RegEx
min :: RegEx -> RegEx -> RegEx
Ord, Int -> RegEx -> ShowS
[RegEx] -> ShowS
RegEx -> String
(Int -> RegEx -> ShowS)
-> (RegEx -> String) -> ([RegEx] -> ShowS) -> Show RegEx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegEx -> ShowS
showsPrec :: Int -> RegEx -> ShowS
$cshow :: RegEx -> String
show :: RegEx -> String
$cshowList :: [RegEx] -> ShowS
showList :: [RegEx] -> ShowS
Show, (forall x. RegEx -> Rep RegEx x)
-> (forall x. Rep RegEx x -> RegEx) -> Generic RegEx
forall x. Rep RegEx x -> RegEx
forall x. RegEx -> Rep RegEx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RegEx -> Rep RegEx x
from :: forall x. RegEx -> Rep RegEx x
$cto :: forall x. Rep RegEx x -> RegEx
to :: forall x. Rep RegEx x -> RegEx
Generic)
makePrisms ''RegEx
makePrisms ''GeneralCategory

{- | The `RegEx` `String`.

>>> let rex = Terminal "xy" `Alternate` KleenePlus (Terminal "z")
>>> putStrLn (regexString rex)
xy|z+
-}
regexString :: RegEx -> String
regexString :: RegEx -> String
regexString RegEx
rex = String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"\\q" ShowS
forall a. a -> a
id (Grammar RegEx -> RegEx -> Maybe String
forall (f :: * -> *) a. Alternative f => Grammar a -> a -> f String
showGrammar p RegEx RegEx
Grammar RegEx
regexGrammar RegEx
rex)

{- | `regexGrammar` provides an important example of a `Grammar`.
Take a look at the source to see its definition.

>>> printGrammar regexGrammar
start = \q{regex}
alternate = \q{sequence}(\|\q{sequence})*
any = \.
atom = \q{nonterminal}|\q{fail}|\q{class-in}|\q{class-not-in}|\q{category-in}|\q{category-not-in}|\q{char}|\q{any}|\q{parenthesized}
category = Ll|Lu|Lt|Lm|Lo|Mn|Mc|Me|Nd|Nl|No|Pc|Pd|Ps|Pe|Pi|Pf|Po|Sm|Sc|Sk|So|Zs|Zl|Zp|Cc|Cf|Cs|Co|Cn
category-in = \\p\{\q{category}\}
category-not-in = \\P\{\q{category}\}
char = \q{char-literal}|\q{char-escaped}
char-escaped = \\[\$\(\)\*\+\.\?\[\\\]\^\{\|\}]
char-literal = [^\$\(\)\*\+\.\?\[\\\]\^\{\|\}]
class-in = \[\q{char}*\]
class-not-in = \[\^\q{char}*\]
expression = \q{terminal}|\q{kleene-optional}|\q{kleene-star}|\q{kleene-plus}|\q{atom}
fail = \\q
kleene-optional = \q{atom}\?
kleene-plus = \q{atom}\+
kleene-star = \q{atom}\*
nonterminal = \\q\{\q{char}*\}
parenthesized = \(\q{regex}\)
regex = \q{alternate}
sequence = \q{expression}*
terminal = \q{char}+

-}
regexGrammar :: Grammar RegEx
regexGrammar :: Grammar RegEx
regexGrammar = String -> (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx
forall a b. String -> (p a b -> p a b) -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> (p a b -> p a b) -> p a b
ruleRec String
"regex" ((p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx)
-> (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$ \p RegEx RegEx
rex -> p RegEx RegEx -> p RegEx RegEx
Grammarr RegEx RegEx
altG p RegEx RegEx
rex

altG :: Grammarr RegEx RegEx
altG :: Grammarr RegEx RegEx
altG p RegEx RegEx
rex = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"alternate" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$
  APartialIso RegEx RegEx (RegEx, RegEx) (RegEx, RegEx)
-> SepBy p -> p RegEx RegEx -> p RegEx RegEx
forall (p :: * -> * -> *) a b.
(Choice p, Cochoice p, Distributor p) =>
APartialIso a b (a, a) (b, b) -> SepBy p -> p a b -> p a b
chainl1 APartialIso RegEx RegEx (RegEx, RegEx) (RegEx, RegEx)
Prism' RegEx (RegEx, RegEx)
_Alternate (p () () -> SepBy p
forall (p :: * -> * -> *). Monoidal p => p () () -> SepBy p
sepBy p () ()
"|") (p RegEx RegEx -> p RegEx RegEx
Grammarr RegEx RegEx
seqG p RegEx RegEx
rex)

anyG :: Grammar RegEx
anyG :: Grammar RegEx
anyG = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"any" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$ PartialExchange () () () (Maybe ())
-> PartialExchange () () RegEx (Maybe RegEx)
Prism' RegEx ()
_AnyChar (PartialExchange () () () (Maybe ())
 -> PartialExchange () () RegEx (Maybe RegEx))
-> p () () -> p RegEx RegEx
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"."

atomG :: Grammarr RegEx RegEx
atomG :: Grammarr RegEx RegEx
atomG p RegEx RegEx
rex = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"atom" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$ (p RegEx RegEx -> p RegEx RegEx -> p RegEx RegEx)
-> p RegEx RegEx -> [p RegEx RegEx] -> p RegEx RegEx
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl p RegEx RegEx -> p RegEx RegEx -> p RegEx RegEx
forall a. p RegEx a -> p RegEx a -> p RegEx a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) p RegEx RegEx
forall a. p RegEx a
forall (f :: * -> *) a. Alternative f => f a
empty
  [ p RegEx RegEx
Grammar RegEx
nonterminalG
  , p RegEx RegEx
Grammar RegEx
failG
  , p RegEx RegEx
Grammar RegEx
classInG
  , p RegEx RegEx
Grammar RegEx
classNotInG
  , p RegEx RegEx
Grammar RegEx
categoryInG
  , p RegEx RegEx
Grammar RegEx
categoryNotInG
  , PartialExchange String String String (Maybe String)
-> PartialExchange String String RegEx (Maybe RegEx)
Prism' RegEx String
_Terminal (PartialExchange String String String (Maybe String)
 -> PartialExchange String String RegEx (Maybe RegEx))
-> p String String -> p RegEx RegEx
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p Char Char
Grammar Char
charG p Char Char -> p String String -> p String String
forall (p :: * -> * -> *) s t a b.
(Monoidal p, Choice p, Cons s t a b) =>
p a b -> p s t -> p s t
>:< String -> p String String
forall a. a -> p String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
  , p RegEx RegEx
Grammar RegEx
anyG
  , p RegEx RegEx -> p RegEx RegEx
Grammarr RegEx RegEx
parenG p RegEx RegEx
rex
  ]

categoryG :: Grammar GeneralCategory
categoryG :: Grammar GeneralCategory
categoryG = String
-> p GeneralCategory GeneralCategory
-> p GeneralCategory GeneralCategory
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"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
 -> p GeneralCategory GeneralCategory)
-> p GeneralCategory GeneralCategory
-> [p GeneralCategory GeneralCategory]
-> p GeneralCategory GeneralCategory
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl p GeneralCategory GeneralCategory
-> p GeneralCategory GeneralCategory
-> p GeneralCategory GeneralCategory
forall a.
p GeneralCategory a -> p GeneralCategory a -> p GeneralCategory a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) p GeneralCategory GeneralCategory
forall a. p GeneralCategory a
forall (f :: * -> *) a. Alternative f => f a
empty
  [ PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_LowercaseLetter (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Ll"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_UppercaseLetter (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Lu"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_TitlecaseLetter (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Lt"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_ModifierLetter (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Lm"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_OtherLetter (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Lo"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_NonSpacingMark (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Mn"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_SpacingCombiningMark (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Mc"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_EnclosingMark (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Me"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_DecimalNumber (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Nd"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_LetterNumber (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Nl"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_OtherNumber (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"No"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_ConnectorPunctuation (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Pc"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_DashPunctuation (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Pd"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_OpenPunctuation (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Ps"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_ClosePunctuation (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Pe"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_InitialQuote (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Pi"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_FinalQuote (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Pf"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_OtherPunctuation (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Po"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_MathSymbol (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Sm"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_CurrencySymbol (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Sc"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_ModifierSymbol (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Sk"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_OtherSymbol (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"So"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_Space (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Zs"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_LineSeparator (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Zl"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_ParagraphSeparator (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Zp"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_Control (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Cc"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_Format (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Cf"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_Surrogate (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Cs"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_PrivateUse (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Co"
  , PartialExchange () () () (Maybe ())
-> PartialExchange () () GeneralCategory (Maybe GeneralCategory)
Prism' GeneralCategory ()
_NotAssigned (PartialExchange () () () (Maybe ())
 -> PartialExchange () () GeneralCategory (Maybe GeneralCategory))
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"Cn"
  ]

categoryInG :: Grammar RegEx
categoryInG :: Grammar RegEx
categoryInG = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"category-in" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$
  PartialExchange
  GeneralCategory
  GeneralCategory
  GeneralCategory
  (Maybe GeneralCategory)
-> PartialExchange
     GeneralCategory GeneralCategory RegEx (Maybe RegEx)
Prism' RegEx GeneralCategory
_InCategory (PartialExchange
   GeneralCategory
   GeneralCategory
   GeneralCategory
   (Maybe GeneralCategory)
 -> PartialExchange
      GeneralCategory GeneralCategory RegEx (Maybe RegEx))
-> p GeneralCategory GeneralCategory -> p RegEx RegEx
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"\\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
Grammar GeneralCategory
categoryG p GeneralCategory GeneralCategory
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< p () ()
"}"

categoryNotInG :: Grammar RegEx
categoryNotInG :: Grammar RegEx
categoryNotInG = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"category-not-in" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$
  PartialExchange
  GeneralCategory
  GeneralCategory
  GeneralCategory
  (Maybe GeneralCategory)
-> PartialExchange
     GeneralCategory GeneralCategory RegEx (Maybe RegEx)
Prism' RegEx GeneralCategory
_NotInCategory (PartialExchange
   GeneralCategory
   GeneralCategory
   GeneralCategory
   (Maybe GeneralCategory)
 -> PartialExchange
      GeneralCategory GeneralCategory RegEx (Maybe RegEx))
-> p GeneralCategory GeneralCategory -> p RegEx RegEx
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"\\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
Grammar GeneralCategory
categoryG p GeneralCategory GeneralCategory
-> p () () -> p GeneralCategory GeneralCategory
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< p () ()
"}"

charG :: Grammar Char
charG :: Grammar Char
charG = String -> p Char Char -> p Char Char
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"char" (p Char Char -> p Char Char) -> p Char Char -> p Char Char
forall a b. (a -> b) -> a -> b
$ p Char Char
Grammar Char
charLiteralG 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
Grammar Char
charEscapedG

charEscapedG :: Grammar Char
charEscapedG :: Grammar Char
charEscapedG = String -> p Char Char -> p Char Char
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"char-escaped" (p Char Char -> p Char Char) -> p Char Char -> p Char Char
forall a b. (a -> b) -> a -> b
$ p () ()
"\\" p () () -> p Char Char -> p Char Char
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* String -> p Char Char
forall (p :: * -> * -> *). Grammatical p => String -> p Char Char
inClass String
charsReserved

charLiteralG :: Grammar Char
charLiteralG :: Grammar Char
charLiteralG = String -> p Char Char -> p Char Char
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"char-literal" (p Char Char -> p Char Char) -> p Char Char -> p Char Char
forall a b. (a -> b) -> a -> b
$ String -> p Char Char
forall (p :: * -> * -> *). Grammatical p => String -> p Char Char
notInClass String
charsReserved

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

classInG :: Grammar RegEx
classInG :: Grammar RegEx
classInG = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"class-in" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$
  PartialExchange String String String (Maybe String)
-> PartialExchange String String RegEx (Maybe RegEx)
Prism' RegEx String
_InClass (PartialExchange String String String (Maybe String)
 -> PartialExchange String String RegEx (Maybe RegEx))
-> p String String -> p RegEx RegEx
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"[" p () () -> p String String -> p String String
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p Char Char -> p String String
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
charG p String String -> p () () -> p String String
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< p () ()
"]"

classNotInG :: Grammar RegEx
classNotInG :: Grammar RegEx
classNotInG = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"class-not-in" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$
  PartialExchange String String String (Maybe String)
-> PartialExchange String String RegEx (Maybe RegEx)
Prism' RegEx String
_NotInClass (PartialExchange String String String (Maybe String)
 -> PartialExchange String String RegEx (Maybe RegEx))
-> p String String -> p RegEx RegEx
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"[^" p () () -> p String String -> p String String
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p Char Char -> p String String
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
charG p String String -> p () () -> p String String
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< p () ()
"]"

exprG :: Grammarr RegEx RegEx
exprG :: Grammarr RegEx RegEx
exprG p RegEx RegEx
rex = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"expression" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$ (p RegEx RegEx -> p RegEx RegEx -> p RegEx RegEx)
-> p RegEx RegEx -> [p RegEx RegEx] -> p RegEx RegEx
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl p RegEx RegEx -> p RegEx RegEx -> p RegEx RegEx
forall a. p RegEx a -> p RegEx a -> p RegEx a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) p RegEx RegEx
forall a. p RegEx a
forall (f :: * -> *) a. Alternative f => f a
empty
  [ p RegEx RegEx
Grammar RegEx
terminalG
  , p RegEx RegEx -> p RegEx RegEx
Grammarr RegEx RegEx
kleeneOptG p RegEx RegEx
rex
  , p RegEx RegEx -> p RegEx RegEx
Grammarr RegEx RegEx
kleeneStarG p RegEx RegEx
rex
  , p RegEx RegEx -> p RegEx RegEx
Grammarr RegEx RegEx
kleenePlusG p RegEx RegEx
rex
  , p RegEx RegEx -> p RegEx RegEx
Grammarr RegEx RegEx
atomG p RegEx RegEx
rex
  ]

failG :: Grammar RegEx
failG :: Grammar RegEx
failG = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"fail" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$ PartialExchange () () () (Maybe ())
-> PartialExchange () () RegEx (Maybe RegEx)
Prism' RegEx ()
_Fail (PartialExchange () () () (Maybe ())
 -> PartialExchange () () RegEx (Maybe RegEx))
-> p () () -> p RegEx RegEx
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"\\q"

nonterminalG :: Grammar RegEx
nonterminalG :: Grammar RegEx
nonterminalG = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"nonterminal" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$
  PartialExchange String String String (Maybe String)
-> PartialExchange String String RegEx (Maybe RegEx)
Prism' RegEx String
_NonTerminal (PartialExchange String String String (Maybe String)
 -> PartialExchange String String RegEx (Maybe RegEx))
-> p String String -> p RegEx RegEx
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
"\\q{" p () () -> p String String -> p String String
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p Char Char -> p String String
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
charG p String String -> p () () -> p String String
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< p () ()
"}"

parenG :: Grammarr RegEx RegEx
parenG :: Grammarr RegEx RegEx
parenG p RegEx RegEx
rex = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"parenthesized" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$
  p () ()
"(" p () () -> p RegEx RegEx -> p RegEx RegEx
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p RegEx RegEx
rex p RegEx RegEx -> p () () -> p RegEx RegEx
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< p () ()
")"

kleeneOptG :: Grammarr RegEx RegEx
kleeneOptG :: Grammarr RegEx RegEx
kleeneOptG p RegEx RegEx
rex = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"kleene-optional" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$
  PartialExchange RegEx RegEx RegEx (Maybe RegEx)
-> PartialExchange RegEx RegEx RegEx (Maybe RegEx)
Prism' RegEx RegEx
_KleeneOpt (PartialExchange RegEx RegEx RegEx (Maybe RegEx)
 -> PartialExchange RegEx RegEx RegEx (Maybe RegEx))
-> p RegEx RegEx -> p RegEx RegEx
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p RegEx RegEx -> p RegEx RegEx
Grammarr RegEx RegEx
atomG p RegEx RegEx
rex p RegEx RegEx -> p () () -> p RegEx RegEx
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< p () ()
"?"

kleeneStarG :: Grammarr RegEx RegEx
kleeneStarG :: Grammarr RegEx RegEx
kleeneStarG p RegEx RegEx
rex = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"kleene-star" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$
  PartialExchange RegEx RegEx RegEx (Maybe RegEx)
-> PartialExchange RegEx RegEx RegEx (Maybe RegEx)
Prism' RegEx RegEx
_KleeneStar (PartialExchange RegEx RegEx RegEx (Maybe RegEx)
 -> PartialExchange RegEx RegEx RegEx (Maybe RegEx))
-> p RegEx RegEx -> p RegEx RegEx
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p RegEx RegEx -> p RegEx RegEx
Grammarr RegEx RegEx
atomG p RegEx RegEx
rex p RegEx RegEx -> p () () -> p RegEx RegEx
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< p () ()
"*"

kleenePlusG :: Grammarr RegEx RegEx
kleenePlusG :: Grammarr RegEx RegEx
kleenePlusG p RegEx RegEx
rex = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"kleene-plus" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$
  PartialExchange RegEx RegEx RegEx (Maybe RegEx)
-> PartialExchange RegEx RegEx RegEx (Maybe RegEx)
Prism' RegEx RegEx
_KleenePlus (PartialExchange RegEx RegEx RegEx (Maybe RegEx)
 -> PartialExchange RegEx RegEx RegEx (Maybe RegEx))
-> p RegEx RegEx -> p RegEx RegEx
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p RegEx RegEx -> p RegEx RegEx
Grammarr RegEx RegEx
atomG p RegEx RegEx
rex p RegEx RegEx -> p () () -> p RegEx RegEx
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< p () ()
"+"

seqG :: Grammarr RegEx RegEx
seqG :: Grammarr RegEx RegEx
seqG p RegEx RegEx
rex = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"sequence" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$
  APartialIso RegEx RegEx (RegEx, RegEx) (RegEx, RegEx)
-> (PartialExchange () () () (Maybe ())
    -> PartialExchange () () RegEx (Maybe RegEx))
-> SepBy p
-> p RegEx RegEx
-> p RegEx RegEx
forall (p :: * -> * -> *) a b.
(Alternator p, Filtrator p) =>
APartialIso a b (a, a) (b, b)
-> APartialIso a b () () -> SepBy p -> p a b -> p a b
chainl APartialIso RegEx RegEx (RegEx, RegEx) (RegEx, RegEx)
Prism' RegEx (RegEx, RegEx)
_Sequence (PartialExchange () () String (Maybe String)
-> PartialExchange () () RegEx (Maybe RegEx)
Prism' RegEx String
_Terminal (PartialExchange () () String (Maybe String)
 -> PartialExchange () () RegEx (Maybe RegEx))
-> (PartialExchange () () () (Maybe ())
    -> PartialExchange () () String (Maybe String))
-> PartialExchange () () () (Maybe ())
-> PartialExchange () () RegEx (Maybe RegEx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialExchange () () () (Maybe ())
-> PartialExchange () () String (Maybe String)
forall a. AsEmpty a => Prism' a ()
Prism' String ()
_Empty) SepBy p
forall (p :: * -> * -> *). Monoidal p => SepBy p
noSep (p RegEx RegEx -> p RegEx RegEx
Grammarr RegEx RegEx
exprG p RegEx RegEx
rex)

terminalG :: Grammar RegEx
terminalG :: Grammar RegEx
terminalG = String -> p RegEx RegEx -> p RegEx RegEx
forall a b. String -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Grammatical p =>
String -> p a b -> p a b
rule String
"terminal" (p RegEx RegEx -> p RegEx RegEx) -> p RegEx RegEx -> p RegEx RegEx
forall a b. (a -> b) -> a -> b
$
  PartialExchange String String String (Maybe String)
-> PartialExchange String String RegEx (Maybe RegEx)
Prism' RegEx String
_Terminal (PartialExchange String String String (Maybe String)
 -> PartialExchange String String RegEx (Maybe RegEx))
-> p String String -> p RegEx RegEx
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p Char Char -> p String String
forall a b. p a b -> p [a] [b]
forall (p :: * -> * -> *) a b. Alternator p => p a b -> p [a] [b]
someP p Char Char
Grammar Char
charG

-- Kleene Star Algebra Operators

(-*-), (|||) :: RegEx -> RegEx -> RegEx

Terminal String
"" -*- :: RegEx -> RegEx -> RegEx
-*- RegEx
rex = RegEx
rex
RegEx
rex -*- Terminal String
"" = RegEx
rex
RegEx
Fail -*- RegEx
_ = RegEx
Fail
RegEx
_ -*- RegEx
Fail = RegEx
Fail
Terminal String
str0 -*- Terminal String
str1 = String -> RegEx
Terminal (String
str0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str1)
KleeneStar RegEx
rex0 -*- RegEx
rex1 | RegEx
rex0 RegEx -> RegEx -> Bool
forall a. Eq a => a -> a -> Bool
== RegEx
rex1 = RegEx -> RegEx
plusK RegEx
rex0
RegEx
rex0 -*- KleeneStar RegEx
rex1 | RegEx
rex0 RegEx -> RegEx -> Bool
forall a. Eq a => a -> a -> Bool
== RegEx
rex1 = RegEx -> RegEx
plusK RegEx
rex0
RegEx
rex0 -*- RegEx
rex1 = RegEx -> RegEx -> RegEx
Sequence RegEx
rex0 RegEx
rex1

KleenePlus RegEx
rex ||| :: RegEx -> RegEx -> RegEx
||| Terminal String
"" = RegEx -> RegEx
starK RegEx
rex
Terminal String
"" ||| KleenePlus RegEx
rex = RegEx -> RegEx
starK RegEx
rex
RegEx
rex ||| Terminal String
"" = RegEx -> RegEx
optK RegEx
rex
Terminal String
"" ||| RegEx
rex = RegEx -> RegEx
optK RegEx
rex
RegEx
rex ||| RegEx
Fail = RegEx
rex
RegEx
Fail ||| RegEx
rex = RegEx
rex
RegEx
rex0 ||| RegEx
rex1 | RegEx
rex0 RegEx -> RegEx -> Bool
forall a. Eq a => a -> a -> Bool
== RegEx
rex1 = RegEx
rex0
RegEx
rex0 ||| RegEx
rex1 = RegEx -> RegEx -> RegEx
Alternate RegEx
rex0 RegEx
rex1

optK, starK, plusK :: RegEx -> RegEx

optK :: RegEx -> RegEx
optK RegEx
Fail = String -> RegEx
Terminal String
""
optK (Terminal String
"") = String -> RegEx
Terminal String
""
optK (KleenePlus RegEx
rex) = RegEx -> RegEx
starK RegEx
rex
optK RegEx
rex = RegEx -> RegEx
KleeneOpt RegEx
rex

starK :: RegEx -> RegEx
starK RegEx
Fail = String -> RegEx
Terminal String
""
starK (Terminal String
"") = String -> RegEx
Terminal String
""
starK RegEx
rex = RegEx -> RegEx
KleeneStar RegEx
rex

plusK :: RegEx -> RegEx
plusK RegEx
Fail = RegEx
Fail
plusK (Terminal String
"") = String -> RegEx
Terminal String
""
plusK RegEx
rex = RegEx -> RegEx
KleenePlus RegEx
rex

-- RegEx generator

newtype DiRegEx a b = DiRegEx RegEx
instance Functor (DiRegEx a) where fmap :: forall a b. (a -> b) -> DiRegEx a a -> DiRegEx a b
fmap = (a -> b) -> DiRegEx a a -> DiRegEx a b
forall b c a. (b -> c) -> DiRegEx a b -> DiRegEx a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
instance Applicative (DiRegEx a) where
  pure :: forall a. a -> DiRegEx a a
pure a
_ = RegEx -> DiRegEx a a
forall a b. RegEx -> DiRegEx a b
DiRegEx (String -> RegEx
Terminal [])
  DiRegEx RegEx
rex1 <*> :: forall a b. DiRegEx a (a -> b) -> DiRegEx a a -> DiRegEx a b
<*> DiRegEx RegEx
rex2 = RegEx -> DiRegEx a b
forall a b. RegEx -> DiRegEx a b
DiRegEx (RegEx
rex1 RegEx -> RegEx -> RegEx
-*- RegEx
rex2)
instance Alternative (DiRegEx a) where
  empty :: forall a. DiRegEx a a
empty = RegEx -> DiRegEx a a
forall a b. RegEx -> DiRegEx a b
DiRegEx RegEx
Fail
  DiRegEx RegEx
rex1 <|> :: forall a. DiRegEx a a -> DiRegEx a a -> DiRegEx a a
<|> DiRegEx RegEx
rex2 = RegEx -> DiRegEx a a
forall a b. RegEx -> DiRegEx a b
DiRegEx (RegEx
rex1 RegEx -> RegEx -> RegEx
||| RegEx
rex2)
  many :: forall a. DiRegEx a a -> DiRegEx a [a]
many (DiRegEx RegEx
rex) = RegEx -> DiRegEx a [a]
forall a b. RegEx -> DiRegEx a b
DiRegEx (RegEx -> RegEx
KleeneStar RegEx
rex)
  some :: forall a. DiRegEx a a -> DiRegEx a [a]
some (DiRegEx RegEx
rex) = RegEx -> DiRegEx a [a]
forall a b. RegEx -> DiRegEx a b
DiRegEx (RegEx -> RegEx
KleenePlus RegEx
rex)
instance Filterable (DiRegEx a) where
  mapMaybe :: forall a b. (a -> Maybe b) -> DiRegEx a a -> DiRegEx a b
mapMaybe a -> Maybe b
_ = DiRegEx a a -> DiRegEx a b
forall a b. Coercible a b => a -> b
coerce
instance Profunctor DiRegEx where
  dimap :: forall a b c d. (a -> b) -> (c -> d) -> DiRegEx b c -> DiRegEx a d
dimap a -> b
_ c -> d
_ = DiRegEx b c -> DiRegEx a d
forall a b. Coercible a b => a -> b
coerce
instance Distributor DiRegEx where
  zeroP :: DiRegEx Void Void
zeroP = RegEx -> DiRegEx Void Void
forall a b. RegEx -> DiRegEx a b
DiRegEx RegEx
Fail
  DiRegEx RegEx
rex1 >+< :: forall a b c d.
DiRegEx a b -> DiRegEx c d -> DiRegEx (Either a c) (Either b d)
>+< DiRegEx RegEx
rex2 = RegEx -> DiRegEx (Either a c) (Either b d)
forall a b. RegEx -> DiRegEx a b
DiRegEx (RegEx
rex1 RegEx -> RegEx -> RegEx
||| RegEx
rex2)
  optionalP :: forall a b. DiRegEx a b -> DiRegEx (Maybe a) (Maybe b)
optionalP (DiRegEx RegEx
rex) = RegEx -> DiRegEx (Maybe a) (Maybe b)
forall a b. RegEx -> DiRegEx a b
DiRegEx (RegEx -> RegEx
optK RegEx
rex)
  manyP :: forall a b. DiRegEx a b -> DiRegEx [a] [b]
manyP (DiRegEx RegEx
rex) = RegEx -> DiRegEx [a] [b]
forall a b. RegEx -> DiRegEx a b
DiRegEx (RegEx -> RegEx
starK RegEx
rex)
instance Choice DiRegEx where
  left' :: forall a b c. DiRegEx a b -> DiRegEx (Either a c) (Either b c)
left' = DiRegEx a b -> DiRegEx (Either a c) (Either b c)
forall a b. Coercible a b => a -> b
coerce
  right' :: forall a b c. DiRegEx a b -> DiRegEx (Either c a) (Either c b)
right' = DiRegEx a b -> DiRegEx (Either c a) (Either c b)
forall a b. Coercible a b => a -> b
coerce
instance Cochoice DiRegEx where
  unleft :: forall a d b. DiRegEx (Either a d) (Either b d) -> DiRegEx a b
unleft = DiRegEx (Either a d) (Either b d) -> DiRegEx a b
forall a b. Coercible a b => a -> b
coerce
  unright :: forall d a b. DiRegEx (Either d a) (Either d b) -> DiRegEx a b
unright = DiRegEx (Either d a) (Either d b) -> DiRegEx a b
forall a b. Coercible a b => a -> b
coerce
instance Alternator DiRegEx where
  someP :: forall a b. DiRegEx a b -> DiRegEx [a] [b]
someP (DiRegEx RegEx
rex) = RegEx -> DiRegEx [a] [b]
forall a b. RegEx -> DiRegEx a b
DiRegEx (RegEx -> RegEx
plusK RegEx
rex)
instance Filtrator DiRegEx
instance IsString (DiRegEx () ()) where
  fromString :: String -> DiRegEx () ()
fromString String
str = RegEx -> DiRegEx () ()
forall a b. RegEx -> DiRegEx a b
DiRegEx (String -> RegEx
Terminal String
str)
instance Tokenized Char Char DiRegEx where
  anyToken :: DiRegEx Char Char
anyToken = RegEx -> DiRegEx Char Char
forall a b. RegEx -> DiRegEx a b
DiRegEx RegEx
AnyChar
instance Grammatical DiRegEx where
  inClass :: String -> DiRegEx Char Char
inClass String
str = RegEx -> DiRegEx Char Char
forall a b. RegEx -> DiRegEx a b
DiRegEx (String -> RegEx
InClass String
str)
  notInClass :: String -> DiRegEx Char Char
notInClass String
str = RegEx -> DiRegEx Char Char
forall a b. RegEx -> DiRegEx a b
DiRegEx (String -> RegEx
NotInClass String
str)
  inCategory :: GeneralCategory -> DiRegEx Char Char
inCategory GeneralCategory
cat = RegEx -> DiRegEx Char Char
forall a b. RegEx -> DiRegEx a b
DiRegEx (GeneralCategory -> RegEx
InCategory GeneralCategory
cat)
  notInCategory :: GeneralCategory -> DiRegEx Char Char
notInCategory GeneralCategory
cat = RegEx -> DiRegEx Char Char
forall a b. RegEx -> DiRegEx a b
DiRegEx (GeneralCategory -> RegEx
NotInCategory GeneralCategory
cat)

-- Grammar generator

data DiGrammar a b = DiGrammar
  { forall a b. DiGrammar a b -> DiRegEx a b
grammarStart :: DiRegEx a b
  , forall a b. DiGrammar a b -> Set (String, RegEx)
grammarRules :: Set (String, RegEx)
  }
instance Functor (DiGrammar a) where fmap :: forall a b. (a -> b) -> DiGrammar a a -> DiGrammar a b
fmap = (a -> b) -> DiGrammar a a -> DiGrammar a b
forall b c a. (b -> c) -> DiGrammar a b -> DiGrammar a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
instance Applicative (DiGrammar a) where
  pure :: forall a. a -> DiGrammar a a
pure a
b = DiRegEx a a -> Set (String, RegEx) -> DiGrammar a a
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar (a -> DiRegEx a a
forall a. a -> DiRegEx a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b) Set (String, RegEx)
forall a. Monoid a => a
mempty
  DiGrammar DiRegEx a (a -> b)
start1 Set (String, RegEx)
rules1 <*> :: forall a b. DiGrammar a (a -> b) -> DiGrammar a a -> DiGrammar a b
<*> DiGrammar DiRegEx a a
start2 Set (String, RegEx)
rules2 =
    DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar (DiRegEx a (a -> b)
start1 DiRegEx a (a -> b) -> DiRegEx a a -> DiRegEx a b
forall a b. DiRegEx a (a -> b) -> DiRegEx a a -> DiRegEx a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DiRegEx a a
start2) (Set (String, RegEx)
rules1 Set (String, RegEx) -> Set (String, RegEx) -> Set (String, RegEx)
forall a. Semigroup a => a -> a -> a
<> Set (String, RegEx)
rules2)
instance Alternative (DiGrammar a) where
  empty :: forall a. DiGrammar a a
empty = DiRegEx a a -> Set (String, RegEx) -> DiGrammar a a
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar DiRegEx a a
forall a. DiRegEx a a
forall (f :: * -> *) a. Alternative f => f a
empty Set (String, RegEx)
forall a. Monoid a => a
mempty
  DiGrammar DiRegEx a a
start1 Set (String, RegEx)
rules1 <|> :: forall a. DiGrammar a a -> DiGrammar a a -> DiGrammar a a
<|> DiGrammar DiRegEx a a
start2 Set (String, RegEx)
rules2 =
    DiRegEx a a -> Set (String, RegEx) -> DiGrammar a a
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar (DiRegEx a a
start1 DiRegEx a a -> DiRegEx a a -> DiRegEx a a
forall a. DiRegEx a a -> DiRegEx a a -> DiRegEx a a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DiRegEx a a
start2) (Set (String, RegEx)
rules1 Set (String, RegEx) -> Set (String, RegEx) -> Set (String, RegEx)
forall a. Semigroup a => a -> a -> a
<> Set (String, RegEx)
rules2)
  many :: forall a. DiGrammar a a -> DiGrammar a [a]
many (DiGrammar DiRegEx a a
start Set (String, RegEx)
rules) = DiRegEx a [a] -> Set (String, RegEx) -> DiGrammar a [a]
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar (DiRegEx a a -> DiRegEx a [a]
forall a. DiRegEx a a -> DiRegEx a [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many DiRegEx a a
start) Set (String, RegEx)
rules
  some :: forall a. DiGrammar a a -> DiGrammar a [a]
some (DiGrammar DiRegEx a a
start Set (String, RegEx)
rules) = DiRegEx a [a] -> Set (String, RegEx) -> DiGrammar a [a]
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar (DiRegEx a a -> DiRegEx a [a]
forall a. DiRegEx a a -> DiRegEx a [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some DiRegEx a a
start) Set (String, RegEx)
rules
instance Filterable (DiGrammar a) where
  mapMaybe :: forall a b. (a -> Maybe b) -> DiGrammar a a -> DiGrammar a b
mapMaybe a -> Maybe b
f (DiGrammar DiRegEx a a
start Set (String, RegEx)
rules) =
    DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar ((a -> Maybe b) -> DiRegEx a a -> DiRegEx a b
forall a b. (a -> Maybe b) -> DiRegEx a a -> DiRegEx a b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f DiRegEx a a
start) Set (String, RegEx)
rules
instance Profunctor DiGrammar where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> DiGrammar b c -> DiGrammar a d
dimap a -> b
f c -> d
g (DiGrammar DiRegEx b c
start Set (String, RegEx)
rules) =
    DiRegEx a d -> Set (String, RegEx) -> DiGrammar a d
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar ((a -> b) -> (c -> d) -> DiRegEx b c -> DiRegEx a d
forall a b c d. (a -> b) -> (c -> d) -> DiRegEx b c -> DiRegEx a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> b
f c -> d
g DiRegEx b c
start) Set (String, RegEx)
rules
instance Distributor DiGrammar where
  zeroP :: DiGrammar Void Void
zeroP = DiRegEx Void Void -> Set (String, RegEx) -> DiGrammar Void Void
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar DiRegEx Void Void
forall (p :: * -> * -> *). Distributor p => p Void Void
zeroP Set (String, RegEx)
forall a. Monoid a => a
mempty
  DiGrammar DiRegEx a b
start1 Set (String, RegEx)
rules1 >+< :: forall a b c d.
DiGrammar a b
-> DiGrammar c d -> DiGrammar (Either a c) (Either b d)
>+< DiGrammar DiRegEx c d
start2 Set (String, RegEx)
rules2 =
    DiRegEx (Either a c) (Either b d)
-> Set (String, RegEx) -> DiGrammar (Either a c) (Either b d)
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar (DiRegEx a b
start1 DiRegEx a b -> DiRegEx c d -> DiRegEx (Either a c) (Either b d)
forall a b c d.
DiRegEx a b -> DiRegEx c d -> DiRegEx (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Distributor p =>
p a b -> p c d -> p (Either a c) (Either b d)
>+< DiRegEx c d
start2) (Set (String, RegEx)
rules1 Set (String, RegEx) -> Set (String, RegEx) -> Set (String, RegEx)
forall a. Semigroup a => a -> a -> a
<> Set (String, RegEx)
rules2)
  optionalP :: forall a b. DiGrammar a b -> DiGrammar (Maybe a) (Maybe b)
optionalP (DiGrammar DiRegEx a b
start Set (String, RegEx)
rules) =
    DiRegEx (Maybe a) (Maybe b)
-> Set (String, RegEx) -> DiGrammar (Maybe a) (Maybe b)
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar (DiRegEx a b -> DiRegEx (Maybe a) (Maybe b)
forall a b. DiRegEx a b -> DiRegEx (Maybe a) (Maybe b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Maybe a) (Maybe b)
optionalP DiRegEx a b
start) Set (String, RegEx)
rules
  manyP :: forall a b. DiGrammar a b -> DiGrammar [a] [b]
manyP (DiGrammar DiRegEx a b
start Set (String, RegEx)
rules) =
    DiRegEx [a] [b] -> Set (String, RegEx) -> DiGrammar [a] [b]
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar (DiRegEx a b -> DiRegEx [a] [b]
forall a b. DiRegEx a b -> DiRegEx [a] [b]
forall (p :: * -> * -> *) a b. Distributor p => p a b -> p [a] [b]
manyP DiRegEx a b
start) Set (String, RegEx)
rules
instance Choice DiGrammar where
  left' :: forall a b c. DiGrammar a b -> DiGrammar (Either a c) (Either b c)
left' = DiGrammar a b -> DiGrammar (Either a c) (Either b c)
forall a b. Coercible a b => a -> b
coerce
  right' :: forall a b c. DiGrammar a b -> DiGrammar (Either c a) (Either c b)
right' = DiGrammar a b -> DiGrammar (Either c a) (Either c b)
forall a b. Coercible a b => a -> b
coerce
instance Cochoice DiGrammar where
  unleft :: forall a d b. DiGrammar (Either a d) (Either b d) -> DiGrammar a b
unleft = DiGrammar (Either a d) (Either b d) -> DiGrammar a b
forall a b. Coercible a b => a -> b
coerce
  unright :: forall d a b. DiGrammar (Either d a) (Either d b) -> DiGrammar a b
unright = DiGrammar (Either d a) (Either d b) -> DiGrammar a b
forall a b. Coercible a b => a -> b
coerce
instance Alternator DiGrammar where
  someP :: forall a b. DiGrammar a b -> DiGrammar [a] [b]
someP (DiGrammar DiRegEx a b
start Set (String, RegEx)
rules) =
    DiRegEx [a] [b] -> Set (String, RegEx) -> DiGrammar [a] [b]
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar (DiRegEx a b -> DiRegEx [a] [b]
forall a b. DiRegEx a b -> DiRegEx [a] [b]
forall (p :: * -> * -> *) a b. Alternator p => p a b -> p [a] [b]
someP DiRegEx a b
start) Set (String, RegEx)
rules
instance Filtrator DiGrammar
instance IsString (DiGrammar () ()) where
  fromString :: String -> DiGrammar () ()
fromString String
str = DiRegEx () () -> Set (String, RegEx) -> DiGrammar () ()
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar (String -> DiRegEx () ()
forall a. IsString a => String -> a
fromString String
str) Set (String, RegEx)
forall a. Monoid a => a
mempty
instance Tokenized Char Char DiGrammar where
  anyToken :: DiGrammar Char Char
anyToken = DiRegEx Char Char -> Set (String, RegEx) -> DiGrammar Char Char
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar DiRegEx Char Char
forall a b (p :: * -> * -> *). Tokenized a b p => p a b
anyToken Set (String, RegEx)
forall a. Monoid a => a
mempty
instance Grammatical DiGrammar where
  inClass :: String -> DiGrammar Char Char
inClass String
str = DiRegEx Char Char -> Set (String, RegEx) -> DiGrammar Char Char
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar (String -> DiRegEx Char Char
forall (p :: * -> * -> *). Grammatical p => String -> p Char Char
inClass String
str) Set (String, RegEx)
forall a. Monoid a => a
mempty
  notInClass :: String -> DiGrammar Char Char
notInClass String
str = DiRegEx Char Char -> Set (String, RegEx) -> DiGrammar Char Char
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar (String -> DiRegEx Char Char
forall (p :: * -> * -> *). Grammatical p => String -> p Char Char
notInClass String
str) Set (String, RegEx)
forall a. Monoid a => a
mempty
  inCategory :: GeneralCategory -> DiGrammar Char Char
inCategory GeneralCategory
str = DiRegEx Char Char -> Set (String, RegEx) -> DiGrammar Char Char
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar (GeneralCategory -> DiRegEx Char Char
forall (p :: * -> * -> *).
Grammatical p =>
GeneralCategory -> p Char Char
inCategory GeneralCategory
str) Set (String, RegEx)
forall a. Monoid a => a
mempty
  rule :: forall a b. String -> DiGrammar a b -> DiGrammar a b
rule String
name DiGrammar a b
gram = 
    let
      start :: DiRegEx a b
start = RegEx -> DiRegEx a b
forall a b. RegEx -> DiRegEx a b
DiRegEx (String -> RegEx
NonTerminal String
name)
      DiRegEx RegEx
newRule = DiGrammar a b -> DiRegEx a b
forall a b. DiGrammar a b -> DiRegEx a b
grammarStart DiGrammar a b
gram
      rules :: Set (String, RegEx)
rules = (String, RegEx) -> Set (String, RegEx) -> Set (String, RegEx)
forall a. Ord a => a -> Set a -> Set a
insert (String
name, RegEx
newRule) (DiGrammar a b -> Set (String, RegEx)
forall a b. DiGrammar a b -> Set (String, RegEx)
grammarRules DiGrammar a b
gram)
    in
      DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar DiRegEx a b
start Set (String, RegEx)
rules
  ruleRec :: forall a b.
String -> (DiGrammar a b -> DiGrammar a b) -> DiGrammar a b
ruleRec String
name DiGrammar a b -> DiGrammar a b
f =
    let
      start :: DiRegEx a b
start = RegEx -> DiRegEx a b
forall a b. RegEx -> DiRegEx a b
DiRegEx (String -> RegEx
NonTerminal String
name)
      gram :: DiGrammar a b
gram = DiGrammar a b -> DiGrammar a b
f (DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar DiRegEx a b
start Set (String, RegEx)
forall a. Monoid a => a
mempty)
      DiRegEx RegEx
newRule = DiGrammar a b -> DiRegEx a b
forall a b. DiGrammar a b -> DiRegEx a b
grammarStart DiGrammar a b
gram
      rules :: Set (String, RegEx)
rules = (String, RegEx) -> Set (String, RegEx) -> Set (String, RegEx)
forall a. Ord a => a -> Set a -> Set a
insert (String
name, RegEx
newRule) (DiGrammar a b -> Set (String, RegEx)
forall a b. DiGrammar a b -> Set (String, RegEx)
grammarRules DiGrammar a b
gram)
    in
      DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
forall a b. DiRegEx a b -> Set (String, RegEx) -> DiGrammar a b
DiGrammar DiRegEx a b
start Set (String, RegEx)
rules

-- Generators --

{- | Generate a `ReadS` from a `Grammar`. -}
genReadS :: Grammar a -> ReadS a
genReadS :: forall a. Grammar a -> ReadS a
genReadS = Parsor String [] a a -> String -> [(a, String)]
Grammar a -> String -> [(a, String)]
forall s (f :: * -> *) a b. Parsor s f a b -> s -> f (b, s)
runParsor

{- | Use a `Grammar` to parse a `String`. -}
readGrammar :: Grammar a -> String -> [a]
readGrammar :: forall a. Grammar a -> String -> [a]
readGrammar Grammar a
grammar String
str =
  [ a
a
  | (a
a, String
remaining) <- Grammar a -> ReadS a
forall a. Grammar a -> ReadS a
genReadS p a a
Grammar a
grammar String
str
  , String
remaining String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== []
  ]

{- | Generate `ShowS`s from a `Grammar`. -}
genShowS :: Alternative f => Grammar a -> a -> f ShowS
genShowS :: forall (f :: * -> *) a. Alternative f => Grammar a -> a -> f ShowS
genShowS = Printor String f a a -> a -> f ShowS
Grammar a -> a -> f ShowS
forall s (f :: * -> *) a b. Printor s f a b -> a -> f (s -> s)
runPrintor

{- | Use a `Grammar` to print `String`s. -}
showGrammar :: Alternative f => Grammar a -> a -> f String
showGrammar :: forall (f :: * -> *) a. Alternative f => Grammar a -> a -> f String
showGrammar Grammar a
grammar a
a = (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"") (ShowS -> String) -> f ShowS -> f String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Grammar a -> a -> f ShowS
forall (f :: * -> *) a. Alternative f => Grammar a -> a -> f ShowS
genShowS p a a
Grammar a
grammar a
a

{- | Generate `RegEx`es from a `Grammar`.
This will infinite loop if you your `Grammar` includes a `ruleRec`,
otherwise it will inline all rules and produce a valid
regular expression.
-}
genRegEx :: Grammar a -> RegEx
genRegEx :: forall a. Grammar a -> RegEx
genRegEx (DiRegEx RegEx
rex) = RegEx
rex

{- | Generate a Backus-Naur form grammar,
extended by regular expressions, from a `Grammar`.
-}
genGrammar :: Grammar a -> [(String, RegEx)]
genGrammar :: forall a. Grammar a -> [(String, RegEx)]
genGrammar (DiGrammar (DiRegEx RegEx
start) Set (String, RegEx)
rules) =
  (String
"start", RegEx
start) (String, RegEx) -> [(String, RegEx)] -> [(String, RegEx)]
forall a. a -> [a] -> [a]
: Set (String, RegEx) -> [(String, RegEx)]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set (String, RegEx)
rules

{- | Print a Backus-Naur form grammar,
extended by regular expressions, from a `Grammar`.
-}
printGrammar :: Grammar a -> IO ()
printGrammar :: forall a. Grammar a -> IO ()
printGrammar Grammar a
gram = [(String, RegEx)] -> ((String, RegEx) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Grammar a -> [(String, RegEx)]
forall a. Grammar a -> [(String, RegEx)]
genGrammar p a a
Grammar a
gram) (((String, RegEx) -> IO ()) -> IO ())
-> ((String, RegEx) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
name_i, RegEx
rule_i) -> do
  String -> IO ()
putStr String
name_i
  String -> IO ()
putStr String
" = "
  String -> IO ()
putStrLn (RegEx -> String
regexString RegEx
rule_i)