-- Standard combinators, specialised
returnM, thenM, thenM_, failM, failWithM,
mappM, mappM_, mapSndM, sequenceM, sequenceM_,
- foldlM, foldrM,
+ foldlM, foldrM, anyM,
mapAndUnzipM, mapAndUnzip3M,
checkM, ifM, zipWithM, zipWithM_,
tryM, tryAllM, tryMostM, fixM,
-- I/O operations
- ioToIOEnv,
IORef, newMutVar, readMutVar, writeMutVar, updMutVar
) where
#include "HsVersions.h"
import Panic ( try, tryUser, tryMost, Exception(..) )
-import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
+import Data.IORef ( IORef, newIORef, readIORef, writeIORef, modifyIORef )
import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO ( fixIO )
-
+import MonadUtils
----------------------------------------------------------------------
-- Defining the monad type
unIOEnv (IOEnv m) = m
instance Monad (IOEnv m) where
- (>>=) = thenM
- (>>) = thenM_
- return = returnM
- fail s = failM -- Ignore the string
+ (>>=) = thenM
+ (>>) = thenM_
+ return = returnM
+ fail s = failM -- Ignore the string
+
+instance Applicative (IOEnv m) where
+ pure = returnM
+ IOEnv f <*> IOEnv x = IOEnv (\ env -> f env <*> x env )
instance Functor (IOEnv m) where
- fmap f (IOEnv m) = IOEnv (\ env -> fmap f (m env))
+ fmap f (IOEnv m) = IOEnv (\ env -> fmap f (m env))
returnM :: a -> IOEnv env a
returnM a = IOEnv (\ env -> return a)
-- Accessing input/output
----------------------------------------------------------------------
-ioToIOEnv :: IO a -> IOEnv env a
-ioToIOEnv io = IOEnv (\ env -> io)
+instance MonadIO (IOEnv env) where
+ liftIO io = IOEnv (\ env -> io)
newMutVar :: a -> IOEnv env (IORef a)
-newMutVar val = IOEnv (\ env -> newIORef val)
+newMutVar val = liftIO (newIORef val)
writeMutVar :: IORef a -> a -> IOEnv env ()
-writeMutVar var val = IOEnv (\ env -> writeIORef var val)
+writeMutVar var val = liftIO (writeIORef var val)
readMutVar :: IORef a -> IOEnv env a
-readMutVar var = IOEnv (\ env -> readIORef var)
+readMutVar var = liftIO (readIORef var)
-updMutVar :: IORef a -> (a->a) -> IOEnv env ()
-updMutVar var upd_fn = IOEnv (\ env -> do { v <- readIORef var; writeIORef var (upd_fn v) })
+updMutVar :: IORef a -> (a -> a) -> IOEnv env ()
+updMutVar var upd = liftIO (modifyIORef var upd)
----------------------------------------------------------------------
mapAndUnzip3M :: (a -> IOEnv env (b,c,d)) -> [a] -> IOEnv env ([b],[c],[d])
checkM :: Bool -> IOEnv env a -> IOEnv env () -- Perform arg if bool is False
ifM :: Bool -> IOEnv env a -> IOEnv env () -- Perform arg if bool is True
+anyM :: (a -> IOEnv env Bool) -> [a] -> IOEnv env Bool
mappM f [] = return []
mappM f (x:xs) = do { r <- f x; rs <- mappM f xs; return (r:rs) }
mappM_ f [] = return ()
mappM_ f (x:xs) = f x >> mappM_ f xs
+anyM f [] = return False
+anyM f (x:xs) = do { b <- f x; if b then return True
+ else anyM f xs }
+
zipWithM :: (a -> b -> IOEnv env c) -> [a] -> [b] -> IOEnv env [c]
zipWithM f [] bs = return []
zipWithM f as [] = return []