1{-# LANGUAGE CPP #-} 2 3{-| This module provides 'throwEither' and 'catchEither' for 'Either'. These two 4 functions reside here because 'throwEither' and 'catchEither' correspond to 'return' 5 and ('>>=') for the flipped 'Either' monad: 'EitherR'. Additionally, this 6 module defines 'handleE' as the flipped version of 'catchE' for 'ExceptT'. 7 8 'throwEither' and 'catchEither' improve upon @MonadError@ because: 9 10 * 'catchEither' is more general than 'catch' and allows you to change the left value's type 11 12 * Both are Haskell98 13 14 More advanced users can use 'EitherR' and 'ExceptRT' to program in an 15 entirely symmetric \"success monad\" where exceptional results are the norm 16 and successful results terminate the computation. This allows you to chain 17 error-handlers using @do@ notation and pass around exceptional values of 18 varying types until you can finally recover from the error: 19 20> runExceptRT $ do 21> e2 <- ioExceptionHandler e1 22> bool <- arithmeticExceptionhandler e2 23> when bool $ lift $ putStrLn "DEBUG: Arithmetic handler did something" 24 25 If any of the above error handlers 'succeed', no other handlers are tried. 26 27 If you choose not to typefully distinguish between the error and sucess 28 monad, then use 'flipEither' and 'flipET', which swap the type variables without 29 changing the type. 30-} 31 32module Data.EitherR ( 33 -- * EitherR 34 EitherR(..), 35 36 -- ** Operations in the EitherR monad 37 succeed, 38 39 -- ** Conversions to the Either monad 40 throwEither, 41 catchEither, 42 handleEither, 43 fmapL, 44 45 -- ** Flip alternative 46 flipEither, 47 48 -- * ExceptRT 49 ExceptRT(..), 50 51 -- ** Operations in the ExceptRT monad 52 succeedT, 53 54 -- ** Conversions to the ExceptT monad 55 handleE, 56 fmapLT, 57 58 -- ** Flip alternative 59 flipET, 60 ) where 61 62import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>))) 63import Control.Monad (liftM, ap, MonadPlus(mzero, mplus)) 64import Control.Monad.Trans.Class (MonadTrans(lift)) 65import Control.Monad.IO.Class (MonadIO(liftIO)) 66import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT, throwE, catchE) 67import Data.Monoid (Monoid(mempty, mappend)) 68 69import qualified Control.Monad.Trans.Except 70 71{-| If \"@Either e r@\" is the error monad, then \"@EitherR r e@\" is the 72 corresponding success monad, where: 73 74 * 'return' is 'throwEither'. 75 76 * ('>>=') is 'catchEither'. 77 78 * Successful results abort the computation 79-} 80newtype EitherR r e = EitherR { runEitherR :: Either e r } 81 82instance Functor (EitherR r) where 83 fmap = liftM 84 85instance Applicative (EitherR r) where 86 pure = return 87 (<*>) = ap 88 89instance Monad (EitherR r) where 90 return e = EitherR (Left e) 91 EitherR m >>= f = case m of 92 Left e -> f e 93 Right r -> EitherR (Right r) 94 95instance (Monoid r) => Alternative (EitherR r) where 96 empty = EitherR (Right mempty) 97 e1@(EitherR (Left _)) <|> _ = e1 98 _ <|> e2@(EitherR (Left _)) = e2 99 EitherR (Right r1) <|> EitherR (Right r2) 100 = EitherR (Right (mappend r1 r2)) 101 102instance (Monoid r) => MonadPlus (EitherR r) where 103 mzero = empty 104 mplus = (<|>) 105 106-- | Complete error handling, returning a result 107succeed :: r -> EitherR r e 108succeed r = EitherR (return r) 109 110-- | 'throwEither' in the error monad corresponds to 'return' in the success monad 111throwEither :: e -> Either e r 112throwEither e = runEitherR (return e) 113 114-- | 'catchEither' in the error monad corresponds to ('>>=') in the success monad 115catchEither :: Either a r -> (a -> Either b r) -> Either b r 116e `catchEither` f = runEitherR $ EitherR e >>= \a -> EitherR (f a) 117 118-- | 'catchEither' with the arguments flipped 119handleEither :: (a -> Either b r) -> Either a r -> Either b r 120handleEither = flip catchEither 121 122-- | Map a function over the 'Left' value of an 'Either' 123fmapL :: (a -> b) -> Either a r -> Either b r 124fmapL f = runEitherR . fmap f . EitherR 125 126-- | Flip the type variables of 'Either' 127flipEither :: Either a b -> Either b a 128flipEither e = case e of 129 Left a -> Right a 130 Right b -> Left b 131 132-- | 'EitherR' converted into a monad transformer 133newtype ExceptRT r m e = ExceptRT { runExceptRT :: ExceptT e m r } 134 135instance (Monad m) => Functor (ExceptRT r m) where 136 fmap = liftM 137 138instance (Monad m) => Applicative (ExceptRT r m) where 139 pure = return 140 (<*>) = ap 141 142instance (Monad m) => Monad (ExceptRT r m) where 143 return e = ExceptRT (throwE e) 144 m >>= f = ExceptRT $ ExceptT $ do 145 x <- runExceptT $ runExceptRT m 146 runExceptT $ runExceptRT $ case x of 147 Left e -> f e 148 Right r -> ExceptRT (return r) 149 150instance (Monad m, Monoid r) => Alternative (ExceptRT r m) where 151 empty = ExceptRT $ ExceptT $ return $ Right mempty 152 e1 <|> e2 = ExceptRT $ ExceptT $ do 153 x1 <- runExceptT $ runExceptRT e1 154 case x1 of 155 Left l -> return (Left l) 156 Right r1 -> do 157 x2 <- runExceptT $ runExceptRT e2 158 case x2 of 159 Left l -> return (Left l) 160 Right r2 -> return (Right (mappend r1 r2)) 161 162instance (Monad m, Monoid r) => MonadPlus (ExceptRT r m) where 163 mzero = empty 164 mplus = (<|>) 165 166instance MonadTrans (ExceptRT r) where 167 lift = ExceptRT . ExceptT . liftM Left 168 169instance (MonadIO m) => MonadIO (ExceptRT r m) where 170 liftIO = lift . liftIO 171 172-- | Complete error handling, returning a result 173succeedT :: (Monad m) => r -> ExceptRT r m e 174succeedT r = ExceptRT (return r) 175 176-- | 'catchE' with the arguments flipped 177handleE :: (Monad m) => (a -> ExceptT b m r) -> ExceptT a m r -> ExceptT b m r 178handleE = flip catchE 179 180-- | Map a function over the 'Left' value of an 'ExceptT' 181#if MIN_VERSION_base(4,8,0) 182fmapLT :: Functor m => (a -> b) -> ExceptT a m r -> ExceptT b m r 183fmapLT = Control.Monad.Trans.Except.withExceptT 184#else 185fmapLT :: (Monad m) => (a -> b) -> ExceptT a m r -> ExceptT b m r 186fmapLT f = runExceptRT . fmap f . ExceptRT 187#endif 188 189-- | Flip the type variables of an 'ExceptT' 190flipET :: (Monad m) => ExceptT a m b -> ExceptT b m a 191flipET = ExceptT . liftM flipEither . runExceptT 192