a monadic if or case?

Dean Herington heringto@cs.unc.edu
Thu, 13 Feb 2003 13:21:35 -0500


Here's another way to sugar if-then-else that works like C's ?: and Lisp's cond:

import Monad (liftM3)
import Directory (doesFileExist, doesDirectoryExist)

infix 1 ?, ??

(?) :: Bool -> a -> a -> a
(c ? t) e = if c then t else e

(??) :: (Monad m) => m Bool -> m a -> m a -> m a
(??) = liftM3 (?)

main = do print $ 1>2 ? 1 $ 2
          print =<< fileType "foo"

fileType :: String -> IO String
fileType name = doesDirectoryExist name ?? return "dir"  $
                doesFileExist      name ?? return "file" $
                return "nothing"


-- Dean


Keith Wansbrough wrote:

> > Not with the syntactic sugar of 'if'.
> > But you can write [warning: untested code ahead]
> >
> > ifM :: IO Bool -> IO a -> IO a -> IO a
> > ifM test yes no = do
> >    b <- test
> >    if b then yes else no
>
> There is a little trick that allows you to "sort-of" get the syntactic sugar.  It goes like this [warning: also untested code]:
>
> data Then_ = Then_
> data Else_ = Else_
> then_ = Then_
> else_ = Else_
>
> ifM :: IO Bool -> Then_ -> IO a -> Else_ -> IO a -> IO a
> ifM test Then_ yes Else_ no = do
>   b <- test
>   if b then yes else no
>
> and then you can write
>
> ifM (doesDirectoryExist f)
>   then_ (return "dir")
>   else_ (ifM (doesFileExist f)
>            then_ (return "file")
>            else_ (return "nothing"))
>
> Note that this doesn't save you any parentheses, sadly, although there may be tricky ways to do that.
>
> References:
>
> LATOS uses this syntax; see http://www.dsse.ecs.soton.ac.uk/techreports/97-1.html
> [Pieter H. Hartel, 1997, LATOS - A Lightweight Animation Tool for Operational Semantics]
>
> http://www.eecs.usma.edu/Personnel/okasaki/pubs.html#hw02 [Chris Okasaki, Haskell Workshop 2002, Techniques for embedding postfix languages in Haskell]
>
> Enjoy!
>
> --KW 8-)
> --
> Keith Wansbrough <kw217@cl.cam.ac.uk>
> http://www.cl.cam.ac.uk/users/kw217/
> University of Cambridge Computer Laboratory.