-- | Some useful monadic combinators missing from the standard libraries
module Monad.Util where
import Control.Monad(ap,when)

infixl 1 #,#!,<#

-- | Apply a pure function to the result of a monadic computation
a -> b
f # :: (a -> b) -> f a -> f b
# f a
x = (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x

-- | Apply a function returned by a monadic computation to an argument returned
-- by a monadic computation
m (a -> b)
f <# :: m (a -> b) -> m a -> m b
<# m a
x = m (a -> b) -> m a -> m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap m (a -> b)
f m a
x

-- | Perform two monadic computation and return the result from the second one
m b
x #! :: m b -> m a -> m b
#! m a
y = b -> a -> b
forall a b. a -> b -> a
const (b -> a -> b) -> m b -> m (a -> b)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# m b
x m (a -> b) -> m a -> m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<# m a
y


-- It is a scandal that monadic composition isn't defined in the libraries...
infixr 1 @@
-- | Kleiski composition
(a -> m b
m1 @@ :: (a -> m b) -> (t -> m a) -> t -> m b
@@ t -> m a
m2) t
i = a -> m b
m1 (a -> m b) -> m a -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< t -> m a
m2 t
i

-- | Infinite loops
loop :: m a -> m b
loop m a
m = m b
forall {b}. m b
l where l :: m b
l = m a
mm a -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>m b
l

-- | While loops
whileM :: m Bool -> m a -> m ()
whileM m Bool
cndM m a
bodyM = m ()
loop
  where loop :: m ()
loop = do Bool
more <- m Bool
cndM
		  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
more (m a
bodyM m a -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
loop)

-- | Repeat m while it returns True
repeatM :: m Bool -> m ()
repeatM m Bool
m = m Bool -> m () -> m ()
forall {m :: * -> *} {a}. Monad m => m Bool -> m a -> m ()
whileM m Bool
m (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

done :: Monad m => m ()
done :: forall (m :: * -> *). Monad m => m ()
done = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()