module Control.Monad.HT where

import qualified Control.Monad as M
import qualified Data.List as List
import Prelude hiding (repeat, until, )


infixr 1 <=<

{- |
Also present in newer versions of the 'base' package.
-}
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)
<=< :: (b -> m c) -> (a -> m b) -> a -> m c
(<=<) b -> m c
f a -> m b
g = (b -> m c
f (b -> m c) -> m b -> m c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (m b -> m c) -> (a -> m b) -> a -> m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
g


{- |
Monadic 'List.repeat'.
-}
repeat :: (Monad m) => m a -> m [a]
repeat :: m a -> m [a]
repeat m a
x =
   let go :: m [a]
go = (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
lift2 (:) m a
x m [a]
go in m [a]
go

nest :: (Monad m) => Int -> (a -> m a) -> a -> m a
nest :: Int -> (a -> m a) -> a -> m a
nest Int
n a -> m a
f a
x0 = (a -> () -> m a) -> a -> [()] -> m a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
M.foldM (\a
x () -> a -> m a
f a
x) a
x0 (Int -> () -> [()]
forall a. Int -> a -> [a]
List.replicate Int
n ())

{-# DEPRECATED untilM "use M.until" #-}
{- | repeat action until result fulfills condition -}
until, untilM :: (Monad m) => (a -> Bool) -> m a -> m a
untilM :: (a -> Bool) -> m a -> m a
untilM = (a -> Bool) -> m a -> m a
forall (m :: * -> *) a. Monad m => (a -> Bool) -> m a -> m a
until
until :: (a -> Bool) -> m a -> m a
until a -> Bool
p m a
m =
   let go :: m a
go =
         do a
x <- m a
m
            if a -> Bool
p a
x
              then a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
              else m a
go
   in  m a
go

{-# DEPRECATED iterateLimitM "use M.iterateLimit" #-}
{- | parameter order equal to that of 'nest' -}
iterateLimit, iterateLimitM :: Monad m => Int -> (a -> m a) -> a -> m [a]
iterateLimitM :: Int -> (a -> m a) -> a -> m [a]
iterateLimitM = Int -> (a -> m a) -> a -> m [a]
forall (m :: * -> *) a. Monad m => Int -> (a -> m a) -> a -> m [a]
iterateLimit
iterateLimit :: Int -> (a -> m a) -> a -> m [a]
iterateLimit Int
m a -> m a
f =
   let aux :: t -> a -> m [a]
aux t
n a
x =
          ([a] -> [a]) -> m [a] -> m [a]
forall (m :: * -> *) a r. Monad m => (a -> r) -> m a -> m r
lift (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (m [a] -> m [a]) -> m [a] -> m [a]
forall a b. (a -> b) -> a -> b
$
          if t
nt -> t -> Bool
forall a. Eq a => a -> a -> Bool
==t
0
            then [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            else t -> a -> m [a]
aux (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) (a -> m [a]) -> m a -> m [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m a
f a
x
   in  Int -> a -> m [a]
forall t. (Eq t, Num t) => t -> a -> m [a]
aux Int
m

{- |
I think this makes only sense in a lazy monad
like @Trans.State.Lazy@ or @IO.Lazy@.
-}
iterate :: Monad m => (a -> m a) -> a -> m [a]
iterate :: (a -> m a) -> a -> m [a]
iterate a -> m a
f =
   let go :: a -> m [a]
go a
x = ([a] -> [a]) -> m [a] -> m [a]
forall (m :: * -> *) a r. Monad m => (a -> r) -> m a -> m r
lift (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (m [a] -> m [a]) -> m [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ a -> m [a]
go (a -> m [a]) -> m a -> m [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m a
f a
x
   in  a -> m [a]
go

{- |
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 :: m Bool -> m Bool -> m Bool
andLazy m Bool
m0 m Bool
m1 =
   m Bool
m0 m Bool -> (Bool -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b ->
   if Bool
b
     then m Bool
m1
     else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: m Bool -> m Bool -> m Bool
orLazy m Bool
m0 m Bool
m1 =
   m Bool
m0 m Bool -> (Bool -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b ->
   if Bool
b
     then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
     else m Bool
m1


void :: (Monad m) => m a -> m ()
void :: m a -> m ()
void = (a -> ()) -> m a -> m ()
forall (m :: * -> *) a r. Monad m => (a -> r) -> m a -> m r
lift (() -> a -> ()
forall a b. a -> b -> a
const ())

for :: Monad m => [a] -> (a -> m b) -> m [b]
for :: [a] -> (a -> m b) -> m [b]
for = [a] -> (a -> m b) -> m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
M.forM

map :: Monad m => (a -> m b) -> [a] -> m [b]
map :: (a -> m b) -> [a] -> m [b]
map = (a -> m b) -> [a] -> m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
M.mapM

zipWith :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c]
zipWith :: (a -> b -> m c) -> [a] -> [b] -> m [c]
zipWith = (a -> b -> m c) -> [a] -> [b] -> m [c]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
M.zipWithM

chain :: (Monad m) => [a -> m a] -> (a -> m a)
chain :: [a -> m a] -> a -> m a
chain = ((a -> m a) -> (a -> m a) -> a -> m a)
-> (a -> m a) -> [a -> m a] -> a -> m a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((a -> m a) -> (a -> m a) -> a -> m a)
-> (a -> m a) -> (a -> m a) -> a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m a) -> (a -> m a) -> a -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
(<=<)) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- there is also mfilter, but this should be part of Control.Monad.Plus
filter :: Monad m => (a -> m Bool) -> [a] -> m [a]
filter :: (a -> m Bool) -> [a] -> m [a]
filter = (a -> m Bool) -> [a] -> m [a]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
M.filterM

replicate :: Monad m => Int -> m a -> m [a]
replicate :: Int -> m a -> m [a]
replicate = Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
M.replicateM

lift :: Monad m => (a -> r) -> m a -> m r
lift :: (a -> r) -> m a -> m r
lift = (a -> r) -> m a -> m r
forall (m :: * -> *) a r. Monad m => (a -> r) -> m a -> m r
M.liftM

lift2 ::
   Monad m => (a -> b -> r) -> m a -> m b -> m r
lift2 :: (a -> b -> r) -> m a -> m b -> m r
lift2 = (a -> b -> r) -> m a -> m b -> m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
M.liftM2

lift3 ::
   Monad m => (a -> b -> c -> r) -> m a -> m b -> m c -> m r
lift3 :: (a -> b -> c -> r) -> m a -> m b -> m c -> m r
lift3 = (a -> b -> c -> r) -> m a -> m b -> m c -> m r
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
M.liftM3

lift4 ::
   Monad m =>
   (a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
lift4 :: (a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
lift4 = (a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
M.liftM4

lift5 ::
   Monad m =>
   (a -> b -> c -> d -> e -> r) ->
   m a -> m b -> m c -> m d -> m e -> m r
lift5 :: (a -> b -> c -> d -> e -> r)
-> m a -> m b -> m c -> m d -> m e -> m r
lift5 = (a -> b -> c -> d -> e -> r)
-> m a -> m b -> m c -> m d -> m e -> m r
forall (m :: * -> *) a1 a2 a3 a4 a5 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> a5 -> r)
-> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
M.liftM5


{-
that's just (=<<)

liftJoin :: (Monad m) => (a -> m b) -> m a -> m b
liftJoin f ma =
   join (lift f ma)
-}

liftJoin2 :: (Monad m) => (a -> b -> m c) -> m a -> m b -> m c
liftJoin2 :: (a -> b -> m c) -> m a -> m b -> m c
liftJoin2 a -> b -> m c
f m a
ma m b
mb =
   m (m c) -> m c
forall (m :: * -> *) a. Monad m => m (m a) -> m a
M.join ((a -> b -> m c) -> m a -> m b -> m (m c)
forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
lift2 a -> b -> m c
f m a
ma m b
mb)

liftJoin3 :: (Monad m) => (a -> b -> c -> m d) -> m a -> m b -> m c -> m d
liftJoin3 :: (a -> b -> c -> m d) -> m a -> m b -> m c -> m d
liftJoin3 a -> b -> c -> m d
f m a
ma m b
mb m c
mc =
   m (m d) -> m d
forall (m :: * -> *) a. Monad m => m (m a) -> m a
M.join ((a -> b -> c -> m d) -> m a -> m b -> m c -> m (m d)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
lift3 a -> b -> c -> m d
f m a
ma m b
mb m c
mc)

liftJoin4 ::
   (Monad m) =>
   (a -> b -> c -> d -> m e) ->
   m a -> m b -> m c -> m d -> m e
liftJoin4 :: (a -> b -> c -> d -> m e) -> m a -> m b -> m c -> m d -> m e
liftJoin4 a -> b -> c -> d -> m e
f m a
ma m b
mb m c
mc m d
md =
   m (m e) -> m e
forall (m :: * -> *) a. Monad m => m (m a) -> m a
M.join ((a -> b -> c -> d -> m e) -> m a -> m b -> m c -> m d -> m (m e)
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
lift4 a -> b -> c -> d -> m e
f m a
ma m b
mb m c
mc m d
md)

liftJoin5 ::
   (Monad m) =>
   (a -> b -> c -> d -> e -> m f) ->
   m a -> m b -> m c -> m d -> m e -> m f
liftJoin5 :: (a -> b -> c -> d -> e -> m f)
-> m a -> m b -> m c -> m d -> m e -> m f
liftJoin5 a -> b -> c -> d -> e -> m f
f m a
ma m b
mb m c
mc m d
md m e
me =
   m (m f) -> m f
forall (m :: * -> *) a. Monad m => m (m a) -> m a
M.join ((a -> b -> c -> d -> e -> m f)
-> m a -> m b -> m c -> m d -> m e -> m (m f)
forall (m :: * -> *) a1 a2 a3 a4 a5 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> a5 -> r)
-> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
lift5 a -> b -> c -> d -> e -> m f
f m a
ma m b
mb m c
mc m d
md m e
me)

{-
Add functions with restricted types?
Shall their element types be monoids?
Should we add these functions to a Foldable.HT module
in order to save the underscore?

(>>)
mapM_
zipWithM_
sequence_
...
-}