diff --git a/CHANGELOG.md b/CHANGELOG.md index d7e5af83..24779ed9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,9 @@ Breaking changes: New features: +- Add lazily evaluated versions of the conditional functions for applicatives + and monads ifM', when', whenM', unless' and unlessM' (#313) + Bugfixes: Other improvements: diff --git a/src/Control/Applicative.purs b/src/Control/Applicative.purs index 6d444460..22ccec27 100644 --- a/src/Control/Applicative.purs +++ b/src/Control/Applicative.purs @@ -3,14 +3,18 @@ module Control.Applicative , pure , liftA1 , unless + , unless' , when + , when' , module Control.Apply , module Data.Functor ) where import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) +import Control.Category ((<<<)) import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) +import Data.HeytingAlgebra (not) import Data.Unit (Unit, unit) import Type.Proxy (Proxy(..)) @@ -64,7 +68,14 @@ when :: forall m. Applicative m => Boolean -> m Unit -> m Unit when true m = m when false _ = pure unit +-- | Construct an applicative action when a condition is true. +when' :: forall m a. Applicative m => (a -> Boolean) -> (a -> m Unit) -> a -> m Unit +when' f m a = if f a then m a else pure unit + -- | Perform an applicative action unless a condition is true. unless :: forall m. Applicative m => Boolean -> m Unit -> m Unit -unless false m = m -unless true _ = pure unit +unless = when <<< not + +-- | Construct an applicative action unless a condition is true. +unless' :: forall m a. Applicative m => (a -> Boolean) -> (a -> m Unit) -> a -> m Unit +unless' = when' <<< not diff --git a/src/Control/Bind.purs b/src/Control/Bind.purs index c6d8a6ae..b5574c9d 100644 --- a/src/Control/Bind.purs +++ b/src/Control/Bind.purs @@ -12,6 +12,7 @@ module Control.Bind , composeKleisliFlipped , (<=<) , ifM + , ifM' , module Data.Functor , module Control.Apply , module Control.Applicative @@ -148,3 +149,20 @@ infixr 1 composeKleisliFlipped as <=< -- | ``` ifM :: forall a m. Bind m => m Boolean -> m a -> m a -> m a ifM cond t f = cond >>= \cond' -> if cond' then t else f + +-- | Similar to `ifM` but for use in cases where one of the monadic actions may +-- | be expensive to construct. +-- | +-- | ```purescript +-- | main :: Effect Unit +-- | main = do +-- | response <- ifM' exists update create user +-- | log response +-- | +-- | where +-- | create :: User -> Effect String +-- | update :: User -> Effect String +-- | exists :: User -> Effect Boolean +-- | ``` +ifM' :: forall a b m. Bind m => (a -> m Boolean) -> (a -> m b) -> (a -> m b) -> a -> m b +ifM' cond t f a = cond a >>= \cond' -> if cond' then t a else f a diff --git a/src/Control/Monad.purs b/src/Control/Monad.purs index 3d8400ae..f1b67773 100644 --- a/src/Control/Monad.purs +++ b/src/Control/Monad.purs @@ -2,7 +2,9 @@ module Control.Monad ( class Monad , liftM1 , whenM + , whenM' , unlessM + , unlessM' , ap , module Data.Functor , module Control.Apply @@ -12,10 +14,13 @@ module Control.Monad import Control.Applicative (class Applicative, liftA1, pure, unless, when) import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) -import Control.Bind (class Bind, bind, ifM, join, (<=<), (=<<), (>=>), (>>=)) +import Control.Bind (class Bind, bind, join, (<=<), (=<<), (>=>), (>>=), ifM, ifM') +import Control.Category ((>>>)) +import Data.HeytingAlgebra (not) +import Data.Function (($)) import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) -import Data.Unit (Unit) +import Data.Unit (Unit, unit) import Type.Proxy (Proxy) -- | The `Monad` type class combines the operations of the `Bind` and @@ -55,16 +60,22 @@ liftM1 f a = do -- | Perform a monadic action when a condition is true, where the conditional -- | value is also in a monadic context. whenM :: forall m. Monad m => m Boolean -> m Unit -> m Unit -whenM mb m = do - b <- mb - when b m +whenM mb m = ifM mb m $ pure unit + +-- | Perform a monadic action when a condition is true, without constructing it +-- | otherwise, where the conditional value is also in a monadic context. +whenM' :: forall m a. Monad m => (a -> m Boolean) -> (a -> m Unit) -> a -> m Unit +whenM' mb m = ifM' mb m \_ -> pure unit -- | Perform a monadic action unless a condition is true, where the conditional -- | value is also in a monadic context. unlessM :: forall m. Monad m => m Boolean -> m Unit -> m Unit -unlessM mb m = do - b <- mb - unless b m +unlessM mb = whenM $ not <$> mb + +-- | Perform a monadic action unless a condition is true, without constructing +-- | it otherwise, where the conditional value is also in a monadic context. +unlessM' :: forall m a. Monad m => (a -> m Boolean) -> (a -> m Unit) -> a -> m Unit +unlessM' mb = whenM' \x -> mb x >>= not >>> pure -- | `ap` provides a default implementation of `(<*>)` for any `Monad`, without -- | using `(<*>)` as provided by the `Apply`-`Monad` superclass relationship. diff --git a/src/Prelude.purs b/src/Prelude.purs index 6f42076b..9a82f4fc 100644 --- a/src/Prelude.purs +++ b/src/Prelude.purs @@ -40,11 +40,11 @@ module Prelude , module Data.Void ) where -import Control.Applicative (class Applicative, pure, liftA1, unless, when) +import Control.Applicative (class Applicative, liftA1, pure, unless, unless', when, when') import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) -import Control.Bind (class Bind, bind, class Discard, discard, ifM, join, (<=<), (=<<), (>=>), (>>=)) +import Control.Bind (class Bind, bind, class Discard, discard, ifM, ifM', join, (<=<), (=<<), (>=>), (>>=)) import Control.Category (class Category, identity) -import Control.Monad (class Monad, liftM1, unlessM, whenM, ap) +import Control.Monad (class Monad, ap, liftM1, unlessM, unlessM', whenM, whenM') import Control.Semigroupoid (class Semigroupoid, compose, (<<<), (>>>)) import Data.Boolean (otherwise)