Package environments
[ghc.git] / compiler / utils / Maybes.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 -}
5
6 {-# LANGUAGE CPP #-}
7 module Maybes (
8 module Data.Maybe,
9
10 MaybeErr(..), -- Instance of Monad
11 failME, isSuccess,
12
13 orElse,
14 firstJust, firstJusts,
15 whenIsJust,
16 expectJust,
17
18 MaybeT(..), liftMaybeT
19 ) where
20
21 import Control.Applicative
22 import Control.Monad
23 import Data.Maybe
24
25 infixr 4 `orElse`
26
27 {-
28 ************************************************************************
29 * *
30 \subsection[Maybe type]{The @Maybe@ type}
31 * *
32 ************************************************************************
33 -}
34
35 firstJust :: Maybe a -> Maybe a -> Maybe a
36 firstJust a b = firstJusts [a, b]
37
38 -- | Takes a list of @Maybes@ and returns the first @Just@ if there is one, or
39 -- @Nothing@ otherwise.
40 firstJusts :: [Maybe a] -> Maybe a
41 firstJusts = msum
42
43 expectJust :: String -> Maybe a -> a
44 {-# INLINE expectJust #-}
45 expectJust _ (Just x) = x
46 expectJust err Nothing = error ("expectJust " ++ err)
47
48 whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
49 whenIsJust (Just x) f = f x
50 whenIsJust Nothing _ = return ()
51
52 -- | Flipped version of @fromMaybe@, useful for chaining.
53 orElse :: Maybe a -> a -> a
54 orElse = flip fromMaybe
55
56 {-
57 ************************************************************************
58 * *
59 \subsection[MaybeT type]{The @MaybeT@ monad transformer}
60 * *
61 ************************************************************************
62 -}
63
64 newtype MaybeT m a = MaybeT {runMaybeT :: m (Maybe a)}
65
66 instance Functor m => Functor (MaybeT m) where
67 fmap f x = MaybeT $ fmap (fmap f) $ runMaybeT x
68
69 #if __GLASGOW_HASKELL__ < 710
70 -- Pre-AMP change
71 instance (Monad m, Functor m) => Applicative (MaybeT m) where
72 #else
73 instance (Monad m) => Applicative (MaybeT m) where
74 #endif
75 pure = return
76 (<*>) = ap
77
78 instance Monad m => Monad (MaybeT m) where
79 return = MaybeT . return . Just
80 x >>= f = MaybeT $ runMaybeT x >>= maybe (return Nothing) (runMaybeT . f)
81 fail _ = MaybeT $ return Nothing
82
83 #if __GLASGOW_HASKELL__ < 710
84 -- Pre-AMP change
85 instance (Monad m, Functor m) => Alternative (MaybeT m) where
86 #else
87 instance (Monad m) => Alternative (MaybeT m) where
88 #endif
89 empty = mzero
90 (<|>) = mplus
91
92 instance Monad m => MonadPlus (MaybeT m) where
93 mzero = MaybeT $ return Nothing
94 p `mplus` q = MaybeT $ do ma <- runMaybeT p
95 case ma of
96 Just a -> return (Just a)
97 Nothing -> runMaybeT q
98
99 liftMaybeT :: Monad m => m a -> MaybeT m a
100 liftMaybeT act = MaybeT $ Just `liftM` act
101
102 {-
103 ************************************************************************
104 * *
105 \subsection[MaybeErr type]{The @MaybeErr@ type}
106 * *
107 ************************************************************************
108 -}
109
110 data MaybeErr err val = Succeeded val | Failed err
111
112 instance Functor (MaybeErr err) where
113 fmap = liftM
114
115 instance Applicative (MaybeErr err) where
116 pure = return
117 (<*>) = ap
118
119 instance Monad (MaybeErr err) where
120 return v = Succeeded v
121 Succeeded v >>= k = k v
122 Failed e >>= _ = Failed e
123
124 isSuccess :: MaybeErr err val -> Bool
125 isSuccess (Succeeded {}) = True
126 isSuccess (Failed {}) = False
127
128 failME :: err -> MaybeErr err val
129 failME e = Failed e