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