module Yi.Monad (
                 assign,
                 gets,
                 getsAndModify,
                 maybeM,
                 repeatUntilM,
                 uses,
                 whenM,
                 with,
                ) where

import Control.Monad.Base   (MonadBase, liftBase)
import Control.Monad.Reader (MonadReader, ask)
import Control.Monad.State  (MonadState, get, gets, put, when)
import Lens.Micro.Platform (Getting, ASetter, (.=), use)

-- | Combination of the Control.Monad.State 'modify' and 'gets'
getsAndModify :: MonadState s m => (s -> (s,a)) -> m a
getsAndModify :: (s -> (s, a)) -> m a
getsAndModify s -> (s, a)
f = do
  s
e <- m s
forall s (m :: * -> *). MonadState s m => m s
get
  let (s
e',a
result) = s -> (s, a)
f s
e
  s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
e'
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

with :: (MonadReader r m, MonadBase b m) => (r -> a) -> (a -> b c) -> m c
with :: (r -> a) -> (a -> b c) -> m c
with r -> a
f a -> b c
g = do
    r
yi <- m r
forall r (m :: * -> *). MonadReader r m => m r
ask
    b c -> m c
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (b c -> m c) -> b c -> m c
forall a b. (a -> b) -> a -> b
$ a -> b c
g (r -> a
f r
yi)

whenM :: Monad m => m Bool -> m () -> m ()
whenM :: m Bool -> m () -> m ()
whenM m Bool
mtest m ()
ma = m Bool
mtest m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> m () -> m ()) -> m () -> Bool -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when m ()
ma

maybeM :: Monad m => (x -> m ()) -> Maybe x -> m ()
maybeM :: (x -> m ()) -> Maybe x -> m ()
maybeM x -> m ()
_ Maybe x
Nothing = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
maybeM x -> m ()
f (Just x
x) = x -> m ()
f x
x

-- | Rerun the monad until the boolean result is false, collecting list of results.
repeatUntilM :: Monad m => m (Bool,a) -> m [a]
repeatUntilM :: m (Bool, a) -> m [a]
repeatUntilM m (Bool, a)
m = do
  (Bool
proceed,a
x) <- m (Bool, a)
m
  if Bool
proceed 
    then (do [a]
xs <- m (Bool, a) -> m [a]
forall (m :: * -> *) a. Monad m => m (Bool, a) -> m [a]
repeatUntilM m (Bool, a)
m 
             [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs))
    else [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a
x]

assign :: MonadState s m => ASetter s s a b -> b -> m ()
assign :: ASetter s s a b -> b -> m ()
assign = ASetter s s a b -> b -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
(.=)

uses :: MonadState s m => Getting a s a -> (a -> b) -> m b
uses :: Getting a s a -> (a -> b) -> m b
uses Getting a s a
l a -> b
f = a -> b
f (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting a s a -> m a
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting a s a
l