implement double-to-float narrowing in the x86 NCG (#4441)
[ghc-hetmet.git] / compiler / utils / Maybes.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5
6 \begin{code}
7 module Maybes (
8         module Data.Maybe,
9
10         MaybeErr(..), -- Instance of Monad
11         failME, isSuccess,
12
13         fmapM_maybe,
14         orElse,
15         mapCatMaybes,
16         allMaybes,
17         firstJust, firstJusts,
18         expectJust,
19         maybeToBool,
20
21         MaybeT(..)
22     ) where
23
24 import Data.Maybe
25
26 infixr 4 `orElse`
27 \end{code}
28
29 %************************************************************************
30 %*                                                                      *
31 \subsection[Maybe type]{The @Maybe@ type}
32 %*                                                                      *
33 %************************************************************************
34
35 \begin{code}
36 maybeToBool :: Maybe a -> Bool
37 maybeToBool Nothing  = False
38 maybeToBool (Just _) = True
39
40 -- | Collects a list of @Justs@ into a single @Just@, returning @Nothing@ if
41 -- there are any @Nothings@.
42 allMaybes :: [Maybe a] -> Maybe [a]
43 allMaybes [] = Just []
44 allMaybes (Nothing : _)  = Nothing
45 allMaybes (Just x  : ms) = case allMaybes ms of
46                            Nothing -> Nothing
47                            Just xs -> Just (x:xs)
48
49 firstJust :: Maybe a -> Maybe a -> Maybe a
50 firstJust (Just a) _ = Just a
51 firstJust Nothing  b = b
52
53 -- | Takes a list of @Maybes@ and returns the first @Just@ if there is one, or
54 -- @Nothing@ otherwise.
55 firstJusts :: [Maybe a] -> Maybe a
56 firstJusts = foldr firstJust Nothing
57 \end{code}
58
59 \begin{code}
60 expectJust :: String -> Maybe a -> a
61 {-# INLINE expectJust #-}
62 expectJust _   (Just x) = x
63 expectJust err Nothing  = error ("expectJust " ++ err)
64 \end{code}
65
66 \begin{code}
67 mapCatMaybes :: (a -> Maybe b) -> [a] -> [b]
68 mapCatMaybes _ [] = []
69 mapCatMaybes f (x:xs) = case f x of
70                         Just y  -> y : mapCatMaybes f xs
71                         Nothing -> mapCatMaybes f xs
72 \end{code}
73
74 \begin{code}
75
76 orElse :: Maybe a -> a -> a
77 (Just x) `orElse` _ = x
78 Nothing  `orElse` y = y
79 \end{code}
80
81 \begin{code}
82 fmapM_maybe :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
83 fmapM_maybe _ Nothing = return Nothing
84 fmapM_maybe f (Just x) = do
85         x' <- f x
86         return $ Just x'
87 \end{code}
88
89 %************************************************************************
90 %*                                                                      *
91 \subsection[MaybeT type]{The @MaybeT@ monad transformer}
92 %*                                                                      *
93 %************************************************************************
94
95 \begin{code}
96
97 newtype MaybeT m a = MaybeT {runMaybeT :: m (Maybe a)}
98
99 instance Functor m => Functor (MaybeT m) where
100   fmap f x = MaybeT $ fmap (fmap f) $ runMaybeT x
101
102 instance Monad m => Monad (MaybeT m) where
103   return = MaybeT . return . Just
104   x >>= f = MaybeT $ runMaybeT x >>= maybe (return Nothing) (runMaybeT . f)
105   fail _ = MaybeT $ return Nothing
106
107 \end{code}
108
109
110 %************************************************************************
111 %*                                                                      *
112 \subsection[MaybeErr type]{The @MaybeErr@ type}
113 %*                                                                      *
114 %************************************************************************
115
116 \begin{code}
117 data MaybeErr err val = Succeeded val | Failed err
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
130 \end{code}