Monads and Maybe

Doaitse Swierstra doaitse@cs.uu.nl
Thu, 21 Aug 2003 23:01:08 +0200


On dinsdag, aug 19, 2003, at 15:09 Europe/Amsterdam, C T McBride wrote:

> Hi
>
>>> As an example, I'll use the Maybe monad. Suppose I want to write 
>>> code to
>>> handle experimental data, in which there might be missing values. I 
>>> might
>>> then decide to represent measurements by data of type "Maybe 
>>> Double", with
>>> missing values represented by "Nothing". I could then go on to define
>>> functions on missing values, which would return "Nothing" when their
>>> argument is "Nothing", and I could string these functions together 
>>> via the
>>> monad mechanism. Fine.  But how would I handle e.g. addition of two 
>>> such
>>> values? The result should be "Nothing" when either of its arguments 
>>> is
>>> "Nothing". Is there any mechanism to handle that?
>>
>> Yes, liftM2. Defined in module Monad (or Data.Monad resp.).
>>
>>> Konrad.
>>
>> Wolfgang
>
> Or, more generally,
>
>   infixl 9 <$>
>
>   (<$>) :: Monad m => m (s -> t) -> m s -> m t
>   mf <$> ms =
>     do f <- mf
>        s <- ms
>        return (f s)

In my parsing libraries I have been using <$> for function with the 
type:

(<$>) :: Parser p => (a -> b) -> p a -> p b

Yes, I know that by making p a Functor this function would be called 
`map`, but since all my combiantors are of the <...> form I prefer 
this. Your <$> is written as <*>:

(<*>) :: Parser p => p ( b -> a) -> p b -> p a
(<* ) :: Parser p => p  a        -> p b -> p a
( *>) :: Parser p => p b         -> p a -> p a

etc

Now  one can combine parsers as in:

pVal =      (+) <$> pInteger <* pSymbol '+' <*> pInteger
        <|>  (*) <$> pInteger <* pSymbol '*' <*> pInteger

etc

Should I change this in future versions?

Doaitse Swierstra


>
> Now your lifted sum is
>
>   return (+) <$> mx <$> my
>
> Being a sick type class hacker (a symptom of the Haskell guilt caused 
> by
> working with dependent types) I've constructed an overloaded operator
>
>   fun :: Monad m => (t0 -> ... -> tn) -> (m t0 -> ... -> m tn)
>
> where tn is of ground type. Effectively
>
>   fun f x0 ... xn-1 = return f <$> x0 <$> ... <$> xn-1
>
> In fact, it's good to weaken the requirement (on fun and <^>) from 
> `being
> a Monad' to being Fun, where
>
>   class Fun f where
>     eta :: x -> f x
>     (<$>) :: f (s -> t) -> f s -> f t
>
> `supporting return and <$>', as there are plenty of such structures 
> which
> are not monadic (eg. lists wrt repeat and zipWith ($)).
>
> It's even more fun to work with lifted functors
>
>   class LFunctor f where
>     (<^>) :: Fun m => (s -> m t) -> f s -> m (f t)
>
> with, for example
>
>   instance LFunctor [] where
>     f <^> []       = fun []
>     f <^> (x : xs) = fun (:) (f x) (f <^> xs)
>
> You can use <^> to define mapping, flattening and all sorts of other
> goodies.
>
> What it comes down to, I suppose, is that sometimes we want to use the
> functional idiom to write programs modulo some modality, eg Maybe-ness
> statefulness, non-determinism, etc. I guess that Arrows generalize all
> this stuff still further, but the Fun class above is cheap and 
> remarkably
> cheerful. I use it all the time...
>
> Cheers
>
> Conor
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe