[Haskell-cafe] applicative challenge
Conor McBride
conor at strictlypositive.org
Mon May 4 17:49:56 EDT 2009
Hi Thomas
This is "iffy versus miffy", a standard applicative problem.
When you use the result of one computation to choose the
next computation (e.g., to decide whether you want to keep
doing-and-taking), that's when you need yer actual monad.
It's the join of a monad that lets you compute computations.
The applicative interface does not allow any interference
between the value and computation layers. It's enough for
effects which facilitate but do not determine the flow of
computation (e.g. threading an environment, counting how
often something happens, etc...).
So, you ask a sensible...
On 4 May 2009, at 22:15, Thomas Hartman wrote:
> {-# LANGUAGE NoMonomorphismRestriction #-}
> import Data.List
> import Control.Monad
> import Control.Applicative
>
> -- Can the function below be tweaked to quit on blank input,
> provisioned in the applicative style?
> -- which function(s) needs to be rewritten to make it so?
> -- Can you tell/guess which function(s) is the problem just by looking
> at the code below?
> -- If so, can you explain what the strategy for doing so is?
...nostril question.
>
> notQuiteRight = takeWhile (not . blank) <$> ( sequence . repeat $
> echo )
^^^
Here, we're doing all the computations, then post-processing the values
with a pure function. There's no way the pure function can tell the
computation to stop bothering.
> echo = do
> l <- getLine
> putStrLn l
> return l
>
>
> -- this seems to work... is there a way to make it work Applicatively,
> with lifted takeWhile?
> seemsToWork = sequenceWhile_ (not . blank) (repeat echo)
>
> sequenceWhile_ p [] = return ()
> sequenceWhile_ p (mx:mxs) = do
> x <- mx
> if p x
^^^
Here, you're exactly using the result of a computation to choose
which computations come next. That's a genuinely monadic thing to
do: miffy not iffy.
>
> then do sequenceWhile_ p mxs
> else return ()
If you're wondering what I'm talking about, let me remind/inform
you of the definitions.
iffy :: Applicative a => a Bool -> a t -> a t -> a t
iffy test yes no = cond <$> test <*> yes <*> no where
cond b y n = if b then y else n
miffy :: Monad m => m Bool -> m t -> m t -> m t
miffy test yes no = do
b <- test
if b then yes else no
Apologies for slang/pop-culture references, but
"iffy" means dubious, questionable, untrustworthy
"miffy" is a cute Dutch cartoon character drawn by Dick Bruna
The effect of
iffy askPresident launchMissiles seekUNResolution
is to ask the President, then launch the missiles, then lobby the
UN, then decide that the result of seeking a UN resolution is
preferable.
Remember folks: Missiles need miffy!
Cheers
Conor
More information about the Haskell-Cafe
mailing list