Monad.hs

-----------------------------------------------------------------------------
-- Copyright 2019, Advise-Me project team. This file is distributed under 
-- the terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------

module Util.Monad
   ( deleteByM, anyM, allM, applyFirstM, withGuard, mWhen
   ) where

import Control.Applicative
import Control.Monad

applyFirstM :: Monad m => (a -> m a) -> m (a, b) -> m (a,b)
applyFirstM f sp = sp >>= \(e,b) -> f e >>= \e' -> return (e',b)

allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
allM p xs = do
  bs <- mapM p xs
  return $ and bs

anyM :: (Show a, Monad m) => (a -> m Bool) -> [a] -> m Bool
anyM _ [] = return False
anyM p (x:xs) = do
  b <- p x
  if b then return True
       else anyM p xs

deleteByM                :: Monad m => (a -> a -> m Bool) -> a -> [a] -> m [a]
deleteByM _  _ []        = return []
deleteByM eq x (y:ys)    = do b <- x `eq` y
                              if b then return ys
                                   else (y :) <$> deleteByM eq x ys

withGuard :: (Monad m, Alternative m) => (a -> Bool) -> m a -> m a
withGuard p m = do
  a <- m
  guard (p a)
  return a


mWhen :: Monoid m => Bool -> m -> m
mWhen True m = m
mWhen False _ = mempty