Created
October 25, 2019 10:36
-
-
Save darcykimball/eeada304b9b3b2e7b247b5fc05d754a8 to your computer and use it in GitHub Desktop.
Insomnia: `monad-loops`
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| -- There are some functions manipulating values of type Monad m => (a -> m Bool) | |
| -- in `monad-loops`. Feels like they're special cases of something more general? | |
| module MonadPred where | |
| import Data.Monoid (Any(..), All(..), First(..)) | |
| import Control.Monad (liftM2) | |
| import Control.Monad.Reader | |
| -- This is the implementation in `monad-loops`, more or less. | |
| andM :: Monad m => [m Bool] -> m Bool | |
| andM (x:xs) = do | |
| val <- x | |
| if val then andM xs else return False | |
| andM _ = return True | |
| -- Slightly less explicit...but no longer short-circuiting. | |
| andM' :: Monad m => [m Bool] -> m Bool | |
| andM' (x:xs) = liftM2 (&&) x (andM' xs) | |
| andM' _ = return True | |
| -- Even less explicit; same problem. | |
| andM'' :: Monad m => [m Bool] -> m Bool | |
| andM'' = foldr (liftM2 (&&)) (return True) | |
| -- So the problem might be that 'short-circuiting' has to be present alongside | |
| -- monadic effects. It's not enough that the combining function ((&&) here) is | |
| -- itself short-circuiting. Well, at least the original. The monadic one we | |
| -- pass just has to be short-circuiting. | |
| andM''' :: Monad m => [m Bool] -> m Bool | |
| andM''' = foldr andSM (return True) | |
| andSM :: Monad m => m Bool -> m Bool -> m Bool | |
| andSM x y = do | |
| val <- x | |
| if val then y else return False | |
| -- Is there a better way to abstract these? Holding that thought. | |
| -- Again, lifted from `monad-loops` | |
| allPM :: Monad m => [a -> m Bool] -> a -> m Bool | |
| allPM (p:ps) x = do | |
| value <- p x | |
| if value then allPM ps x else return False | |
| allPM _ _ = return True | |
| -- Less explicit, using the `Monad` instance for functions (reader monad). | |
| -- Of course, it also has the problem of not short-circuiting. | |
| allPM' :: Monad m => [a -> m Bool] -> a -> m Bool | |
| allPM' (p:ps) = liftM2 (liftM2 (&&)) p (allPM' ps) | |
| allPM' _ = const $ return True | |
| -- Using the same approach as with `andM`...works as expected. | |
| allPM'' :: Monad m => [a -> m Bool] -> a -> m Bool | |
| allPM'' = foldr (liftM2 andSM) (const $ return True) | |
| -- Slightly clearer(?) using monad transformers... | |
| type PredM a m = ReaderT a m Bool | |
| allPM''' :: Monad m => [a -> m Bool] -> a -> m Bool | |
| allPM''' = runReaderT . foldr andSM (return True) . map ReaderT | |
| -- And yeah, this is all just stuff on top of the monoids on `Bool` under | |
| -- conjunction and disjunction. Crucially, it seems that a `Monad` is necessary | |
| -- to actually be able to decide whether or not to proceed with the second | |
| -- effect. `Applicative`s have to perform both effects before applying `mappend` | |
| -- no matter what (static order). | |
| class Monoid a => Shorty a where | |
| squish :: Monad m => m a -> m a -> m a | |
| instance Shorty Any where | |
| squish x y = do | |
| Any value <- x | |
| if value then return (Any True) else y -- really, x <> y | |
| instance Shorty All where | |
| squish x y = do | |
| All value <- x | |
| if value then y else return (All False) | |
| -- Possibly less obvious... | |
| instance Shorty (First a) where | |
| squish x y = do | |
| First mx <- x | |
| maybe y (return . First . Just) mx | |
| foldShorty :: (Shorty a, Monad m, Foldable t) => t (m a) -> m a | |
| foldShorty = foldr squish (return mempty) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment