{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TupleSections     #-}
{- |
   Module      : Text.Pandoc.Readers.Odt.Arrows.State
   Copyright   : Copyright (C) 2015 Martin Linnemann
   License     : GNU GPL, version 2 or above

   Maintainer  : Martin Linnemann <theCodingMarlin@googlemail.com>
   Stability   : alpha
   Portability : portable

An arrow that transports a state. It is in essence a more powerful version of
the standard state monad. As it is such a simple extension, there are
other version out there that do exactly the same.
The implementation is duplicated, though, to add some useful features.
Most of these might be implemented without access to innards, but it's much
faster and easier to implement this way.
-}

module Text.Pandoc.Readers.Odt.Arrows.State where

import Control.Arrow
import qualified Control.Category as Cat
import Control.Monad
import Data.List (foldl')
import Text.Pandoc.Readers.Odt.Arrows.Utils
import Text.Pandoc.Readers.Odt.Generic.Fallible


newtype ArrowState state a b = ArrowState
  { ArrowState state a b -> (state, a) -> (state, b)
runArrowState :: (state, a) -> (state, b) }

-- | Constructor
withState           :: (state -> a -> (state, b)) -> ArrowState state a b
withState :: (state -> a -> (state, b)) -> ArrowState state a b
withState            = ((state, a) -> (state, b)) -> ArrowState state a b
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, a) -> (state, b)) -> ArrowState state a b)
-> ((state -> a -> (state, b)) -> (state, a) -> (state, b))
-> (state -> a -> (state, b))
-> ArrowState state a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (state -> a -> (state, b)) -> (state, a) -> (state, b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

-- | Constructor
modifyState         :: (state      ->  state    ) -> ArrowState state a a
modifyState :: (state -> state) -> ArrowState state a a
modifyState          = ((state, a) -> (state, a)) -> ArrowState state a a
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, a) -> (state, a)) -> ArrowState state a a)
-> ((state -> state) -> (state, a) -> (state, a))
-> (state -> state)
-> ArrowState state a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (state -> state) -> (state, a) -> (state, a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first

-- | Constructor
ignoringState       :: (         a ->         b ) -> ArrowState state a b
ignoringState :: (a -> b) -> ArrowState state a b
ignoringState        = ((state, a) -> (state, b)) -> ArrowState state a b
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, a) -> (state, b)) -> ArrowState state a b)
-> ((a -> b) -> (state, a) -> (state, b))
-> (a -> b)
-> ArrowState state a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> (state, a) -> (state, b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second

-- | Constructor
fromState           :: (state      -> (state, b)) -> ArrowState state a b
fromState :: (state -> (state, b)) -> ArrowState state a b
fromState            = ((state, a) -> (state, b)) -> ArrowState state a b
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, a) -> (state, b)) -> ArrowState state a b)
-> ((state -> (state, b)) -> (state, a) -> (state, b))
-> (state -> (state, b))
-> ArrowState state a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((state -> (state, b))
-> ((state, a) -> state) -> (state, a) -> (state, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(state, a) -> state
forall a b. (a, b) -> a
fst)

-- | Constructor
extractFromState    :: (state      ->         b ) -> ArrowState state x b
extractFromState :: (state -> b) -> ArrowState state x b
extractFromState   f :: state -> b
f = ((state, x) -> (state, b)) -> ArrowState state x b
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, x) -> (state, b)) -> ArrowState state x b)
-> ((state, x) -> (state, b)) -> ArrowState state x b
forall a b. (a -> b) -> a -> b
$ \(state :: state
state,_) -> (state
state, state -> b
f state
state)

-- | Constructor
tryModifyState      :: (state ->  Either f state)
                    -> ArrowState state a (Either f a)
tryModifyState :: (state -> Either f state) -> ArrowState state a (Either f a)
tryModifyState     f :: state -> Either f state
f = ((state, a) -> (state, Either f a))
-> ArrowState state a (Either f a)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, a) -> (state, Either f a))
 -> ArrowState state a (Either f a))
-> ((state, a) -> (state, Either f a))
-> ArrowState state a (Either f a)
forall a b. (a -> b) -> a -> b
$ \(state :: state
state,a :: a
a)
                                  -> (state
state,)(Either f a -> (state, Either f a))
-> (f -> Either f a) -> f -> (state, Either f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.f -> Either f a
forall a b. a -> Either a b
Left (f -> (state, Either f a))
-> (state -> (state, Either f a))
-> Either f state
-> (state, Either f a)
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| (,a -> Either f a
forall a b. b -> Either a b
Right a
a) (Either f state -> (state, Either f a))
-> Either f state -> (state, Either f a)
forall a b. (a -> b) -> a -> b
$ state -> Either f state
f state
state

instance Cat.Category (ArrowState s) where
  id :: ArrowState s a a
id                = ((s, a) -> (s, a)) -> ArrowState s a a
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (s, a) -> (s, a)
forall a. a -> a
id
  arrow2 :: ArrowState s b c
arrow2 . :: ArrowState s b c -> ArrowState s a b -> ArrowState s a c
. arrow1 :: ArrowState s a b
arrow1   = ((s, a) -> (s, c)) -> ArrowState s a c
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((s, a) -> (s, c)) -> ArrowState s a c)
-> ((s, a) -> (s, c)) -> ArrowState s a c
forall a b. (a -> b) -> a -> b
$ ArrowState s b c -> (s, b) -> (s, c)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState s b c
arrow2 ((s, b) -> (s, c)) -> ((s, a) -> (s, b)) -> (s, a) -> (s, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrowState s a b -> (s, a) -> (s, b)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState s a b
arrow1

instance Arrow (ArrowState state) where
  arr :: (b -> c) -> ArrowState state b c
arr               = (b -> c) -> ArrowState state b c
forall a b state. (a -> b) -> ArrowState state a b
ignoringState
  first :: ArrowState state b c -> ArrowState state (b, d) (c, d)
first  a :: ArrowState state b c
a          = ((state, (b, d)) -> (state, (c, d)))
-> ArrowState state (b, d) (c, d)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, (b, d)) -> (state, (c, d)))
 -> ArrowState state (b, d) (c, d))
-> ((state, (b, d)) -> (state, (c, d)))
-> ArrowState state (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ \(s :: state
s,(aF :: b
aF,aS :: d
aS))
                                    -> (c -> (c, d)) -> (state, c) -> (state, (c, d))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (,d
aS) ((state, c) -> (state, (c, d))) -> (state, c) -> (state, (c, d))
forall a b. (a -> b) -> a -> b
$ ArrowState state b c -> (state, b) -> (state, c)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState state b c
a (state
s,b
aF)
  second :: ArrowState state b c -> ArrowState state (d, b) (d, c)
second a :: ArrowState state b c
a          = ((state, (d, b)) -> (state, (d, c)))
-> ArrowState state (d, b) (d, c)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, (d, b)) -> (state, (d, c)))
 -> ArrowState state (d, b) (d, c))
-> ((state, (d, b)) -> (state, (d, c)))
-> ArrowState state (d, b) (d, c)
forall a b. (a -> b) -> a -> b
$ \(s :: state
s,(aF :: d
aF,aS :: b
aS))
                                    -> (c -> (d, c)) -> (state, c) -> (state, (d, c))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (d
aF,) ((state, c) -> (state, (d, c))) -> (state, c) -> (state, (d, c))
forall a b. (a -> b) -> a -> b
$ ArrowState state b c -> (state, b) -> (state, c)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState state b c
a (state
s,b
aS)

instance ArrowChoice (ArrowState state) where
  left :: ArrowState state b c -> ArrowState state (Either b d) (Either c d)
left   a :: ArrowState state b c
a          = ((state, Either b d) -> (state, Either c d))
-> ArrowState state (Either b d) (Either c d)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, Either b d) -> (state, Either c d))
 -> ArrowState state (Either b d) (Either c d))
-> ((state, Either b d) -> (state, Either c d))
-> ArrowState state (Either b d) (Either c d)
forall a b. (a -> b) -> a -> b
$ \(s :: state
s,e :: Either b d
e) -> case Either b d
e of
                                 Left  l :: b
l -> (c -> Either c d) -> (state, c) -> (state, Either c d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second c -> Either c d
forall a b. a -> Either a b
Left  ((state, c) -> (state, Either c d))
-> (state, c) -> (state, Either c d)
forall a b. (a -> b) -> a -> b
$ ArrowState state b c -> (state, b) -> (state, c)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState state b c
a (state
s,b
l)
                                 Right r :: d
r -> (state
s, d -> Either c d
forall a b. b -> Either a b
Right d
r)
  right :: ArrowState state b c -> ArrowState state (Either d b) (Either d c)
right  a :: ArrowState state b c
a          = ((state, Either d b) -> (state, Either d c))
-> ArrowState state (Either d b) (Either d c)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, Either d b) -> (state, Either d c))
 -> ArrowState state (Either d b) (Either d c))
-> ((state, Either d b) -> (state, Either d c))
-> ArrowState state (Either d b) (Either d c)
forall a b. (a -> b) -> a -> b
$ \(s :: state
s,e :: Either d b
e) -> case Either d b
e of
                                 Left  l :: d
l -> (state
s, d -> Either d c
forall a b. a -> Either a b
Left d
l)
                                 Right r :: b
r -> (c -> Either d c) -> (state, c) -> (state, Either d c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second c -> Either d c
forall a b. b -> Either a b
Right ((state, c) -> (state, Either d c))
-> (state, c) -> (state, Either d c)
forall a b. (a -> b) -> a -> b
$ ArrowState state b c -> (state, b) -> (state, c)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState state b c
a (state
s,b
r)

instance ArrowApply (ArrowState state) where
   app :: ArrowState state (ArrowState state b c, b) c
app             = ((state, (ArrowState state b c, b)) -> (state, c))
-> ArrowState state (ArrowState state b c, b) c
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, (ArrowState state b c, b)) -> (state, c))
 -> ArrowState state (ArrowState state b c, b) c)
-> ((state, (ArrowState state b c, b)) -> (state, c))
-> ArrowState state (ArrowState state b c, b) c
forall a b. (a -> b) -> a -> b
$ \(s :: state
s, (f :: ArrowState state b c
f,b :: b
b)) -> ArrowState state b c -> (state, b) -> (state, c)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState state b c
f (state
s,b
b)

-- | Switches the type of the state temporarily.
-- Drops the intermediate result state, behaving like a fallible
-- identity arrow, save for side effects in the state.
withSubStateF  :: ArrowState s  x (Either f s')
               -> ArrowState s' s (Either f s )
               -> ArrowState s  x (Either f x )
withSubStateF :: ArrowState s x (Either f s')
-> ArrowState s' s (Either f s) -> ArrowState s x (Either f x)
withSubStateF  unlift :: ArrowState s x (Either f s')
unlift a :: ArrowState s' s (Either f s)
a = ArrowState s x (Either f s') -> ArrowState s x (x, Either f s')
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue (ArrowState s x (Either f s')
-> ArrowState s' s (Either f s) -> ArrowState s x (Either f s')
forall s x f s'.
ArrowState s x (Either f s')
-> ArrowState s' s (Either f s) -> ArrowState s x (Either f s')
withSubStateF' ArrowState s x (Either f s')
unlift ArrowState s' s (Either f s)
a)
                          ArrowState s x (x, Either f s')
-> ((x, Either f s') -> Either f x) -> ArrowState s x (Either f x)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (x, Either f s') -> Either f (x, s')
forall (v :: * -> *) f a.
ChoiceVector v =>
v (Either f a) -> Either f (v a)
spreadChoice
                          ((x, Either f s') -> Either f (x, s'))
-> (Either f (x, s') -> Either f x)
-> (x, Either f s')
-> Either f x
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ ((x, s') -> x) -> Either f (x, s') -> Either f x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x, s') -> x
forall a b. (a, b) -> a
fst

-- | Switches the type of the state temporarily.
-- Returns the resulting sub-state.
withSubStateF' :: ArrowState s  x (Either f s')
               -> ArrowState s' s (Either f s )
               -> ArrowState s  x (Either f s')
withSubStateF' :: ArrowState s x (Either f s')
-> ArrowState s' s (Either f s) -> ArrowState s x (Either f s')
withSubStateF' unlift :: ArrowState s x (Either f s')
unlift a :: ArrowState s' s (Either f s)
a = ((s, x) -> (s, Either f s')) -> ArrowState s x (Either f s')
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (s, x) -> (s, Either f s')
go
  where go :: (s, x) -> (s, Either f s')
go p :: (s, x)
p@(s :: s
s,_) = ArrowState s x (Either f s')
-> ((s', s) -> (s, Either f s')) -> (s, x) -> (s, Either f s')
forall b a a a b.
ArrowState b a (Either a a)
-> ((a, b) -> (s, Either a b)) -> (b, a) -> (s, Either a b)
tryRunning ArrowState s x (Either f s')
unlift
                                ( ArrowState s' s (Either f s)
-> ((s, s') -> (s, Either f s')) -> (s', s) -> (s, Either f s')
forall b a a a b.
ArrowState b a (Either a a)
-> ((a, b) -> (s, Either a b)) -> (b, a) -> (s, Either a b)
tryRunning ArrowState s' s (Either f s)
a ((s' -> Either f s') -> (s, s') -> (s, Either f s')
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second s' -> Either f s'
forall a b. b -> Either a b
Right) )
                                (s, x)
p
          where tryRunning :: ArrowState b a (Either a a)
-> ((a, b) -> (s, Either a b)) -> (b, a) -> (s, Either a b)
tryRunning a' :: ArrowState b a (Either a a)
a' b :: (a, b) -> (s, Either a b)
b v :: (b, a)
v = case ArrowState b a (Either a a) -> (b, a) -> (b, Either a a)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState b a (Either a a)
a' (b, a)
v of
                                      (_ , Left  f :: a
f) -> (s
s, a -> Either a b
forall a b. a -> Either a b
Left a
f)
                                      (x :: b
x , Right y :: a
y) -> (a, b) -> (s, Either a b)
b (a
y,b
x)

-- | Fold a state arrow through something 'Foldable'. Collect the results
-- in a 'Monoid'.
-- Intermediate form of a fold between one with "only" a 'Monoid'
-- and one with any function.
foldS :: (Foldable f, Monoid m) => ArrowState s x m -> ArrowState s (f x) m
foldS :: ArrowState s x m -> ArrowState s (f x) m
foldS a :: ArrowState s x m
a = ((s, f x) -> (s, m)) -> ArrowState s (f x) m
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((s, f x) -> (s, m)) -> ArrowState s (f x) m)
-> ((s, f x) -> (s, m)) -> ArrowState s (f x) m
forall a b. (a -> b) -> a -> b
$ \(s :: s
s,f :: f x
f) -> (x -> (s, m) -> (s, m)) -> (s, m) -> f x -> (s, m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr x -> (s, m) -> (s, m)
a' (s
s,m
forall a. Monoid a => a
mempty) f x
f
  where a' :: x -> (s, m) -> (s, m)
a' x :: x
x (s' :: s
s',m :: m
m) = (m -> m) -> (s, m) -> (s, m)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (m -> m -> m
forall a. Monoid a => a -> a -> a
mappend m
m)  ((s, m) -> (s, m)) -> (s, m) -> (s, m)
forall a b. (a -> b) -> a -> b
$ ArrowState s x m -> (s, x) -> (s, m)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState s x m
a (s
s',x
x)

-- | Fold a state arrow through something 'Foldable'. Collect the results in a
-- 'MonadPlus'.
iterateS :: (Foldable f, MonadPlus m)
         => ArrowState s    x     y
         -> ArrowState s (f x) (m y)
iterateS :: ArrowState s x y -> ArrowState s (f x) (m y)
iterateS a :: ArrowState s x y
a = ((s, f x) -> (s, m y)) -> ArrowState s (f x) (m y)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((s, f x) -> (s, m y)) -> ArrowState s (f x) (m y))
-> ((s, f x) -> (s, m y)) -> ArrowState s (f x) (m y)
forall a b. (a -> b) -> a -> b
$ \(s :: s
s,f :: f x
f) -> (x -> (s, m y) -> (s, m y)) -> (s, m y) -> f x -> (s, m y)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr x -> (s, m y) -> (s, m y)
forall (m :: * -> *). MonadPlus m => x -> (s, m y) -> (s, m y)
a' (s
s,m y
forall (m :: * -> *) a. MonadPlus m => m a
mzero) f x
f
  where a' :: x -> (s, m y) -> (s, m y)
a' x :: x
x (s' :: s
s',m :: m y
m) = (y -> m y) -> (s, y) -> (s, m y)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (m y -> m y -> m y
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus m y
m(m y -> m y) -> (y -> m y) -> y -> m y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.y -> m y
forall (m :: * -> *) a. Monad m => a -> m a
return) ((s, y) -> (s, m y)) -> (s, y) -> (s, m y)
forall a b. (a -> b) -> a -> b
$ ArrowState s x y -> (s, x) -> (s, y)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState s x y
a (s
s',x
x)

-- | Fold a state arrow through something 'Foldable'. Collect the results in a
-- 'MonadPlus'.
iterateSL :: (Foldable f, MonadPlus m)
          => ArrowState s    x     y
          -> ArrowState s (f x) (m y)
iterateSL :: ArrowState s x y -> ArrowState s (f x) (m y)
iterateSL a :: ArrowState s x y
a = ((s, f x) -> (s, m y)) -> ArrowState s (f x) (m y)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((s, f x) -> (s, m y)) -> ArrowState s (f x) (m y))
-> ((s, f x) -> (s, m y)) -> ArrowState s (f x) (m y)
forall a b. (a -> b) -> a -> b
$ \(s :: s
s,f :: f x
f) -> ((s, m y) -> x -> (s, m y)) -> (s, m y) -> f x -> (s, m y)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (s, m y) -> x -> (s, m y)
forall (m :: * -> *). MonadPlus m => (s, m y) -> x -> (s, m y)
a' (s
s,m y
forall (m :: * -> *) a. MonadPlus m => m a
mzero) f x
f
  where a' :: (s, m y) -> x -> (s, m y)
a' (s' :: s
s',m :: m y
m) x :: x
x = (y -> m y) -> (s, y) -> (s, m y)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (m y -> m y -> m y
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus m y
m(m y -> m y) -> (y -> m y) -> y -> m y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.y -> m y
forall (m :: * -> *) a. Monad m => a -> m a
return) ((s, y) -> (s, m y)) -> (s, y) -> (s, m y)
forall a b. (a -> b) -> a -> b
$ ArrowState s x y -> (s, x) -> (s, y)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState s x y
a (s
s',x
x)


-- | Fold a fallible state arrow through something 'Foldable'.
-- Collect the results in a 'MonadPlus'.
-- If the iteration fails, the state will be reset to the initial one.
iterateS' :: (Foldable f, MonadPlus m)
          => ArrowState s    x  (Either e    y )
          -> ArrowState s (f x) (Either e (m y))
iterateS' :: ArrowState s x (Either e y) -> ArrowState s (f x) (Either e (m y))
iterateS' a :: ArrowState s x (Either e y)
a = ((s, f x) -> (s, Either e (m y)))
-> ArrowState s (f x) (Either e (m y))
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((s, f x) -> (s, Either e (m y)))
 -> ArrowState s (f x) (Either e (m y)))
-> ((s, f x) -> (s, Either e (m y)))
-> ArrowState s (f x) (Either e (m y))
forall a b. (a -> b) -> a -> b
$ \(s :: s
s,f :: f x
f) -> (x -> (s, Either e (m y)) -> (s, Either e (m y)))
-> (s, Either e (m y)) -> f x -> (s, Either e (m y))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (s -> x -> (s, Either e (m y)) -> (s, Either e (m y))
forall (m :: * -> *).
MonadPlus m =>
s -> x -> (s, Either e (m y)) -> (s, Either e (m y))
a' s
s) (s
s,m y -> Either e (m y)
forall a b. b -> Either a b
Right m y
forall (m :: * -> *) a. MonadPlus m => m a
mzero) f x
f
  where a' :: s -> x -> (s, Either e (m y)) -> (s, Either e (m y))
a' s :: s
s x :: x
x (s' :: s
s',Right m :: m y
m) = case ArrowState s x (Either e y) -> (s, x) -> (s, Either e y)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState s x (Either e y)
a (s
s',x
x) of
                                (s'' :: s
s'',Right m' :: y
m') -> (s
s'',m y -> Either e (m y)
forall a b. b -> Either a b
Right (m y -> Either e (m y)) -> m y -> Either e (m y)
forall a b. (a -> b) -> a -> b
$ m y -> m y -> m y
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus m y
m (m y -> m y) -> m y -> m y
forall a b. (a -> b) -> a -> b
$ y -> m y
forall (m :: * -> *) a. Monad m => a -> m a
return y
m')
                                (_  ,Left  e :: e
e ) -> (s
s  ,e -> Either e (m y)
forall a b. a -> Either a b
Left  e
e )
        a' _ _   e :: (s, Either e (m y))
e          = (s, Either e (m y))
e