module Control.Monad.HT where

{- | repeat action until result fulfills condition -}
untilM :: (Monad m) => (a -> Bool) -> m a -> m a
untilM p m =
   do x <- m
      if p x
        then return x
        else untilM p m

-- parameter order equal to that of 'nest'
iterateLimitM :: Monad m => Int -> (a -> m a) -> a -> m [a]
iterateLimitM m f =
   let aux 0 x = return [x]
       aux n x = do y <- f x
                    z <- aux (n-1) y
                    return (x : z)
   in  aux m

{- |
Lazy monadic conjunction.
That is, when the first action returns @False@,
then @False@ is immediately returned, without running the second action.
-}
andLazy :: (Monad m) => m Bool -> m Bool -> m Bool
andLazy m0 m1 =
   m0 >>= \b ->
   if b
     then m1
     else return False

{- |
Lazy monadic disjunction.
That is, when the first action returns @True@,
then @True@ is immediately returned, without running the second action.
-}
orLazy :: (Monad m) => m Bool -> m Bool -> m Bool
orLazy m0 m1 =
   m0 >>= \b ->
   if b
     then return True
     else m1