module Language.Boogie.ErrorAccum where
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Error
newtype ErrorAccumT e m a = ErrorAccumT { runErrorAccumT :: m ([e], a) }
instance (ErrorList e, Monad m) => Monad (ErrorAccumT e m) where
return x = ErrorAccumT $ return ([], x)
m >>= k = ErrorAccumT $ do
(errs, res) <- runErrorAccumT m
(errs', res') <- runErrorAccumT $ k res
return (errs ++ errs', res')
instance ErrorList e => MonadTrans (ErrorAccumT e) where
lift m = ErrorAccumT $ do
a <- m
return ([], a)
accum :: (ErrorList e, Monad m) => ErrorT [e] m a -> a -> ErrorAccumT e m a
accum c def = ErrorAccumT (errToAccum def `liftM` runErrorT c)
where
errToAccum def (Left errs) = (errs, def)
errToAccum def (Right x) = ([], x)
report :: (ErrorList e, Monad m) => ErrorAccumT e m a -> ErrorT [e] m a
report accum = ErrorT (accumToErr `liftM` runErrorAccumT accum)
where
accumToErr ([], x) = Right x
accumToErr (es, _) = Left es
mapAccum :: (ErrorList e, Monad m) => (a -> ErrorT [e] m b) -> b -> [a] -> ErrorT [e] m [b]
mapAccum f def xs = report $ mapM (acc f) xs
where
acc f x = accum (f x) def
mapAccumA_ :: (ErrorList e, Monad m) => (a -> ErrorT [e] m ()) -> [a] -> ErrorAccumT e m ()
mapAccumA_ f xs = mapM_ (acc f) xs
where
acc f x = accum (f x) ()
mapAccum_ :: (ErrorList e, Monad m) => (a -> ErrorT [e] m ()) -> [a] -> ErrorT [e] m ()
mapAccum_ f xs = report $ mapAccumA_ f xs
zipWithAccum_ :: (ErrorList e, Monad m) => (a -> b -> ErrorT [e] m ()) -> [a] -> [b] -> ErrorT [e] m ()
zipWithAccum_ f xs ys = report $ zipWithM_ (acc f) xs ys
where
acc f x y = accum (f x y) ()