{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveFoldable        #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE DeriveTraversable     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE Trustworthy           #-}
{-# LANGUAGE TypeOperators         #-}

module Data.InvertibleGrammar.Base
  ( Grammar (..)
  , (:-) (..)
  , forward
  , backward
  , GrammarError (..)
  , Mismatch
  , expected
  , unexpected
  ) where

import Prelude hiding ((.), id)
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Category
import Control.Monad
import Data.Text (Text)
import Data.Bifunctor
import Data.Bifoldable
import Data.Bitraversable
#if !MIN_VERSION_base(4,8,0)
import Data.Traversable
import Data.Foldable
#endif
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
import Data.InvertibleGrammar.Monad
import qualified Debug.Trace

-- | \"Cons\" pair of a heterogenous list or a stack with potentially
-- polymophic tail. E.g. @"first" :- 2 :- (3,4) :- t@
--
-- Isomorphic to a tuple with two elments, but is much more
-- convenient for nested pairs.
data h :- t = h :- t deriving ((h :- t) -> (h :- t) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall h t. (Eq h, Eq t) => (h :- t) -> (h :- t) -> Bool
/= :: (h :- t) -> (h :- t) -> Bool
$c/= :: forall h t. (Eq h, Eq t) => (h :- t) -> (h :- t) -> Bool
== :: (h :- t) -> (h :- t) -> Bool
$c== :: forall h t. (Eq h, Eq t) => (h :- t) -> (h :- t) -> Bool
Eq, Int -> (h :- t) -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall h t. (Show h, Show t) => Int -> (h :- t) -> ShowS
forall h t. (Show h, Show t) => [h :- t] -> ShowS
forall h t. (Show h, Show t) => (h :- t) -> String
showList :: [h :- t] -> ShowS
$cshowList :: forall h t. (Show h, Show t) => [h :- t] -> ShowS
show :: (h :- t) -> String
$cshow :: forall h t. (Show h, Show t) => (h :- t) -> String
showsPrec :: Int -> (h :- t) -> ShowS
$cshowsPrec :: forall h t. (Show h, Show t) => Int -> (h :- t) -> ShowS
Show, forall a b. a -> (h :- b) -> h :- a
forall a b. (a -> b) -> (h :- a) -> h :- b
forall h a b. a -> (h :- b) -> h :- a
forall h a b. (a -> b) -> (h :- a) -> h :- b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> (h :- b) -> h :- a
$c<$ :: forall h a b. a -> (h :- b) -> h :- a
fmap :: forall a b. (a -> b) -> (h :- a) -> h :- b
$cfmap :: forall h a b. (a -> b) -> (h :- a) -> h :- b
Functor, forall a. (h :- a) -> Bool
forall h a. Eq a => a -> (h :- a) -> Bool
forall h a. Num a => (h :- a) -> a
forall h a. Ord a => (h :- a) -> a
forall m a. Monoid m => (a -> m) -> (h :- a) -> m
forall h m. Monoid m => (h :- m) -> m
forall h a. (h :- a) -> Bool
forall h a. (h :- a) -> Int
forall h a. (h :- a) -> [a]
forall a b. (a -> b -> b) -> b -> (h :- a) -> b
forall h a. (a -> a -> a) -> (h :- a) -> a
forall h m a. Monoid m => (a -> m) -> (h :- a) -> m
forall h b a. (b -> a -> b) -> b -> (h :- a) -> b
forall h a b. (a -> b -> b) -> b -> (h :- a) -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => (h :- a) -> a
$cproduct :: forall h a. Num a => (h :- a) -> a
sum :: forall a. Num a => (h :- a) -> a
$csum :: forall h a. Num a => (h :- a) -> a
minimum :: forall a. Ord a => (h :- a) -> a
$cminimum :: forall h a. Ord a => (h :- a) -> a
maximum :: forall a. Ord a => (h :- a) -> a
$cmaximum :: forall h a. Ord a => (h :- a) -> a
elem :: forall a. Eq a => a -> (h :- a) -> Bool
$celem :: forall h a. Eq a => a -> (h :- a) -> Bool
length :: forall a. (h :- a) -> Int
$clength :: forall h a. (h :- a) -> Int
null :: forall a. (h :- a) -> Bool
$cnull :: forall h a. (h :- a) -> Bool
toList :: forall a. (h :- a) -> [a]
$ctoList :: forall h a. (h :- a) -> [a]
foldl1 :: forall a. (a -> a -> a) -> (h :- a) -> a
$cfoldl1 :: forall h a. (a -> a -> a) -> (h :- a) -> a
foldr1 :: forall a. (a -> a -> a) -> (h :- a) -> a
$cfoldr1 :: forall h a. (a -> a -> a) -> (h :- a) -> a
foldl' :: forall b a. (b -> a -> b) -> b -> (h :- a) -> b
$cfoldl' :: forall h b a. (b -> a -> b) -> b -> (h :- a) -> b
foldl :: forall b a. (b -> a -> b) -> b -> (h :- a) -> b
$cfoldl :: forall h b a. (b -> a -> b) -> b -> (h :- a) -> b
foldr' :: forall a b. (a -> b -> b) -> b -> (h :- a) -> b
$cfoldr' :: forall h a b. (a -> b -> b) -> b -> (h :- a) -> b
foldr :: forall a b. (a -> b -> b) -> b -> (h :- a) -> b
$cfoldr :: forall h a b. (a -> b -> b) -> b -> (h :- a) -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> (h :- a) -> m
$cfoldMap' :: forall h m a. Monoid m => (a -> m) -> (h :- a) -> m
foldMap :: forall m a. Monoid m => (a -> m) -> (h :- a) -> m
$cfoldMap :: forall h m a. Monoid m => (a -> m) -> (h :- a) -> m
fold :: forall m. Monoid m => (h :- m) -> m
$cfold :: forall h m. Monoid m => (h :- m) -> m
Foldable, forall h. Functor ((:-) h)
forall h. Foldable ((:-) h)
forall h (m :: * -> *) a. Monad m => (h :- m a) -> m (h :- a)
forall h (f :: * -> *) a. Applicative f => (h :- f a) -> f (h :- a)
forall h (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (h :- a) -> m (h :- b)
forall h (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (h :- a) -> f (h :- b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (h :- a) -> f (h :- b)
sequence :: forall (m :: * -> *) a. Monad m => (h :- m a) -> m (h :- a)
$csequence :: forall h (m :: * -> *) a. Monad m => (h :- m a) -> m (h :- a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (h :- a) -> m (h :- b)
$cmapM :: forall h (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (h :- a) -> m (h :- b)
sequenceA :: forall (f :: * -> *) a. Applicative f => (h :- f a) -> f (h :- a)
$csequenceA :: forall h (f :: * -> *) a. Applicative f => (h :- f a) -> f (h :- a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (h :- a) -> f (h :- b)
$ctraverse :: forall h (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (h :- a) -> f (h :- b)
Traversable)
infixr 5 :-

instance Bifunctor (:-) where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> (a :- c) -> b :- d
bimap a -> b
f c -> d
g (a
a :- c
b) = a -> b
f a
a forall h t. h -> t -> h :- t
:- c -> d
g c
b

instance Bifoldable (:-) where
  bifoldr :: forall a c b. (a -> c -> c) -> (b -> c -> c) -> c -> (a :- b) -> c
bifoldr a -> c -> c
f b -> c -> c
g c
x0 (a
a :- b
b) = a
a a -> c -> c
`f` (b
b b -> c -> c
`g` c
x0)

instance Bitraversable (:-) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a :- b) -> f (c :- d)
bitraverse a -> f c
f b -> f d
g (a
a :- b
b) = forall h t. h -> t -> h :- t
(:-) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g b
b

-- | Representation of an invertible grammar -- a grammar that can be
-- run either "forwards" and "backwards".
--
-- For a grammar @Grammar p a b@, running it forwards will take a
-- value of type @a@ and possibly produce a value of type @b@. Running
-- it backwards will take a value of type @b@ and possibly produce an
-- @a@. If a value cannot be produced, an error message is generated.
--
-- As a common example, running a 'Grammar' forwards corresponds to
-- parsing and running backwards corresponds to prettyprinting.
--
-- That is, the grammar defines a partial isomorphism between two
-- values.
data Grammar p a b where
  -- | Total isomorphism grammar.
  Iso        :: (a -> b) -> (b -> a) -> Grammar p a b

  -- | Partial isomorphism. Use 'Flip' to change the direction of
  -- partiality.
  PartialIso :: (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b

  -- | Flip forward and backward passes of an underlying grammar.
  Flip       :: Grammar p a b -> Grammar p b a

  -- | Grammar composition.
  (:.:)      :: Grammar p b c -> Grammar p a b -> Grammar p a c

  -- | Grammar alternation. Left operand is tried first.
  (:<>:)     :: Grammar p a b -> Grammar p a b -> Grammar p a b

  -- | Application of a grammar on 'Traversable' functor.
  Traverse   :: (Traversable f) => Grammar p a b -> Grammar p (f a) (f b)

  -- | Applicaiton of a grammar on stack head
  -- (first component of ':-').
  OnHead     :: Grammar p a b -> Grammar p (a :- t) (b :- t)

  -- | Applicaiton of a grammar on stack tail
  -- (second component of ':-').
  OnTail     :: Grammar p a b -> Grammar p (h :- a) (h :- b)

  -- | Application of a grammar inside a context of annotation, used
  -- for error messages.
  Annotate   :: Text -> Grammar p a b -> Grammar p a b

  -- | Application of a grammar inside a context of a nested
  -- structure, used for error messages. E.g. JSON arrays.
  Dive       :: Grammar p a b -> Grammar p a b

  -- | Propagate logical position inside a nested
  -- structure. E.g. after each successfully matched element of a JSON
  -- array.
  Step       :: Grammar p a a

  -- | Update the position of grammar monad from value on grammar's
  -- input or output on forward or backward pass, respectively. Used
  -- for error messages.
  Locate     :: Grammar p p p

trace :: String -> a -> a
trace :: forall a. String -> a -> a
trace = if Bool
False then forall a. String -> a -> a
Debug.Trace.trace else forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const


instance Category (Grammar p) where
  id :: forall a. Grammar p a a
id                                              = forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

  PartialIso b -> c
f c -> Either Mismatch b
g        . :: forall b c a. Grammar p b c -> Grammar p a b -> Grammar p a c
. Iso a -> b
f' b -> a
g'               = forall a. String -> a -> a
trace String
"p/i" forall a b. (a -> b) -> a -> b
$ forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso (b -> c
f 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') (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
g' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> Either Mismatch b
g)
  Iso b -> c
f c -> b
g               . PartialIso a -> b
f' b -> Either Mismatch a
g'        = forall a. String -> a -> a
trace String
"i/p" forall a b. (a -> b) -> a -> b
$ forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso (b -> c
f 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') (b -> Either Mismatch a
g' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> b
g)

  Flip (PartialIso c -> b
f b -> Either Mismatch c
g) . Iso a -> b
f' b -> a
g'               = forall a. String -> a -> a
trace String
"fp/i" forall a b. (a -> b) -> a -> b
$ forall p a b. Grammar p a b -> Grammar p b a
Flip forall a b. (a -> b) -> a -> b
$ forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso (b -> a
g' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> b
f) (b -> Either Mismatch c
g 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')
  Iso b -> c
f c -> b
g               . Flip (PartialIso b -> a
f' a -> Either Mismatch b
g') = forall a. String -> a -> a
trace String
"i/fp" forall a b. (a -> b) -> a -> b
$ forall p a b. Grammar p a b -> Grammar p b a
Flip forall a b. (a -> b) -> a -> b
$ forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso (b -> a
f' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> b
g) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Either Mismatch b
g')

  PartialIso b -> c
f c -> Either Mismatch b
g        . (Iso b -> b
f' b -> b
g'               :.: Grammar p a b
h) = forall a. String -> a -> a
trace String
"p/i2" forall a b. (a -> b) -> a -> b
$ forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso (b -> c
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> b
f') (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
g' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> Either Mismatch b
g) forall p b c a. Grammar p b c -> Grammar p a b -> Grammar p a c
:.: Grammar p a b
h
  Iso b -> c
f c -> b
g               . (PartialIso b -> b
f' b -> Either Mismatch b
g'        :.: Grammar p a b
h) = forall a. String -> a -> a
trace String
"i/p2" forall a b. (a -> b) -> a -> b
$ forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso (b -> c
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> b
f') (b -> Either Mismatch b
g' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> b
g) forall p b c a. Grammar p b c -> Grammar p a b -> Grammar p a c
:.: Grammar p a b
h

  Flip (PartialIso c -> b
f b -> Either Mismatch c
g) . (Iso b -> b
f' b -> b
g'               :.: Grammar p a b
h) = forall a. String -> a -> a
trace String
"fp/i2" forall a b. (a -> b) -> a -> b
$ forall p a b. Grammar p a b -> Grammar p b a
Flip (forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso (b -> b
g' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> b
f) (b -> Either Mismatch c
g forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> b
f')) forall p b c a. Grammar p b c -> Grammar p a b -> Grammar p a c
:.: Grammar p a b
h
  Iso b -> c
f c -> b
g               . (Flip (PartialIso b -> b
f' b -> Either Mismatch b
g') :.: Grammar p a b
h) = forall a. String -> a -> a
trace String
"i/fp2" forall a b. (a -> b) -> a -> b
$ forall p a b. Grammar p a b -> Grammar p b a
Flip (forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso (b -> b
f' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> b
g) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> Either Mismatch b
g')) forall p b c a. Grammar p b c -> Grammar p a b -> Grammar p a c
:.: Grammar p a b
h

  Flip Grammar p c b
g . Flip Grammar p b a
h                                 = forall a. String -> a -> a
trace String
"f/f" forall a b. (a -> b) -> a -> b
$ forall p a b. Grammar p a b -> Grammar p b a
Flip (Grammar p b a
h forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Grammar p c b
g)
  Iso b -> c
f c -> b
g . Iso a -> b
f' b -> a
g'                             = forall a. String -> a -> a
trace String
"i/i" forall a b. (a -> b) -> a -> b
$ forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso (b -> c
f 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') (b -> a
g' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> b
g)

  (Grammar p b c
g :.: Grammar p b b
h)             . Grammar p a b
j                       = forall a. String -> a -> a
trace String
"assoc" forall a b. (a -> b) -> a -> b
$ Grammar p b c
g forall p b c a. Grammar p b c -> Grammar p a b -> Grammar p a c
:.: (Grammar p b b
h forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Grammar p a b
j)

  Grammar p b c
g                     . Grammar p a b
h                       = Grammar p b c
g forall p b c a. Grammar p b c -> Grammar p a b -> Grammar p a c
:.: Grammar p a b
h


instance Semigroup (Grammar p a b) where
  <> :: Grammar p a b -> Grammar p a b -> Grammar p a b
(<>) = forall p a b. Grammar p a b -> Grammar p a b -> Grammar p a b
(:<>:)

-- | Run 'Grammar' forwards.
--
-- For @Grammar p a b@, given a value of type @a@ tries to produce a
-- value of type @b@, otherwise reports an error with position of type
-- @p@.
forward :: Grammar p a b -> a -> ContextError (Propagation p) (GrammarError p) b
forward :: forall p a b.
Grammar p a b
-> a -> ContextError (Propagation p) (GrammarError p) b
forward (Iso a -> b
f b -> a
_)        = forall (m :: * -> *) a. Monad m => a -> m a
return 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
forward (PartialIso a -> b
f b -> Either Mismatch a
_) = forall (m :: * -> *) a. Monad m => a -> m a
return 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
forward (Flip Grammar p b a
g)         = forall p a b.
Grammar p a b
-> b -> ContextError (Propagation p) (GrammarError p) a
backward Grammar p b a
g
forward (Grammar p b b
g :.: Grammar p a b
f)        = forall p a b.
Grammar p a b
-> a -> ContextError (Propagation p) (GrammarError p) b
forward Grammar p b b
g forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall p a b.
Grammar p a b
-> a -> ContextError (Propagation p) (GrammarError p) b
forward Grammar p a b
f
forward (Grammar p a b
f :<>: Grammar p a b
g)       = \a
x -> forall p a b.
Grammar p a b
-> a -> ContextError (Propagation p) (GrammarError p) b
forward Grammar p a b
f a
x forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall p a b.
Grammar p a b
-> a -> ContextError (Propagation p) (GrammarError p) b
forward Grammar p a b
g a
x
forward (Traverse Grammar p a b
g)     = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall p a b.
Grammar p a b
-> a -> ContextError (Propagation p) (GrammarError p) b
forward Grammar p a b
g)
forward (OnHead Grammar p a b
g)       = \(a
a :- t
b) -> (forall h t. h -> t -> h :- t
:- t
b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p a b.
Grammar p a b
-> a -> ContextError (Propagation p) (GrammarError p) b
forward Grammar p a b
g a
a
forward (OnTail Grammar p a b
g)       = \(h
a :- a
b) -> (h
a forall h t. h -> t -> h :- t
:-) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p a b.
Grammar p a b
-> a -> ContextError (Propagation p) (GrammarError p) b
forward Grammar p a b
g a
b
forward (Annotate Text
t Grammar p a b
g)   = forall p e (m :: * -> *) a.
MonadContextError (Propagation p) e m =>
Text -> m a -> m a
doAnnotate Text
t forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall p a b.
Grammar p a b
-> a -> ContextError (Propagation p) (GrammarError p) b
forward Grammar p a b
g
forward (Dive Grammar p a b
g)         = forall p e (m :: * -> *) a.
MonadContextError (Propagation p) e m =>
m a -> m a
doDive forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall p a b.
Grammar p a b
-> a -> ContextError (Propagation p) (GrammarError p) b
forward Grammar p a b
g
forward Grammar p a b
Step             = \a
x -> forall p e (m :: * -> *).
MonadContextError (Propagation p) e m =>
m ()
doStep forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
forward Grammar p a b
Locate           = \a
x -> forall p e (m :: * -> *).
MonadContextError (Propagation p) e m =>
p -> m ()
doLocate a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Run 'Grammar' backwards.
--
-- For @Grammar p a b@, given a value of type @b@ tries to produce a
-- value of type @a@, otherwise reports an error with position of type
-- @p@.
backward :: Grammar p a b -> b -> ContextError (Propagation p) (GrammarError p) a
backward :: forall p a b.
Grammar p a b
-> b -> ContextError (Propagation p) (GrammarError p) a
backward (Iso a -> b
_ b -> a
g)        = forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> a
g
backward (PartialIso a -> b
_ b -> Either Mismatch a
g) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall p (m :: * -> *) a.
MonadContextError (Propagation p) (GrammarError p) m =>
Mismatch -> m a
doError forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> Either Mismatch a
g
backward (Flip Grammar p b a
g)         = forall p a b.
Grammar p a b
-> a -> ContextError (Propagation p) (GrammarError p) b
forward Grammar p b a
g
backward (Grammar p b b
g :.: Grammar p a b
f)        = forall p a b.
Grammar p a b
-> b -> ContextError (Propagation p) (GrammarError p) a
backward Grammar p b b
g forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall p a b.
Grammar p a b
-> b -> ContextError (Propagation p) (GrammarError p) a
backward Grammar p a b
f
backward (Grammar p a b
f :<>: Grammar p a b
g)       = \b
x -> forall p a b.
Grammar p a b
-> b -> ContextError (Propagation p) (GrammarError p) a
backward Grammar p a b
f b
x forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall p a b.
Grammar p a b
-> b -> ContextError (Propagation p) (GrammarError p) a
backward Grammar p a b
g b
x
backward (Traverse Grammar p a b
g)     = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall p a b.
Grammar p a b
-> b -> ContextError (Propagation p) (GrammarError p) a
backward Grammar p a b
g)
backward (OnHead Grammar p a b
g)       = \(b
a :- t
b) -> (forall h t. h -> t -> h :- t
:- t
b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p a b.
Grammar p a b
-> b -> ContextError (Propagation p) (GrammarError p) a
backward Grammar p a b
g b
a
backward (OnTail Grammar p a b
g)       = \(h
a :- b
b) -> (h
a forall h t. h -> t -> h :- t
:-) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p a b.
Grammar p a b
-> b -> ContextError (Propagation p) (GrammarError p) a
backward Grammar p a b
g b
b
backward (Annotate Text
t Grammar p a b
g)   = forall p e (m :: * -> *) a.
MonadContextError (Propagation p) e m =>
Text -> m a -> m a
doAnnotate Text
t forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall p a b.
Grammar p a b
-> b -> ContextError (Propagation p) (GrammarError p) a
backward Grammar p a b
g
backward (Dive Grammar p a b
g)         = forall p e (m :: * -> *) a.
MonadContextError (Propagation p) e m =>
m a -> m a
doDive forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall p a b.
Grammar p a b
-> b -> ContextError (Propagation p) (GrammarError p) a
backward Grammar p a b
g
backward Grammar p a b
Step             = \b
x -> forall p e (m :: * -> *).
MonadContextError (Propagation p) e m =>
m ()
doStep forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return b
x
backward Grammar p a b
Locate           = \b
x -> forall p e (m :: * -> *).
MonadContextError (Propagation p) e m =>
p -> m ()
doLocate b
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return b
x