1{-# LANGUAGE CPP #-}
2module Distribution.Utils.MapAccum (mapAccumM) where
3
4import Distribution.Compat.Prelude
5import Prelude ()
6
7-- Like StateT but with return tuple swapped
8newtype StateM s m a = StateM { runStateM :: s -> m (s, a) }
9
10instance Functor m => Functor (StateM s m) where
11    fmap f (StateM x) = StateM $ \s -> fmap (\(s', a) -> (s', f a)) (x s)
12
13instance
14#if __GLASGOW_HASKELL__ < 709
15    (Functor m, Monad m)
16#else
17    Monad m
18#endif
19    => Applicative (StateM s m) where
20    pure x = StateM $ \s -> return (s, x)
21    StateM f <*> StateM x = StateM $ \s -> do (s', f') <- f s
22                                              (s'', x') <- x s'
23                                              return (s'', f' x')
24
25-- | Monadic variant of 'mapAccumL'.
26mapAccumM ::
27#if __GLASGOW_HASKELL__ < 709
28    (Functor m, Monad m, Traversable t)
29#else
30    (Monad m, Traversable t)
31#endif
32          => (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
33mapAccumM f s t = runStateM (traverse (\x -> StateM (\s' -> f s' x)) t) s
34
35