{-# 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
  { forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState :: (state, a) -> (state, b) }

-- | Constructor
withState           :: (state -> a -> (state, b)) -> ArrowState state a b
withState :: forall state a b.
(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 :: forall state a. (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 b c d. (b -> c) -> (b, d) -> (c, d)
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 :: forall a b state. (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 b c d. (b -> c) -> (d, b) -> (d, c)
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 :: forall state b a. (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 :: forall state b x. (state -> b) -> ArrowState state x b
extractFromState   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,x
_) -> (state
state, state -> b
f state
state)

-- | Constructor
tryModifyState      :: (state ->  Either f state)
                    -> ArrowState state a (Either f a)
tryModifyState :: forall state f a.
(state -> Either f state) -> ArrowState state a (Either f a)
tryModifyState     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,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 b d c. (b -> d) -> (c -> d) -> Either b c -> d
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 :: forall a. 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
  ArrowState s b c
arrow2 . :: forall b c a.
ArrowState s b c -> ArrowState s a b -> ArrowState s a c
. 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 :: forall b c. (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 :: forall b c d.
ArrowState state b c -> ArrowState state (b, d) (c, d)
first  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
$ \(state
s,(b
aF,d
aS))
                                    -> (c -> (c, d)) -> (state, c) -> (state, (c, d))
forall b c d. (b -> c) -> (d, b) -> (d, c)
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 :: forall b c d.
ArrowState state b c -> ArrowState state (d, b) (d, c)
second 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
$ \(state
s,(d
aF,b
aS))
                                    -> (c -> (d, c)) -> (state, c) -> (state, (d, c))
forall b c d. (b -> c) -> (d, b) -> (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 :: forall b c d.
ArrowState state b c -> ArrowState state (Either b d) (Either c d)
left   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
$ \(state
s,Either b d
e) -> case Either b d
e of
                                 Left  b
l -> (c -> Either c d) -> (state, c) -> (state, Either c d)
forall b c d. (b -> c) -> (d, b) -> (d, c)
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 d
r -> (state
s, d -> Either c d
forall a b. b -> Either a b
Right d
r)
  right :: forall b c d.
ArrowState state b c -> ArrowState state (Either d b) (Either d c)
right  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
$ \(state
s,Either d b
e) -> case Either d b
e of
                                 Left  d
l -> (state
s, d -> Either d c
forall a b. a -> Either a b
Left d
l)
                                 Right b
r -> (c -> Either d c) -> (state, c) -> (state, Either d c)
forall b c d. (b -> c) -> (d, b) -> (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 :: forall b c. 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
$ \(state
s, (ArrowState state b c
f,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 :: forall s x f s'.
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')
unlift 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 f a. (x, Either f a) -> Either f (x, a)
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 a b. (a -> b) -> Either f a -> Either f b
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' :: 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 = ((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,x
_) = 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 b c d. (b -> c) -> (d, b) -> (d, c)
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 ArrowState b a (Either a a)
a' (a, b) -> (s, Either a b)
b (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
                                      (b
_ , Left  a
f) -> (s
s, a -> Either a b
forall a b. a -> Either a b
Left a
f)
                                      (b
x , Right 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 :: forall (f :: * -> *) m s x.
(Foldable f, Monoid m) =>
ArrowState s x m -> ArrowState s (f x) m
foldS 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,f x
f) -> (x -> (s, m) -> (s, m)) -> (s, m) -> f x -> (s, m)
forall a b. (a -> b -> b) -> b -> f a -> b
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 (s
s',m
m) = (m -> m) -> (s, m) -> (s, m)
forall b c d. (b -> c) -> (d, b) -> (d, c)
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 :: forall (f :: * -> *) (m :: * -> *) s x y.
(Foldable f, MonadPlus m) =>
ArrowState s x y -> ArrowState s (f x) (m y)
iterateS 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,f x
f) -> (x -> (s, m y) -> (s, m y)) -> (s, m y) -> f x -> (s, m y)
forall a b. (a -> b -> b) -> b -> f a -> b
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 a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero) f x
f
  where a' :: x -> (s, m y) -> (s, m y)
a' x
x (s
s',m y
m) = (y -> m y) -> (s, y) -> (s, m y)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (m y -> m y -> m y
forall a. m a -> m a -> m a
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 a. a -> m a
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 :: forall (f :: * -> *) (m :: * -> *) s x y.
(Foldable f, MonadPlus m) =>
ArrowState s x y -> ArrowState s (f x) (m y)
iterateSL 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,f x
f) -> ((s, m y) -> x -> (s, m y)) -> (s, m y) -> f x -> (s, m y)
forall b a. (b -> a -> b) -> b -> f a -> b
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 a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero) f x
f
  where a' :: (s, m y) -> x -> (s, m y)
a' (s
s',m y
m) x
x = (y -> m y) -> (s, y) -> (s, m y)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (m y -> m y -> m y
forall a. m a -> m a -> m a
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 a. a -> m a
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' :: forall (f :: * -> *) (m :: * -> *) s x e y.
(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)
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,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 a b. (a -> b -> b) -> b -> f a -> b
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 a. m a
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 x
x (s
s',Right 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'',Right 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 a. m a -> m a -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return y
m')
                                (s
_  ,Left  e
e ) -> (s
s  ,e -> Either e (m y)
forall a b. a -> Either a b
Left  e
e )
        a' s
_ x
_   (s, Either e (m y))
e          = (s, Either e (m y))
e