monoid-comprehensions-transformer.hs

newtype MonoidComp r m a = MonoidComp { unMonoidComp :: ContT r m a }
  deriving (Functor, Applicative, Monad, MonadTrans)

instance (Applicative m, Monoid r) => Alternative (MonoidComp r m) where
  empty = MonoidComp $ ContT $ const (pure mempty)
  MonoidComp a <|> MonoidComp b =
    MonoidComp $ ContT $ \f -> liftA2 (<>) (runContT a f) (runContT b f)

foldMapA :: (Foldable f, Applicative m, Monoid r) => (a -> m r) -> f a -> m r
foldMapA f = foldr (liftA2 (<>) . f) (pure mempty)

fromFoldable :: (Applicative m, Foldable f, Monoid r) => f a -> MonoidComp r m a
fromFoldable xs = MonoidComp $ ContT $ \f -> foldMapA f xs

runMonoidComp :: MonoidComp r m r -> m r
runMonoidComp = evalContT . unMonoidComp