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