a monadic if or case?

David Roundy droundy@abridgegame.org
Thu, 13 Feb 2003 14:54:42 -0500


On Thu, Feb 13, 2003 at 01:21:35PM -0500, Dean Herington wrote:
> 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"

That's pretty nice (although not quite as nice as it would be to be able to
use real ifs with no extra parentheses).  Any idea how to do something like
this with a case? I imagine it's considerably harder, since case statements
do pattern matching, which is rather heavy duty syntactic sugar.  I often
have functions like

mp <- fun
case mp of
  Nothing -> deal with error
  Just p -> do something with p

where it would be much nicer to be able to just use

caseM fun of
  Nothing -> deal with error
  Just p -> do something with p

which would avoid confusion when reading the code as to whether the value
mp may be used later in the function.  Any ideas how to do something like
this?
-- 
David Roundy
http://civet.berkeley.edu/droundy/