{-# LANGUAGE CPP #-}
module Distribution.Utils.MapAccum (mapAccumM) where

import Distribution.Compat.Prelude
import Prelude ()

-- Like StateT but with return tuple swapped
newtype StateM s m a = StateM { forall s (m :: * -> *) a. StateM s m a -> s -> m (s, a)
runStateM :: s -> m (s, a) }

instance Functor m => Functor (StateM s m) where
    fmap :: forall a b. (a -> b) -> StateM s m a -> StateM s m b
fmap a -> b
f (StateM s -> m (s, a)
x) = forall s (m :: * -> *) a. (s -> m (s, a)) -> StateM s m a
StateM forall a b. (a -> b) -> a -> b
$ \s
s -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(s
s', a
a) -> (s
s', a -> b
f a
a)) (s -> m (s, a)
x s
s)

instance
#if __GLASGOW_HASKELL__ < 709
    (Functor m, Monad m)
#else
    Monad m
#endif
    => Applicative (StateM s m) where
    pure :: forall a. a -> StateM s m a
pure a
x = forall s (m :: * -> *) a. (s -> m (s, a)) -> StateM s m a
StateM forall a b. (a -> b) -> a -> b
$ \s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
x)
    StateM s -> m (s, a -> b)
f <*> :: forall a b. StateM s m (a -> b) -> StateM s m a -> StateM s m b
<*> StateM s -> m (s, a)
x = forall s (m :: * -> *) a. (s -> m (s, a)) -> StateM s m a
StateM forall a b. (a -> b) -> a -> b
$ \s
s -> do (s
s', a -> b
f') <- s -> m (s, a -> b)
f s
s
                                              (s
s'', a
x') <- s -> m (s, a)
x s
s'
                                              forall (m :: * -> *) a. Monad m => a -> m a
return (s
s'', a -> b
f' a
x')

-- | Monadic variant of 'mapAccumL'.
mapAccumM ::
#if __GLASGOW_HASKELL__ < 709
    (Functor m, Monad m, Traversable t)
#else
    (Monad m, Traversable t)
#endif
          => (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumM :: forall (m :: * -> *) (t :: * -> *) a b c.
(Monad m, Traversable t) =>
(a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumM a -> b -> m (a, c)
f a
s t b
t = forall s (m :: * -> *) a. StateM s m a -> s -> m (s, a)
runStateM (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\b
x -> forall s (m :: * -> *) a. (s -> m (s, a)) -> StateM s m a
StateM (\a
s' -> a -> b -> m (a, c)
f a
s' b
x)) t b
t) a
s