{-|
Module      : Data.Profunctor.Grammar
Description : grammar distributors
Copyright   : (C) 2026 - Eitan Chatav
License     : BSD-style (see the file LICENSE)
Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
Stability   : provisional
Portability : non-portable
-}

module Data.Profunctor.Grammar
  ( -- * Parsor
    Parsor (..)
  , unparseP
  , parseP
    -- * Printor
  , Printor (..)
  , printP
    -- * Grammor
  , Grammor (..)
  ) where

import Control.Applicative
import Control.Arrow
import Control.Category
import Control.Lens
import Control.Lens.Extras
import Control.Lens.Grammar.BackusNaur
import Control.Lens.Grammar.Boole
import Control.Lens.Grammar.Kleene
import Control.Lens.Grammar.Symbol
import Control.Lens.Grammar.Token
import Control.Monad
import Data.Coerce
import Data.Monoid
import Data.Profunctor
import Data.Profunctor.Distributor
import Data.Profunctor.Filtrator
import Data.Profunctor.Monoidal
import Data.Void
import Prelude hiding (id, (.))
import GHC.Exts
import Witherable

-- | `Parsor` is a simple invertible parser `Profunctor`.
newtype Parsor s f a b = Parsor {forall s (f :: * -> *) a b.
Parsor s f a b -> Maybe a -> s -> f (b, s)
runParsor :: Maybe a -> s -> f (b,s)}

-- | Run the parser on an input string,
-- `uncons`ing tokens from the beginning of the string,
-- from left to right, returning a value and the remaining string.
parseP :: Parsor s f a b -> s -> f (b,s)
parseP :: forall s (f :: * -> *) a b. Parsor s f a b -> s -> f (b, s)
parseP (Parsor Maybe a -> s -> f (b, s)
f) = Maybe a -> s -> f (b, s)
f Maybe a
forall a. Maybe a
Nothing

-- | Run the parser in reverse on a value and an input string;
-- `snoc`ing tokens at the end of the string, from left to right,
-- and returning the new string.
unparseP :: Functor f => Parsor s f a b -> a -> s -> f s
unparseP :: forall (f :: * -> *) s a b.
Functor f =>
Parsor s f a b -> a -> s -> f s
unparseP (Parsor Maybe a -> s -> f (b, s)
f) a
a = ((b, s) -> s) -> f (b, s) -> f s
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, s) -> s
forall a b. (a, b) -> b
snd (f (b, s) -> f s) -> (s -> f (b, s)) -> s -> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe a -> s -> f (b, s)
f (a -> Maybe a
forall a. a -> Maybe a
Just a
a)

-- | `Printor` is a simple printer `Profunctor`.
newtype Printor s f a b = Printor {forall s (f :: * -> *) a b. Printor s f a b -> a -> f (b, s -> s)
runPrintor :: a -> f (b, s -> s)}

-- | Run the printer on a value, returning a function
-- that `cons`es tokens at the beginning of an input string,
-- from right to left.
printP :: Functor f => Printor s f a b -> a -> f (s -> s)
printP :: forall (f :: * -> *) s a b.
Functor f =>
Printor s f a b -> a -> f (s -> s)
printP (Printor a -> f (b, s -> s)
f) = ((b, s -> s) -> s -> s) -> f (b, s -> s) -> f (s -> s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, s -> s) -> s -> s
forall a b. (a, b) -> b
snd (f (b, s -> s) -> f (s -> s))
-> (a -> f (b, s -> s)) -> a -> f (s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> f (b, s -> s)
f

-- | `Grammor` is a constant `Profunctor`.
newtype Grammor k a b = Grammor {forall k a b. Grammor k a b -> k
runGrammor :: k}

-- Parsor instances
deriving stock instance Functor f => Functor (Parsor s f a)
instance Functor f => Profunctor (Parsor s f) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Parsor s f b c -> Parsor s f a d
dimap a -> b
f c -> d
g = (Maybe a -> s -> f (d, s)) -> Parsor s f a d
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor ((Maybe a -> s -> f (d, s)) -> Parsor s f a d)
-> (Parsor s f b c -> Maybe a -> s -> f (d, s))
-> Parsor s f b c
-> Parsor s f a d
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe a -> Maybe b)
-> ((s -> f (c, s)) -> s -> f (d, s))
-> (Maybe b -> s -> f (c, s))
-> Maybe a
-> s
-> f (d, s)
forall a b c d. (a -> b) -> (c -> d) -> (b -> c) -> a -> d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap ((a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) ((f (c, s) -> f (d, s)) -> (s -> f (c, s)) -> s -> f (d, s)
forall a b. (a -> b) -> (s -> a) -> s -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((c, s) -> (d, s)) -> f (c, s) -> f (d, s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> d) -> (c, s) -> (d, s)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' c -> d
g))) ((Maybe b -> s -> f (c, s)) -> Maybe a -> s -> f (d, s))
-> (Parsor s f b c -> Maybe b -> s -> f (c, s))
-> Parsor s f b c
-> Maybe a
-> s
-> f (d, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parsor s f b c -> Maybe b -> s -> f (c, s)
forall s (f :: * -> *) a b.
Parsor s f a b -> Maybe a -> s -> f (b, s)
runParsor
instance Monad m => Applicative (Parsor s m a) where
  pure :: forall a. a -> Parsor s m a a
pure a
b = (Maybe a -> s -> m (a, s)) -> Parsor s m a a
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor (\Maybe a
_ s
s -> (a, s) -> m (a, s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
b,s
s))
  Parsor Maybe a -> s -> m (a -> b, s)
f <*> :: forall a b.
Parsor s m a (a -> b) -> Parsor s m a a -> Parsor s m a b
<*> Parsor Maybe a -> s -> m (a, s)
x = (Maybe a -> s -> m (b, s)) -> Parsor s m a b
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor ((Maybe a -> s -> m (b, s)) -> Parsor s m a b)
-> (Maybe a -> s -> m (b, s)) -> Parsor s m a b
forall a b. (a -> b) -> a -> b
$ \Maybe a
ma s
s -> do
    (a -> b
g, s
s') <- Maybe a -> s -> m (a -> b, s)
f Maybe a
ma s
s
    (a
a, s
s'') <- Maybe a -> s -> m (a, s)
x Maybe a
ma s
s'
    (b, s) -> m (b, s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
g a
a, s
s'')
instance (Alternative m, Monad m) => Strong (Parsor s m) where
  first' :: forall a b c. Parsor s m a b -> Parsor s m (a, c) (b, c)
first' Parsor s m a b
p = Parsor s m a b
p Parsor s m a b -> Parsor s m c c -> Parsor s m (a, c) (b, c)
forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
>*< Parsor s m c c
forall a. Parsor s m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  second' :: forall a b c. Parsor s m a b -> Parsor s m (c, a) (c, b)
second' Parsor s m a b
p = Parsor s m c c
forall a. Parsor s m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Parsor s m c c -> Parsor s m a b -> Parsor s m (c, a) (c, b)
forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
>*< Parsor s m a b
p
instance Monad m => Monad (Parsor s m a) where
  return :: forall a. a -> Parsor s m a a
return = a -> Parsor s m a a
forall a. a -> Parsor s m a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Parsor Maybe a -> s -> m (a, s)
p >>= :: forall a b.
Parsor s m a a -> (a -> Parsor s m a b) -> Parsor s m a b
>>= a -> Parsor s m a b
f = (Maybe a -> s -> m (b, s)) -> Parsor s m a b
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor ((Maybe a -> s -> m (b, s)) -> Parsor s m a b)
-> (Maybe a -> s -> m (b, s)) -> Parsor s m a b
forall a b. (a -> b) -> a -> b
$ \Maybe a
ma s
s -> do
    (a
a, s
s') <- Maybe a -> s -> m (a, s)
p Maybe a
ma s
s
    Parsor s m a b -> Maybe a -> s -> m (b, s)
forall s (f :: * -> *) a b.
Parsor s f a b -> Maybe a -> s -> f (b, s)
runParsor (a -> Parsor s m a b
f a
a) Maybe a
ma s
s'
instance (Alternative m, Monad m) => Alternative (Parsor s m a) where
  empty :: forall a. Parsor s m a a
empty = (Maybe a -> s -> m (a, s)) -> Parsor s m a a
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor (\Maybe a
_ s
_ -> m (a, s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty)
  Parsor Maybe a -> s -> m (a, s)
p <|> :: forall a. Parsor s m a a -> Parsor s m a a -> Parsor s m a a
<|> Parsor Maybe a -> s -> m (a, s)
q = (Maybe a -> s -> m (a, s)) -> Parsor s m a a
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor ((Maybe a -> s -> m (a, s)) -> Parsor s m a a)
-> (Maybe a -> s -> m (a, s)) -> Parsor s m a a
forall a b. (a -> b) -> a -> b
$ \Maybe a
ma s
s -> Maybe a -> s -> m (a, s)
p Maybe a
ma s
s m (a, s) -> m (a, s) -> m (a, s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a -> s -> m (a, s)
q Maybe a
ma s
s
instance (Alternative m, Monad m) => MonadPlus (Parsor s m a)
instance Filterable f => Filterable (Parsor s f a) where
  mapMaybe :: forall a b. (a -> Maybe b) -> Parsor s f a a -> Parsor s f a b
mapMaybe a -> Maybe b
f (Parsor Maybe a -> s -> f (a, s)
p) = (Maybe a -> s -> f (b, s)) -> Parsor s f a b
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor ((Maybe a -> s -> f (b, s)) -> Parsor s f a b)
-> (Maybe a -> s -> f (b, s)) -> Parsor s f a b
forall a b. (a -> b) -> a -> b
$ \Maybe a
fa s
s ->
    ((a, s) -> Maybe (b, s)) -> f (a, s) -> f (b, s)
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (\(a
a,s
t) -> (b -> (b, s)) -> Maybe b -> Maybe (b, s)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,s
t) (a -> Maybe b
f a
a)) (Maybe a -> s -> f (a, s)
p Maybe a
fa s
s)
instance Filterable f => Cochoice (Parsor s f) where
  unleft :: forall a d b.
Parsor s f (Either a d) (Either b d) -> Parsor s f a b
unleft = (Parsor s f a b, Parsor s f d d) -> Parsor s f a b
forall a b. (a, b) -> a
fst ((Parsor s f a b, Parsor s f d d) -> Parsor s f a b)
-> (Parsor s f (Either a d) (Either b d)
    -> (Parsor s f a b, Parsor s f d d))
-> Parsor s f (Either a d) (Either b d)
-> Parsor s f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parsor s f (Either a d) (Either b d)
-> (Parsor s f a b, Parsor s f d d)
forall a c b d.
Parsor s f (Either a c) (Either b d)
-> (Parsor s f a b, Parsor s f c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate
  unright :: forall d a b.
Parsor s f (Either d a) (Either d b) -> Parsor s f a b
unright = (Parsor s f d d, Parsor s f a b) -> Parsor s f a b
forall a b. (a, b) -> b
snd ((Parsor s f d d, Parsor s f a b) -> Parsor s f a b)
-> (Parsor s f (Either d a) (Either d b)
    -> (Parsor s f d d, Parsor s f a b))
-> Parsor s f (Either d a) (Either d b)
-> Parsor s f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parsor s f (Either d a) (Either d b)
-> (Parsor s f d d, Parsor s f a b)
forall a c b d.
Parsor s f (Either a c) (Either b d)
-> (Parsor s f a b, Parsor s f c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate
instance Filterable f => Filtrator (Parsor s f) where
  filtrate :: forall a c b d.
Parsor s f (Either a c) (Either b d)
-> (Parsor s f a b, Parsor s f c d)
filtrate (Parsor Maybe (Either a c) -> s -> f (Either b d, s)
p) =
    ( (Maybe a -> s -> f (b, s)) -> Parsor s f a b
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor ((Maybe a -> s -> f (b, s)) -> Parsor s f a b)
-> (Maybe a -> s -> f (b, s)) -> Parsor s f a b
forall a b. (a -> b) -> a -> b
$ \Maybe a
ma s
s -> ((Either b d, s) -> Maybe (b, s)) -> f (Either b d, s) -> f (b, s)
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
        (\case{(Left b
b,s
t) -> (b, s) -> Maybe (b, s)
forall a. a -> Maybe a
Just (b
b,s
t); (Either b d, s)
_ -> Maybe (b, s)
forall a. Maybe a
Nothing})
        (Maybe (Either a c) -> s -> f (Either b d, s)
p ((a -> Either a c) -> Maybe a -> Maybe (Either a c)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a c
forall a b. a -> Either a b
Left Maybe a
ma) s
s)
    , (Maybe c -> s -> f (d, s)) -> Parsor s f c d
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor ((Maybe c -> s -> f (d, s)) -> Parsor s f c d)
-> (Maybe c -> s -> f (d, s)) -> Parsor s f c d
forall a b. (a -> b) -> a -> b
$ \Maybe c
ma s
s -> ((Either b d, s) -> Maybe (d, s)) -> f (Either b d, s) -> f (d, s)
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
        (\case{(Right d
b,s
t) -> (d, s) -> Maybe (d, s)
forall a. a -> Maybe a
Just (d
b,s
t); (Either b d, s)
_ -> Maybe (d, s)
forall a. Maybe a
Nothing})
        (Maybe (Either a c) -> s -> f (Either b d, s)
p ((c -> Either a c) -> Maybe c -> Maybe (Either a c)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> Either a c
forall a b. b -> Either a b
Right Maybe c
ma) s
s)
    )
instance (Alternative m, Monad m) => Distributor (Parsor s m)
instance (Alternative m, Monad m) => Choice (Parsor s m) where
  left' :: forall a b c.
Parsor s m a b -> Parsor s m (Either a c) (Either b c)
left' = Either (Parsor s m a b) (Parsor s m c c)
-> Parsor s m (Either a c) (Either b c)
forall a b c d.
Either (Parsor s m a b) (Parsor s m c d)
-> Parsor s m (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate (Either (Parsor s m a b) (Parsor s m c c)
 -> Parsor s m (Either a c) (Either b c))
-> (Parsor s m a b -> Either (Parsor s m a b) (Parsor s m c c))
-> Parsor s m a b
-> Parsor s m (Either a c) (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parsor s m a b -> Either (Parsor s m a b) (Parsor s m c c)
forall a b. a -> Either a b
Left
  right' :: forall a b c.
Parsor s m a b -> Parsor s m (Either c a) (Either c b)
right' = Either (Parsor s m c c) (Parsor s m a b)
-> Parsor s m (Either c a) (Either c b)
forall a b c d.
Either (Parsor s m a b) (Parsor s m c d)
-> Parsor s m (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate (Either (Parsor s m c c) (Parsor s m a b)
 -> Parsor s m (Either c a) (Either c b))
-> (Parsor s m a b -> Either (Parsor s m c c) (Parsor s m a b))
-> Parsor s m a b
-> Parsor s m (Either c a) (Either c b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parsor s m a b -> Either (Parsor s m c c) (Parsor s m a b)
forall a b. b -> Either a b
Right
instance (Alternative m, Monad m) => Alternator (Parsor s m) where
  alternate :: forall a b c d.
Either (Parsor s m a b) (Parsor s m c d)
-> Parsor s m (Either a c) (Either b d)
alternate = \case
    Left (Parsor Maybe a -> s -> m (b, s)
p) -> (Maybe (Either a c) -> s -> m (Either b d, s))
-> Parsor s m (Either a c) (Either b d)
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor ((Maybe (Either a c) -> s -> m (Either b d, s))
 -> Parsor s m (Either a c) (Either b d))
-> (Maybe (Either a c) -> s -> m (Either b d, s))
-> Parsor s m (Either a c) (Either b d)
forall a b. (a -> b) -> a -> b
$ \Maybe (Either a c)
ma s
s -> case Maybe (Either a c)
ma of
      Maybe (Either a c)
Nothing -> ((b, s) -> (Either b d, s)) -> m (b, s) -> m (Either b d, s)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> Either b d) -> (b, s) -> (Either b d, s)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' b -> Either b d
forall a b. a -> Either a b
Left) (Maybe a -> s -> m (b, s)
p Maybe a
forall a. Maybe a
Nothing s
s)
      Just (Left a
a) -> ((b, s) -> (Either b d, s)) -> m (b, s) -> m (Either b d, s)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> Either b d) -> (b, s) -> (Either b d, s)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' b -> Either b d
forall a b. a -> Either a b
Left) (Maybe a -> s -> m (b, s)
p (a -> Maybe a
forall a. a -> Maybe a
Just a
a) s
s)
      Just (Right c
_) -> m (Either b d, s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
    Right (Parsor Maybe c -> s -> m (d, s)
p) -> (Maybe (Either a c) -> s -> m (Either b d, s))
-> Parsor s m (Either a c) (Either b d)
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor ((Maybe (Either a c) -> s -> m (Either b d, s))
 -> Parsor s m (Either a c) (Either b d))
-> (Maybe (Either a c) -> s -> m (Either b d, s))
-> Parsor s m (Either a c) (Either b d)
forall a b. (a -> b) -> a -> b
$ \Maybe (Either a c)
ma s
s -> case Maybe (Either a c)
ma of
      Maybe (Either a c)
Nothing -> ((d, s) -> (Either b d, s)) -> m (d, s) -> m (Either b d, s)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((d -> Either b d) -> (d, s) -> (Either b d, s)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' d -> Either b d
forall a b. b -> Either a b
Right) (Maybe c -> s -> m (d, s)
p Maybe c
forall a. Maybe a
Nothing s
s)
      Just (Right c
a) -> ((d, s) -> (Either b d, s)) -> m (d, s) -> m (Either b d, s)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((d -> Either b d) -> (d, s) -> (Either b d, s)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' d -> Either b d
forall a b. b -> Either a b
Right) (Maybe c -> s -> m (d, s)
p (c -> Maybe c
forall a. a -> Maybe a
Just c
a) s
s)
      Just (Left a
_) -> m (Either b d, s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
instance (Alternative m, Monad m) => Category (Parsor s m) where
  id :: forall a. Parsor s m a a
id = (Maybe a -> s -> m (a, s)) -> Parsor s m a a
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor ((Maybe a -> s -> m (a, s)) -> Parsor s m a a)
-> (Maybe a -> s -> m (a, s)) -> Parsor s m a a
forall a b. (a -> b) -> a -> b
$ \Maybe a
ma s
s -> case Maybe a
ma of
    Maybe a
Nothing -> m (a, s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
    Just a
a  -> (a, s) -> m (a, s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a,s
s)
  Parsor Maybe b -> s -> m (c, s)
q . :: forall b c a. Parsor s m b c -> Parsor s m a b -> Parsor s m a c
. Parsor Maybe a -> s -> m (b, s)
p = (Maybe a -> s -> m (c, s)) -> Parsor s m a c
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor ((Maybe a -> s -> m (c, s)) -> Parsor s m a c)
-> (Maybe a -> s -> m (c, s)) -> Parsor s m a c
forall a b. (a -> b) -> a -> b
$ \Maybe a
ma s
s -> case Maybe a
ma of
    Maybe a
Nothing -> m (c, s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
    Just a
a -> do
      (b
b, s
t) <- Maybe a -> s -> m (b, s)
p (a -> Maybe a
forall a. a -> Maybe a
Just a
a) s
s
      Maybe b -> s -> m (c, s)
q (b -> Maybe b
forall a. a -> Maybe a
Just b
b) s
t
instance (Alternative m, Monad m) => Arrow (Parsor s m) where
  arr :: forall b c. (b -> c) -> Parsor s m b c
arr b -> c
f = (Maybe b -> s -> m (c, s)) -> Parsor s m b c
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor ((Maybe b -> s -> m (c, s)) -> Parsor s m b c)
-> (Maybe b -> s -> m (c, s)) -> Parsor s m b c
forall a b. (a -> b) -> a -> b
$ \Maybe b
ma s
s -> case Maybe b
ma of
    Maybe b
Nothing -> m (c, s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
    Just b
a  -> (c, s) -> m (c, s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> c
f b
a, s
s)
  *** :: forall b c b' c'.
Parsor s m b c -> Parsor s m b' c' -> Parsor s m (b, b') (c, c')
(***) = Parsor s m b c -> Parsor s m b' c' -> Parsor s m (b, b') (c, c')
forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
(>*<)
  first :: forall b c d. Parsor s m b c -> Parsor s m (b, d) (c, d)
first = Parsor s m b c -> Parsor s m (b, d) (c, d)
forall b c d. Parsor s m b c -> Parsor s m (b, d) (c, d)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first'
  second :: forall b c d. Parsor s m b c -> Parsor s m (d, b) (d, c)
second = Parsor s m b c -> Parsor s m (d, b) (d, c)
forall b c d. Parsor s m b c -> Parsor s m (d, b) (d, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (c, a) (c, b)
second'
instance (Alternative m, Monad m) => ArrowZero (Parsor s m) where
  zeroArrow :: forall b c. Parsor s m b c
zeroArrow = Parsor s m b c
forall a. Parsor s m b a
forall (f :: * -> *) a. Alternative f => f a
empty
instance (Alternative m, Monad m) => ArrowPlus (Parsor s m) where
  <+> :: forall b c. Parsor s m b c -> Parsor s m b c -> Parsor s m b c
(<+>) = Parsor s m b c -> Parsor s m b c -> Parsor s m b c
forall a. Parsor s m b a -> Parsor s m b a -> Parsor s m b a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
instance (Alternative m, Monad m) => ArrowChoice (Parsor s m) where
  +++ :: forall b c b' c'.
Parsor s m b c
-> Parsor s m b' c' -> Parsor s m (Either b b') (Either c c')
(+++) = Parsor s m b c
-> Parsor s m b' c' -> Parsor s m (Either b b') (Either c c')
forall b c b' c'.
Parsor s m b c
-> Parsor s m b' c' -> Parsor s m (Either b b') (Either c c')
forall (p :: * -> * -> *) a b c d.
Distributor p =>
p a b -> p c d -> p (Either a c) (Either b d)
(>+<)
  left :: forall b c d.
Parsor s m b c -> Parsor s m (Either b d) (Either c d)
left = Parsor s m b c -> Parsor s m (Either b d) (Either c d)
forall b c d.
Parsor s m b c -> Parsor s m (Either b d) (Either c d)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
left'
  right :: forall b c d.
Parsor s m b c -> Parsor s m (Either d b) (Either d c)
right = Parsor s m b c -> Parsor s m (Either d b) (Either d c)
forall b c d.
Parsor s m b c -> Parsor s m (Either d b) (Either d c)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'
instance
  ( Categorized a, a ~ Item s, IsList s
  , Cons s s a a, Snoc s s a a
  , Filterable m, Alternative m, Monad m
  ) => Tokenized a (Parsor s m a a) where
    anyToken :: Parsor s m a a
anyToken = (Maybe a -> s -> m (a, s)) -> Parsor s m a a
forall s (f :: * -> *) a b.
(Maybe a -> s -> f (b, s)) -> Parsor s f a b
Parsor ((Maybe a -> s -> m (a, s)) -> Parsor s m a a)
-> (Maybe a -> s -> m (a, s)) -> Parsor s m a a
forall a b. (a -> b) -> a -> b
$ (s -> m (a, s)) -> (a -> s -> m (a, s)) -> Maybe a -> s -> m (a, s)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (m (a, s) -> ((a, s) -> m (a, s)) -> Maybe (a, s) -> m (a, s)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (a, s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty (a, s) -> m (a, s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, s) -> m (a, s)) -> (s -> Maybe (a, s)) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> Maybe (a, s)
forall s a. Cons s s a a => s -> Maybe (a, s)
uncons)
      (\a
a -> (a, s) -> m (a, s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, s) -> m (a, s)) -> (s -> (a, s)) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a
a,) (s -> (a, s)) -> (s -> s) -> s -> (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (s -> a -> s) -> a -> s -> s
forall a b c. (a -> b -> c) -> b -> a -> c
flip s -> a -> s
forall s a. Snoc s s a a => s -> a -> s
snoc a
a)
instance
  ( Categorized a, a ~ Item s, IsList s
  , Cons s s a a, Snoc s s a a
  , Filterable m, Alternative m, Monad m
  ) => TokenAlgebra a (Parsor s m a a)
instance
  ( Categorized a, a ~ Item s, IsList s
  , Cons s s a a, Snoc s s a a
  , Filterable m, Alternative m, Monad m
  ) => TerminalSymbol a (Parsor s m () ()) where
instance
  ( Char ~ Item s, IsList s
  , Cons s s Char Char, Snoc s s Char Char
  , Filterable m, Alternative m, Monad m
  ) => IsString (Parsor s m () ()) where
  fromString :: String -> Parsor s m () ()
fromString = String -> Parsor s m () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal
instance
  ( Char ~ Item s, IsList s
  , Cons s s Char Char, Snoc s s Char Char, AsEmpty s
  , Filterable m, Alternative m, Monad m
  ) => IsString (Parsor s m s s) where
  fromString :: String -> Parsor s m s s
fromString = String -> Parsor s m s s
forall (f :: * -> *) a (p :: * -> * -> *) s.
(Foldable f, Tokenized a (p a a), Monoidal p, Choice p, AsEmpty s,
 Cons s s a a) =>
f a -> p s s
tokens
instance BackusNaurForm (Parsor s m a b)
instance (Alternative m, Monad m) => MonadFail (Parsor s m a) where
  fail :: forall a. String -> Parsor s m a a
fail String
_ = Parsor s m a a
forall a. Parsor s m a a
forall (f :: * -> *) a. Alternative f => f a
empty
instance AsEmpty s => Matching s (Parsor s [] a b) where
  s
word =~ :: s -> Parsor s [] a b -> Bool
=~ Parsor s [] a b
p = case
    [ () | (b
_, s
remaining) <- Parsor s [] a b -> Maybe a -> s -> [(b, s)]
forall s (f :: * -> *) a b.
Parsor s f a b -> Maybe a -> s -> f (b, s)
runParsor Parsor s [] a b
p Maybe a
forall a. Maybe a
Nothing s
word
    , APrism s s () () -> s -> Bool
forall s t a b. APrism s t a b -> s -> Bool
is APrism s s () ()
forall a. AsEmpty a => Prism' a ()
Prism' s ()
_Empty s
remaining
    ] of [] -> Bool
False; ()
_:[()]
_ -> Bool
True

-- Printor instances
instance Functor f => Functor (Printor s f a) where
  fmap :: forall a b. (a -> b) -> Printor s f a a -> Printor s f a b
fmap a -> b
f = (a -> f (b, s -> s)) -> Printor s f a b
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor ((a -> f (b, s -> s)) -> Printor s f a b)
-> (Printor s f a a -> a -> f (b, s -> s))
-> Printor s f a a
-> Printor s f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (f (a, s -> s) -> f (b, s -> s))
-> (a -> f (a, s -> s)) -> a -> f (b, s -> s)
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a, s -> s) -> (b, s -> s)) -> f (a, s -> s) -> f (b, s -> s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, s -> s) -> (b, s -> s)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' a -> b
f)) ((a -> f (a, s -> s)) -> a -> f (b, s -> s))
-> (Printor s f a a -> a -> f (a, s -> s))
-> Printor s f a a
-> a
-> f (b, s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Printor s f a a -> a -> f (a, s -> s)
forall s (f :: * -> *) a b. Printor s f a b -> a -> f (b, s -> s)
runPrintor
instance Functor f => Profunctor (Printor s f) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Printor s f b c -> Printor s f a d
dimap a -> b
f c -> d
g = (a -> f (d, s -> s)) -> Printor s f a d
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor ((a -> f (d, s -> s)) -> Printor s f a d)
-> (Printor s f b c -> a -> f (d, s -> s))
-> Printor s f b c
-> Printor s f a d
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b)
-> (f (c, s -> s) -> f (d, s -> s))
-> (b -> f (c, s -> s))
-> a
-> f (d, s -> s)
forall a b c d. (a -> b) -> (c -> d) -> (b -> c) -> a -> d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> b
f (((c, s -> s) -> (d, s -> s)) -> f (c, s -> s) -> f (d, s -> s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> d) -> (c, s -> s) -> (d, s -> s)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' c -> d
g)) ((b -> f (c, s -> s)) -> a -> f (d, s -> s))
-> (Printor s f b c -> b -> f (c, s -> s))
-> Printor s f b c
-> a
-> f (d, s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Printor s f b c -> b -> f (c, s -> s)
forall s (f :: * -> *) a b. Printor s f a b -> a -> f (b, s -> s)
runPrintor
instance Applicative f => Applicative (Printor s f a) where
  pure :: forall a. a -> Printor s f a a
pure a
b = (a -> f (a, s -> s)) -> Printor s f a a
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor (\a
_ -> (a, s -> s) -> f (a, s -> s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
b, s -> s
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id))
  Printor a -> f (a -> b, s -> s)
f <*> :: forall a b.
Printor s f a (a -> b) -> Printor s f a a -> Printor s f a b
<*> Printor a -> f (a, s -> s)
x = (a -> f (b, s -> s)) -> Printor s f a b
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor ((a -> f (b, s -> s)) -> Printor s f a b)
-> (a -> f (b, s -> s)) -> Printor s f a b
forall a b. (a -> b) -> a -> b
$ \a
c ->
    ((a -> b, s -> s) -> (a, s -> s) -> (b, s -> s))
-> f (a -> b, s -> s) -> f (a, s -> s) -> f (b, s -> s)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\(a -> b
g, s -> s
p) (a
a, s -> s
q) -> (a -> b
g a
a, s -> s
p (s -> s) -> (s -> s) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> s
q)) (a -> f (a -> b, s -> s)
f a
c) (a -> f (a, s -> s)
x a
c)
instance Alternative f => Alternative (Printor s f a) where
  empty :: forall a. Printor s f a a
empty = (a -> f (a, s -> s)) -> Printor s f a a
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor (\a
_ -> f (a, s -> s)
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty)
  Printor a -> f (a, s -> s)
p <|> :: forall a. Printor s f a a -> Printor s f a a -> Printor s f a a
<|> Printor a -> f (a, s -> s)
q = (a -> f (a, s -> s)) -> Printor s f a a
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor (\a
a -> a -> f (a, s -> s)
p a
a f (a, s -> s) -> f (a, s -> s) -> f (a, s -> s)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> f (a, s -> s)
q a
a)
instance Filterable f => Filterable (Printor s f a) where
  mapMaybe :: forall a b. (a -> Maybe b) -> Printor s f a a -> Printor s f a b
mapMaybe a -> Maybe b
f (Printor a -> f (a, s -> s)
p) = (a -> f (b, s -> s)) -> Printor s f a b
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor ((a -> f (b, s -> s)) -> Printor s f a b)
-> (a -> f (b, s -> s)) -> Printor s f a b
forall a b. (a -> b) -> a -> b
$
    ((a, s -> s) -> Maybe (b, s -> s))
-> f (a, s -> s) -> f (b, s -> s)
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (\(a
a,s -> s
q) -> (b -> (b, s -> s)) -> Maybe b -> Maybe (b, s -> s)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, s -> s
q) (a -> Maybe b
f a
a)) (f (a, s -> s) -> f (b, s -> s))
-> (a -> f (a, s -> s)) -> a -> f (b, s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> f (a, s -> s)
p
instance Monad f => Monad (Printor s f a) where
  return :: forall a. a -> Printor s f a a
return = a -> Printor s f a a
forall a. a -> Printor s f a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Printor a -> f (a, s -> s)
mx >>= :: forall a b.
Printor s f a a -> (a -> Printor s f a b) -> Printor s f a b
>>= a -> Printor s f a b
f = (a -> f (b, s -> s)) -> Printor s f a b
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor ((a -> f (b, s -> s)) -> Printor s f a b)
-> (a -> f (b, s -> s)) -> Printor s f a b
forall a b. (a -> b) -> a -> b
$ \a
a -> do
    (a
a1,s -> s
g) <- a -> f (a, s -> s)
mx a
a
    (b
b,s -> s
h) <- Printor s f a b -> a -> f (b, s -> s)
forall s (f :: * -> *) a b. Printor s f a b -> a -> f (b, s -> s)
runPrintor (a -> Printor s f a b
f a
a1) a
a
    (b, s -> s) -> f (b, s -> s)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, s -> s
g (s -> s) -> (s -> s) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> s
h)
instance (Alternative f, Monad f) => MonadPlus (Printor s f a)
instance Applicative f => Distributor (Printor s f) where
  zeroP :: Printor s f Void Void
zeroP = (Void -> f (Void, s -> s)) -> Printor s f Void Void
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor Void -> f (Void, s -> s)
forall a. Void -> a
absurd
  Printor a -> f (b, s -> s)
p >+< :: forall a b c d.
Printor s f a b
-> Printor s f c d -> Printor s f (Either a c) (Either b d)
>+< Printor c -> f (d, s -> s)
q = (Either a c -> f (Either b d, s -> s))
-> Printor s f (Either a c) (Either b d)
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor ((Either a c -> f (Either b d, s -> s))
 -> Printor s f (Either a c) (Either b d))
-> (Either a c -> f (Either b d, s -> s))
-> Printor s f (Either a c) (Either b d)
forall a b. (a -> b) -> a -> b
$
    (a -> f (Either b d, s -> s))
-> (c -> f (Either b d, s -> s))
-> Either a c
-> f (Either b d, s -> s)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (((b, s -> s) -> (Either b d, s -> s))
-> f (b, s -> s) -> f (Either b d, s -> s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> Either b d) -> (b, s -> s) -> (Either b d, s -> s)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' b -> Either b d
forall a b. a -> Either a b
Left) (f (b, s -> s) -> f (Either b d, s -> s))
-> (a -> f (b, s -> s)) -> a -> f (Either b d, s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> f (b, s -> s)
p) (((d, s -> s) -> (Either b d, s -> s))
-> f (d, s -> s) -> f (Either b d, s -> s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((d -> Either b d) -> (d, s -> s) -> (Either b d, s -> s)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' d -> Either b d
forall a b. b -> Either a b
Right) (f (d, s -> s) -> f (Either b d, s -> s))
-> (c -> f (d, s -> s)) -> c -> f (Either b d, s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> f (d, s -> s)
q)
instance Alternative f => Alternator (Printor s f) where
  alternate :: forall a b c d.
Either (Printor s f a b) (Printor s f c d)
-> Printor s f (Either a c) (Either b d)
alternate = \case
    Left (Printor a -> f (b, s -> s)
p) -> (Either a c -> f (Either b d, s -> s))
-> Printor s f (Either a c) (Either b d)
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor ((Either a c -> f (Either b d, s -> s))
 -> Printor s f (Either a c) (Either b d))
-> (Either a c -> f (Either b d, s -> s))
-> Printor s f (Either a c) (Either b d)
forall a b. (a -> b) -> a -> b
$
      (a -> f (Either b d, s -> s))
-> (c -> f (Either b d, s -> s))
-> Either a c
-> f (Either b d, s -> s)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (((b, s -> s) -> (Either b d, s -> s))
-> f (b, s -> s) -> f (Either b d, s -> s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> Either b d) -> (b, s -> s) -> (Either b d, s -> s)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' b -> Either b d
forall a b. a -> Either a b
Left) (f (b, s -> s) -> f (Either b d, s -> s))
-> (a -> f (b, s -> s)) -> a -> f (Either b d, s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> f (b, s -> s)
p) (\c
_ -> f (Either b d, s -> s)
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty)
    Right (Printor c -> f (d, s -> s)
p) -> (Either a c -> f (Either b d, s -> s))
-> Printor s f (Either a c) (Either b d)
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor ((Either a c -> f (Either b d, s -> s))
 -> Printor s f (Either a c) (Either b d))
-> (Either a c -> f (Either b d, s -> s))
-> Printor s f (Either a c) (Either b d)
forall a b. (a -> b) -> a -> b
$
      (a -> f (Either b d, s -> s))
-> (c -> f (Either b d, s -> s))
-> Either a c
-> f (Either b d, s -> s)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
_ -> f (Either b d, s -> s)
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty) (((d, s -> s) -> (Either b d, s -> s))
-> f (d, s -> s) -> f (Either b d, s -> s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((d -> Either b d) -> (d, s -> s) -> (Either b d, s -> s)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' d -> Either b d
forall a b. b -> Either a b
Right) (f (d, s -> s) -> f (Either b d, s -> s))
-> (c -> f (d, s -> s)) -> c -> f (Either b d, s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> f (d, s -> s)
p)
instance Filterable f => Filtrator (Printor s f) where
  filtrate :: forall a c b d.
Printor s f (Either a c) (Either b d)
-> (Printor s f a b, Printor s f c d)
filtrate (Printor Either a c -> f (Either b d, s -> s)
p) =
    let
      leftMaybe :: (Either a b, b) -> Maybe (a, b)
leftMaybe = \case
        (Left a
b, b
q) -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
b, b
q)
        (Either a b, b)
_ -> Maybe (a, b)
forall a. Maybe a
Nothing
      rightMaybe :: (Either a a, b) -> Maybe (a, b)
rightMaybe = \case
        (Right a
b, b
q) -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
b, b
q)
        (Either a a, b)
_ -> Maybe (a, b)
forall a. Maybe a
Nothing
    in
      ( (a -> f (b, s -> s)) -> Printor s f a b
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor (((Either b d, s -> s) -> Maybe (b, s -> s))
-> f (Either b d, s -> s) -> f (b, s -> s)
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (Either b d, s -> s) -> Maybe (b, s -> s)
forall {a} {b} {b}. (Either a b, b) -> Maybe (a, b)
leftMaybe (f (Either b d, s -> s) -> f (b, s -> s))
-> (a -> f (Either b d, s -> s)) -> a -> f (b, s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either a c -> f (Either b d, s -> s)
p (Either a c -> f (Either b d, s -> s))
-> (a -> Either a c) -> a -> f (Either b d, s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Either a c
forall a b. a -> Either a b
Left)
      , (c -> f (d, s -> s)) -> Printor s f c d
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor (((Either b d, s -> s) -> Maybe (d, s -> s))
-> f (Either b d, s -> s) -> f (d, s -> s)
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (Either b d, s -> s) -> Maybe (d, s -> s)
forall {a} {a} {b}. (Either a a, b) -> Maybe (a, b)
rightMaybe (f (Either b d, s -> s) -> f (d, s -> s))
-> (c -> f (Either b d, s -> s)) -> c -> f (d, s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either a c -> f (Either b d, s -> s)
p (Either a c -> f (Either b d, s -> s))
-> (c -> Either a c) -> c -> f (Either b d, s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> Either a c
forall a b. b -> Either a b
Right)
      )
instance Alternative f => Choice (Printor s f) where
  left' :: forall a b c.
Printor s f a b -> Printor s f (Either a c) (Either b c)
left' = Either (Printor s f a b) (Printor s f c c)
-> Printor s f (Either a c) (Either b c)
forall a b c d.
Either (Printor s f a b) (Printor s f c d)
-> Printor s f (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate (Either (Printor s f a b) (Printor s f c c)
 -> Printor s f (Either a c) (Either b c))
-> (Printor s f a b -> Either (Printor s f a b) (Printor s f c c))
-> Printor s f a b
-> Printor s f (Either a c) (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Printor s f a b -> Either (Printor s f a b) (Printor s f c c)
forall a b. a -> Either a b
Left
  right' :: forall a b c.
Printor s f a b -> Printor s f (Either c a) (Either c b)
right' = Either (Printor s f c c) (Printor s f a b)
-> Printor s f (Either c a) (Either c b)
forall a b c d.
Either (Printor s f a b) (Printor s f c d)
-> Printor s f (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate (Either (Printor s f c c) (Printor s f a b)
 -> Printor s f (Either c a) (Either c b))
-> (Printor s f a b -> Either (Printor s f c c) (Printor s f a b))
-> Printor s f a b
-> Printor s f (Either c a) (Either c b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Printor s f a b -> Either (Printor s f c c) (Printor s f a b)
forall a b. b -> Either a b
Right
instance Filterable f => Cochoice (Printor s f) where
  unleft :: forall a d b.
Printor s f (Either a d) (Either b d) -> Printor s f a b
unleft = (Printor s f a b, Printor s f d d) -> Printor s f a b
forall a b. (a, b) -> a
fst ((Printor s f a b, Printor s f d d) -> Printor s f a b)
-> (Printor s f (Either a d) (Either b d)
    -> (Printor s f a b, Printor s f d d))
-> Printor s f (Either a d) (Either b d)
-> Printor s f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Printor s f (Either a d) (Either b d)
-> (Printor s f a b, Printor s f d d)
forall a c b d.
Printor s f (Either a c) (Either b d)
-> (Printor s f a b, Printor s f c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate
  unright :: forall d a b.
Printor s f (Either d a) (Either d b) -> Printor s f a b
unright = (Printor s f d d, Printor s f a b) -> Printor s f a b
forall a b. (a, b) -> b
snd ((Printor s f d d, Printor s f a b) -> Printor s f a b)
-> (Printor s f (Either d a) (Either d b)
    -> (Printor s f d d, Printor s f a b))
-> Printor s f (Either d a) (Either d b)
-> Printor s f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Printor s f (Either d a) (Either d b)
-> (Printor s f d d, Printor s f a b)
forall a c b d.
Printor s f (Either a c) (Either b d)
-> (Printor s f a b, Printor s f c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate
instance Functor f => Strong (Printor s f) where
  first' :: forall a b c. Printor s f a b -> Printor s f (a, c) (b, c)
first' (Printor a -> f (b, s -> s)
p) =
    ((a, c) -> f ((b, c), s -> s)) -> Printor s f (a, c) (b, c)
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor (\(a
a,c
c) -> ((b, s -> s) -> ((b, c), s -> s))
-> f (b, s -> s) -> f ((b, c), s -> s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b,s -> s
q) -> ((b
b,c
c),s -> s
q)) (a -> f (b, s -> s)
p a
a))
  second' :: forall a b c. Printor s f a b -> Printor s f (c, a) (c, b)
second' (Printor a -> f (b, s -> s)
p) =
    ((c, a) -> f ((c, b), s -> s)) -> Printor s f (c, a) (c, b)
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor (\(c
c,a
a) -> ((b, s -> s) -> ((c, b), s -> s))
-> f (b, s -> s) -> f ((c, b), s -> s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b,s -> s
q) -> ((c
c,b
b),s -> s
q)) (a -> f (b, s -> s)
p a
a))
instance Monad f => Category (Printor s f) where
  id :: forall a. Printor s f a a
id = (a -> f (a, s -> s)) -> Printor s f a a
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor ((a -> f (a, s -> s)) -> Printor s f a a)
-> (a -> f (a, s -> s)) -> Printor s f a a
forall a b. (a -> b) -> a -> b
$ \a
a -> (a, s -> s) -> f (a, s -> s)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, s -> s
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
  Printor b -> f (c, s -> s)
q . :: forall b c a. Printor s f b c -> Printor s f a b -> Printor s f a c
. Printor a -> f (b, s -> s)
p = (a -> f (c, s -> s)) -> Printor s f a c
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor ((a -> f (c, s -> s)) -> Printor s f a c)
-> (a -> f (c, s -> s)) -> Printor s f a c
forall a b. (a -> b) -> a -> b
$ \a
a -> do
    (b
b, s -> s
p') <- a -> f (b, s -> s)
p a
a
    (c
c, s -> s
q') <- b -> f (c, s -> s)
q b
b
    (c, s -> s) -> f (c, s -> s)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, s -> s
q' (s -> s) -> (s -> s) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> s
p')
instance Monad f => Arrow (Printor s f) where
  arr :: forall b c. (b -> c) -> Printor s f b c
arr b -> c
f = (b -> f (c, s -> s)) -> Printor s f b c
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor ((c, s -> s) -> f (c, s -> s)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return ((c, s -> s) -> f (c, s -> s))
-> (b -> (c, s -> s)) -> b -> f (c, s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (, s -> s
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) (c -> (c, s -> s)) -> (b -> c) -> b -> (c, s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> c
f)
  *** :: forall b c b' c'.
Printor s f b c -> Printor s f b' c' -> Printor s f (b, b') (c, c')
(***) = Printor s f b c -> Printor s f b' c' -> Printor s f (b, b') (c, c')
forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
(>*<)
  first :: forall b c d. Printor s f b c -> Printor s f (b, d) (c, d)
first = Printor s f b c -> Printor s f (b, d) (c, d)
forall b c d. Printor s f b c -> Printor s f (b, d) (c, d)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first'
  second :: forall b c d. Printor s f b c -> Printor s f (d, b) (d, c)
second = Printor s f b c -> Printor s f (d, b) (d, c)
forall b c d. Printor s f b c -> Printor s f (d, b) (d, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (c, a) (c, b)
second'
instance (Alternative f, Monad f) => ArrowZero (Printor s f) where
  zeroArrow :: forall b c. Printor s f b c
zeroArrow = Printor s f b c
forall a. Printor s f b a
forall (f :: * -> *) a. Alternative f => f a
empty
instance (Alternative f, Monad f) => ArrowPlus (Printor s f) where
  <+> :: forall b c. Printor s f b c -> Printor s f b c -> Printor s f b c
(<+>) = Printor s f b c -> Printor s f b c -> Printor s f b c
forall a. Printor s f b a -> Printor s f b a -> Printor s f b a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
instance (Alternative f, Monad f) => ArrowChoice (Printor s f) where
  +++ :: forall b c b' c'.
Printor s f b c
-> Printor s f b' c' -> Printor s f (Either b b') (Either c c')
(+++) = Printor s f b c
-> Printor s f b' c' -> Printor s f (Either b b') (Either c c')
forall b c b' c'.
Printor s f b c
-> Printor s f b' c' -> Printor s f (Either b b') (Either c c')
forall (p :: * -> * -> *) a b c d.
Distributor p =>
p a b -> p c d -> p (Either a c) (Either b d)
(>+<)
  left :: forall b c d.
Printor s f b c -> Printor s f (Either b d) (Either c d)
left = Printor s f b c -> Printor s f (Either b d) (Either c d)
forall b c d.
Printor s f b c -> Printor s f (Either b d) (Either c d)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
left'
  right :: forall b c d.
Printor s f b c -> Printor s f (Either d b) (Either d c)
right = Printor s f b c -> Printor s f (Either d b) (Either d c)
forall b c d.
Printor s f b c -> Printor s f (Either d b) (Either d c)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'
instance
  ( Categorized a, a ~ Item s, IsList s, Cons s s a a
  , Filterable m, Alternative m, Monad m
  ) => Tokenized a (Printor s m a a) where
  anyToken :: Printor s m a a
anyToken = (a -> m (a, s -> s)) -> Printor s m a a
forall s (f :: * -> *) a b. (a -> f (b, s -> s)) -> Printor s f a b
Printor (\a
b -> (a, s -> s) -> m (a, s -> s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
b, a -> s -> s
forall s a. Cons s s a a => a -> s -> s
cons a
b))
instance
  ( Categorized a, a ~ Item s, IsList s, Cons s s a a
  , Filterable m, Alternative m, Monad m
  ) => TokenAlgebra a (Printor s m a a)
instance
  ( Categorized a, a ~ Item s, IsList s, Cons s s a a
  , Filterable m, Alternative m, Monad m
  ) => TerminalSymbol a (Printor s m () ()) where
instance
  ( Char ~ Item s, IsList s, Cons s s Char Char
  , Filterable m, Alternative m, Monad m
  ) => IsString (Printor s m () ()) where
  fromString :: String -> Printor s m () ()
fromString = String -> Printor s m () ()
forall token s. TerminalSymbol token s => [token] -> s
terminal
instance
  ( Char ~ Item s, IsList s, Cons s s Char Char, AsEmpty s
  , Filterable m, Alternative m, Monad m
  ) => IsString (Printor s m s s) where
  fromString :: String -> Printor s m s s
fromString = String -> Printor s m s s
forall (f :: * -> *) a (p :: * -> * -> *) s.
(Foldable f, Tokenized a (p a a), Monoidal p, Choice p, AsEmpty s,
 Cons s s a a) =>
f a -> p s s
tokens
instance BackusNaurForm (Printor s m a b)
instance (Alternative m, Monad m) => MonadFail (Printor s m a) where
  fail :: forall a. String -> Printor s m a a
fail String
_ = Printor s m a a
forall a. Printor s m a a
forall (f :: * -> *) a. Alternative f => f a
empty

-- Grammor instances
instance Functor (Grammor k a) where fmap :: forall a b. (a -> b) -> Grammor k a a -> Grammor k a b
fmap a -> b
_ = Grammor k a a -> Grammor k a b
forall a b. Coercible a b => a -> b
coerce
instance Contravariant (Grammor k a) where contramap :: forall a' a. (a' -> a) -> Grammor k a a -> Grammor k a a'
contramap a' -> a
_ = Grammor k a a -> Grammor k a a'
forall a b. Coercible a b => a -> b
coerce
instance Profunctor (Grammor k) where dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Grammor k b c -> Grammor k a d
dimap a -> b
_ c -> d
_ = Grammor k b c -> Grammor k a d
forall a b. Coercible a b => a -> b
coerce
instance Bifunctor (Grammor k) where bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Grammor k a c -> Grammor k b d
bimap a -> b
_ c -> d
_ = Grammor k a c -> Grammor k b d
forall a b. Coercible a b => a -> b
coerce
instance Choice (Grammor k) where
  left' :: forall a b c. Grammor k a b -> Grammor k (Either a c) (Either b c)
left' = Grammor k a b -> Grammor k (Either a c) (Either b c)
forall a b. Coercible a b => a -> b
coerce
  right' :: forall a b c. Grammor k a b -> Grammor k (Either c a) (Either c b)
right' = Grammor k a b -> Grammor k (Either c a) (Either c b)
forall a b. Coercible a b => a -> b
coerce
instance Monoid k => Applicative (Grammor k a) where
  pure :: forall a. a -> Grammor k a a
pure a
_ = k -> Grammor k a a
forall k a b. k -> Grammor k a b
Grammor k
forall a. Monoid a => a
mempty
  Grammor k
rex1 <*> :: forall a b. Grammor k a (a -> b) -> Grammor k a a -> Grammor k a b
<*> Grammor k
rex2 = k -> Grammor k a b
forall k a b. k -> Grammor k a b
Grammor (k
rex1 k -> k -> k
forall a. Semigroup a => a -> a -> a
<> k
rex2)
instance KleeneStarAlgebra k => Alternative (Grammor k a) where
  empty :: forall a. Grammor k a a
empty = k -> Grammor k a a
forall k a b. k -> Grammor k a b
Grammor k
forall k. KleeneStarAlgebra k => k
zeroK
  Grammor k
rex1 <|> :: forall a. Grammor k a a -> Grammor k a a -> Grammor k a a
<|> Grammor k
rex2 = k -> Grammor k a a
forall k a b. k -> Grammor k a b
Grammor (k
rex1 k -> k -> k
forall k. KleeneStarAlgebra k => k -> k -> k
>|< k
rex2)
  many :: forall a. Grammor k a a -> Grammor k a [a]
many (Grammor k
rex) = k -> Grammor k a [a]
forall k a b. k -> Grammor k a b
Grammor (k -> k
forall k. KleeneStarAlgebra k => k -> k
starK k
rex)
  some :: forall a. Grammor k a a -> Grammor k a [a]
some (Grammor k
rex) = k -> Grammor k a [a]
forall k a b. k -> Grammor k a b
Grammor (k -> k
forall k. KleeneStarAlgebra k => k -> k
plusK k
rex)
instance KleeneStarAlgebra k => Distributor (Grammor k) where
  zeroP :: Grammor k Void Void
zeroP = k -> Grammor k Void Void
forall k a b. k -> Grammor k a b
Grammor k
forall k. KleeneStarAlgebra k => k
zeroK
  Grammor k
rex1 >+< :: forall a b c d.
Grammor k a b
-> Grammor k c d -> Grammor k (Either a c) (Either b d)
>+< Grammor k
rex2 = k -> Grammor k (Either a c) (Either b d)
forall k a b. k -> Grammor k a b
Grammor (k
rex1 k -> k -> k
forall k. KleeneStarAlgebra k => k -> k -> k
>|< k
rex2)
  manyP :: forall a b. Grammor k a b -> Grammor k [a] [b]
manyP (Grammor k
rex) = k -> Grammor k [a] [b]
forall k a b. k -> Grammor k a b
Grammor (k -> k
forall k. KleeneStarAlgebra k => k -> k
starK k
rex)
  optionalP :: forall a b. Grammor k a b -> Grammor k (Maybe a) (Maybe b)
optionalP (Grammor k
rex) = k -> Grammor k (Maybe a) (Maybe b)
forall k a b. k -> Grammor k a b
Grammor (k -> k
forall k. KleeneStarAlgebra k => k -> k
optK k
rex)
instance KleeneStarAlgebra k => Alternator (Grammor k) where
  alternate :: forall a b c d.
Either (Grammor k a b) (Grammor k c d)
-> Grammor k (Either a c) (Either b d)
alternate = (Grammor k a b -> Grammor k (Either a c) (Either b d))
-> (Grammor k c d -> Grammor k (Either a c) (Either b d))
-> Either (Grammor k a b) (Grammor k c d)
-> Grammor k (Either a c) (Either b d)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Grammor k a b -> Grammor k (Either a c) (Either b d)
forall a b. Coercible a b => a -> b
coerce Grammor k c d -> Grammor k (Either a c) (Either b d)
forall a b. Coercible a b => a -> b
coerce
  someP :: forall a b. Grammor k a b -> Grammor k [a] [b]
someP (Grammor k
rex) = k -> Grammor k [a] [b]
forall k a b. k -> Grammor k a b
Grammor (k -> k
forall k. KleeneStarAlgebra k => k -> k
plusK k
rex)
instance Tokenized token k => Tokenized token (Grammor k a b) where
  anyToken :: Grammor k a b
anyToken = k -> Grammor k a b
forall k a b. k -> Grammor k a b
Grammor k
forall token p. Tokenized token p => p
anyToken
  token :: token -> Grammor k a b
token = k -> Grammor k a b
forall k a b. k -> Grammor k a b
Grammor (k -> Grammor k a b) -> (token -> k) -> token -> Grammor k a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. token -> k
forall token p. Tokenized token p => token -> p
token
  oneOf :: forall (f :: * -> *). Foldable f => f token -> Grammor k a b
oneOf = k -> Grammor k a b
forall k a b. k -> Grammor k a b
Grammor (k -> Grammor k a b) -> (f token -> k) -> f token -> Grammor k a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f token -> k
forall token p (f :: * -> *).
(Tokenized token p, Foldable f) =>
f token -> p
forall (f :: * -> *). Foldable f => f token -> k
oneOf
  notOneOf :: forall (f :: * -> *). Foldable f => f token -> Grammor k a b
notOneOf = k -> Grammor k a b
forall k a b. k -> Grammor k a b
Grammor (k -> Grammor k a b) -> (f token -> k) -> f token -> Grammor k a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f token -> k
forall token p (f :: * -> *).
(Tokenized token p, Foldable f) =>
f token -> p
forall (f :: * -> *). Foldable f => f token -> k
notOneOf
  asIn :: Categorize token -> Grammor k a b
asIn = k -> Grammor k a b
forall k a b. k -> Grammor k a b
Grammor (k -> Grammor k a b)
-> (Categorize token -> k) -> Categorize token -> Grammor k a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Categorize token -> k
forall token p. Tokenized token p => Categorize token -> p
asIn
  notAsIn :: Categorize token -> Grammor k a b
notAsIn = k -> Grammor k a b
forall k a b. k -> Grammor k a b
Grammor (k -> Grammor k a b)
-> (Categorize token -> k) -> Categorize token -> Grammor k a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Categorize token -> k
forall token p. Tokenized token p => Categorize token -> p
notAsIn
instance TokenAlgebra a k => TokenAlgebra a (Grammor k a b) where
  tokenClass :: TokenTest a -> Grammor k a b
tokenClass = k -> Grammor k a b
forall k a b. k -> Grammor k a b
Grammor (k -> Grammor k a b)
-> (TokenTest a -> k) -> TokenTest a -> Grammor k a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TokenTest a -> k
forall token p. TokenAlgebra token p => TokenTest token -> p
tokenClass
instance TerminalSymbol token k
  => TerminalSymbol token (Grammor k a b) where
  terminal :: [token] -> Grammor k a b
terminal = k -> Grammor k a b
forall k a b. k -> Grammor k a b
Grammor (k -> Grammor k a b) -> ([token] -> k) -> [token] -> Grammor k a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [token] -> k
forall token s. TerminalSymbol token s => [token] -> s
terminal
instance BackusNaurForm k => BackusNaurForm (Grammor k a b) where
  rule :: String -> Grammor k a b -> Grammor k a b
rule String
name = k -> Grammor k a b
forall k a b. k -> Grammor k a b
Grammor (k -> Grammor k a b)
-> (Grammor k a b -> k) -> Grammor k a b -> Grammor k a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> k -> k
forall bnf. BackusNaurForm bnf => String -> bnf -> bnf
rule String
name (k -> k) -> (Grammor k a b -> k) -> Grammor k a b -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Grammor k a b -> k
forall k a b. Grammor k a b -> k
runGrammor
  ruleRec :: String -> (Grammor k a b -> Grammor k a b) -> Grammor k a b
ruleRec String
name = k -> Grammor k a b
forall k a b. k -> Grammor k a b
Grammor (k -> Grammor k a b)
-> ((Grammor k a b -> Grammor k a b) -> k)
-> (Grammor k a b -> Grammor k a b)
-> Grammor k a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> (k -> k) -> k
forall bnf. BackusNaurForm bnf => String -> (bnf -> bnf) -> bnf
ruleRec String
name ((k -> k) -> k)
-> ((Grammor k a b -> Grammor k a b) -> k -> k)
-> (Grammor k a b -> Grammor k a b)
-> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (k -> Grammor k a b)
-> (Grammor k a b -> k)
-> (Grammor k a b -> Grammor k a b)
-> k
-> k
forall a b c d. (a -> b) -> (c -> d) -> (b -> c) -> a -> d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap k -> Grammor k a b
forall k a b. k -> Grammor k a b
Grammor Grammor k a b -> k
forall k a b. Grammor k a b -> k
runGrammor
instance Matching s k => Matching s (Grammor k a b) where
  s
word =~ :: s -> Grammor k a b -> Bool
=~ Grammor k a b
pattern = s
word s -> k -> Bool
forall word pattern.
Matching word pattern =>
word -> pattern -> Bool
=~ Grammor k a b -> k
forall k a b. Grammor k a b -> k
runGrammor Grammor k a b
pattern