a monadic if or case?

Dean Herington heringto@cs.unc.edu
Thu, 13 Feb 2003 17:05:46 -0500 (EST)


On Thu, 13 Feb 2003, David Roundy wrote:

> 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?

Not really.  As you point out, the difficulty is the patttern matching.

However, I often use `maybe` in cases such as your example:

  fun >>= maybe (deal with error) (\p -> do something with p)

as long as the alternatives are not too long.  Then it's very clear that
there are no other references to the scrutinee.  And, of course, there are
other functions like `maybe` for other types.  The Prelude defines
`either`, and I've defined `bool`, `ordering`, `list`, and `tuple<n>`.

-- Dean