[Haskell-cafe] Monadic vs "pure" style (was: pros and cons of
sta tic typing and side effects)
Juan Carlos Arevalo Baeza
jcab.lists at JCABs-Rumblings.com
Thu Sep 1 04:03:15 EDT 2005
Ben Lippmeier wrote:
>> to monads. If the idea is most clearly expressed
>> as a monad, use a monad. If the idea is most
>> clearly expressed recursively, write it recursively
>> (but perhaps wrap it in "return").
>
> There is no inherent advantage or disadvantage
>
> Perhaps the "inherent disadvantage" is that functions written in the
> monadic style must have different types compared with their
> conceptually similar non-monadic functions..
>
> mapM :: Monad m => (a -> m b) -> [a] -> m [b]
> map :: (a -> b) -> [a] -> [b]
>
> filter :: (a -> Bool) -> [a] -> [a]
> filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
>
> foldl :: (a -> b -> a) -> a -> [b] -> a
> foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
>
> Some would say "but they're different functions!", others would say
> "close enough".
Heh... I recently was experimenting with this separation... Check
this out. If the Num class had been defined without having "Eq" as a
prerequisite, you could do something like this:
---8<---------------------------------
class MyNum v where
(.+) :: v -> v -> v
instance MyNum Int where
(.+) a b = a + b
instance (Monad m, MyNum v) => MyNum (m v) where
(.+) a b = do
ra <- a
rb <- b
return (ra .+ rb)
two = return 2 :: IO Int
three = return 3 :: IO Int
main = do
result <- two .+ three
putStr $ show result
---8<---------------------------------
I defined an operator to add Ints and made it work fine in a monadic
environment.
See what happened? Easy. Problem is, Num is a subclass of Eq (for no
apparent technical reason, only for expressivity), which prevents using
this mechanism with it. Eq could have been defined to parameterize on
the boolean value (using multiparameter classes and functional
dependencies, so no wonder it isn't):
---8<---------------------------------
class MyEq v b | v -> b where
(.==) :: v -> v -> b
instance MyEq Int Bool where
(.==) a b = a == b
instance (Monad m, MyEq v b) => MyEq (m v) (m b) where
(.==) a b = do
ra <- a
rb <- b
return (ra .== rb)
two = return 2 :: IO Int
three = return 3 :: IO Int
main = do
cond <- two .== three
putStrLn $ show cond
---8<---------------------------------
> I imagine this would be an absolute pain for library writers. Notice
> that we get Data.Map.map but no Data.Map.mapM - or perhaps there's
> some magical lifting combinator that I am not aware of?
The above works great. Not with the standard libraries, of course,
but you can always use it in your own classes. I'm not sure yet what the
"catch" will be, but it sounds like a pattern worth investigating. The
same thing, I suspect, can be done with arrows. Maybe some day syntactic
sugar can be added to overlay functions safely like this without having
to manually create a class and two instances for it.
Just beware: to make this
JCAB
More information about the Haskell-Cafe
mailing list