1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}
module GHC.Data.Maybe (
module Data.Maybe,
MaybeErr(..), -- Instance of Monad
failME, isSuccess,
orElse,
firstJust, firstJusts, firstJustsM,
whenIsJust,
expectJust,
rightToMaybe,
-- * MaybeT
MaybeT(..), liftMaybeT, tryMaybeT
) where
import GHC.Prelude
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Exception (catch, SomeException(..))
import Data.Maybe
import Data.Foldable ( foldlM )
import GHC.Utils.Misc (HasCallStack)
infixr 4 `orElse`
{-
************************************************************************
* *
\subsection[Maybe type]{The @Maybe@ type}
* *
************************************************************************
-}
firstJust :: Maybe a -> Maybe a -> Maybe a
firstJust a b = firstJusts [a, b]
-- | Takes a list of @Maybes@ and returns the first @Just@ if there is one, or
-- @Nothing@ otherwise.
firstJusts :: [Maybe a] -> Maybe a
firstJusts = msum
-- | Takes computations returnings @Maybes@; tries each one in order.
-- The first one to return a @Just@ wins. Returns @Nothing@ if all computations
-- return @Nothing@.
firstJustsM :: (Monad m, Foldable f) => f (m (Maybe a)) -> m (Maybe a)
firstJustsM = foldlM go Nothing where
go :: Monad m => Maybe a -> m (Maybe a) -> m (Maybe a)
go Nothing action = action
go result@(Just _) _action = return result
expectJust :: HasCallStack => String -> Maybe a -> a
{-# INLINE expectJust #-}
expectJust _ (Just x) = x
expectJust err Nothing = error ("expectJust " ++ err)
whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
whenIsJust (Just x) f = f x
whenIsJust Nothing _ = return ()
-- | Flipped version of @fromMaybe@, useful for chaining.
orElse :: Maybe a -> a -> a
orElse = flip fromMaybe
rightToMaybe :: Either a b -> Maybe b
rightToMaybe (Left _) = Nothing
rightToMaybe (Right x) = Just x
{-
************************************************************************
* *
\subsection[MaybeT type]{The @MaybeT@ monad transformer}
* *
************************************************************************
-}
-- We had our own MaybeT in the past. Now we reuse transformer's MaybeT
liftMaybeT :: Monad m => m a -> MaybeT m a
liftMaybeT act = MaybeT $ Just `liftM` act
-- | Try performing an 'IO' action, failing on error.
tryMaybeT :: IO a -> MaybeT IO a
tryMaybeT action = MaybeT $ catch (Just `fmap` action) handler
where
handler (SomeException _) = return Nothing
{-
************************************************************************
* *
\subsection[MaybeErr type]{The @MaybeErr@ type}
* *
************************************************************************
-}
data MaybeErr err val = Succeeded val | Failed err
deriving (Functor)
instance Applicative (MaybeErr err) where
pure = Succeeded
(<*>) = ap
instance Monad (MaybeErr err) where
Succeeded v >>= k = k v
Failed e >>= _ = Failed e
isSuccess :: MaybeErr err val -> Bool
isSuccess (Succeeded {}) = True
isSuccess (Failed {}) = False
failME :: err -> MaybeErr err val
failME e = Failed e
|
