These functions were formerly located in a module called "HugsUtils" --
but it was too messy to make it a "standard Hugs library"
so we moved it over here.

> module Haskore.General.Monad where

> import Control.Monad (MonadPlus, mplus, liftM2)

ToDo: decide on appropriate fixities for these functions

\begin{haskelllisting}

> infixr 2 `andOnError`, `butOnError`
> 
> assert :: Bool -> String -> IO ()
> assert True _    = return ()
> assert False msg = ioError (userError msg)

\end{haskelllisting}

Resource (de)allocation can interact badly with error handling code.
For example, even if the programmer has taken care that every
resource allocation is paired with an appropriate deallocation,
they might forget to release resources when an exception is
invoked.  For example, this program would fail to close
\code{outFile} if an error occured while operating on one of the \code{inFile}s.

\begin{haskelllisting}

  cat :: String -> [String] -> IO ()
  cat outfile files = do
    outFile <- open outfile WriteMode
    mapM_ (\file -> do
         inFile <- open file ReadMode
         copy inFile outFile
         close inFile
       ) 
      files
    close outFile

\end{haskelllisting}

The following functions provide ways of ensuring that a piece of
"cleanup code" is executed even if an exception is raised.

\begin{itemize}
\item
  \lstinline!m `andOnError` k!  is like \lstinline!m >> k! except that \code{k} gets executed
    even if an exception is raised in \code{m}.
\item
  \lstinline!m `butOnError` k! is like \code{m} except that \code{k} gets executed if
    an exception is raised in \code{m}.
\end{itemize}

For example, the following version of \code{cat} guarantees to close all
files even if an error occurs.

\begin{haskelllisting}

  cleancat :: String -> [String] -> IO ()
  cleancat outfile files = do
    outFile <- open outfile WriteMode
    mapM_ (\file -> do
         open file ReadMode   >>= \ inFile ->
         copy inFile outFile  `andOnError`
         close inFile
       ) 
      files
     `andOnError`
      close outFile

\end{haskelllisting}

\begin{haskelllisting}

> andOnError :: IO a -> IO b -> IO b
> m `andOnError` k = (m `catch` \e -> k >> ioError e) >> k

\end{haskelllisting}

Use this to add some cleanup code k that only gets executed
if an error occurs during execution of m.

\begin{haskelllisting}

> butOnError :: IO a -> IO () -> IO a
> m `butOnError` k = (m `catch` \e -> k >> ioError e)

> zeroOrMore, oneOrMore :: MonadPlus m => m a -> m [a]
> zeroOrMore m      = return [] `mplus` oneOrMore m
> oneOrMore  m      = liftM2 (:) m (zeroOrMore m)

\end{haskelllisting}

Repeat the action \code{m} until the result fulfills \code{p}.

\begin{haskelllisting}

> untilM :: Monad m => (a -> Bool) -> m a -> m a
> untilM p m =
>    do x <- m
>       if p x then return x else untilM p m

\end{haskelllisting}