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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}
{-# LANGUAGE CPP #-}
module Maybes (
module Data.Maybe,
MaybeErr(..), -- Instance of Monad
failME, isSuccess,
orElse,
firstJust, firstJusts,
whenIsJust,
expectJust,
MaybeT(..), liftMaybeT
) where
import Control.Applicative
import Control.Monad
import Data.Maybe
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
expectJust :: 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
{-
************************************************************************
* *
\subsection[MaybeT type]{The @MaybeT@ monad transformer}
* *
************************************************************************
-}
newtype MaybeT m a = MaybeT {runMaybeT :: m (Maybe a)}
instance Functor m => Functor (MaybeT m) where
fmap f x = MaybeT $ fmap (fmap f) $ runMaybeT x
#if __GLASGOW_HASKELL__ < 710
-- Pre-AMP change
instance (Monad m, Applicative m) => Applicative (MaybeT m) where
#else
instance (Monad m) => Applicative (MaybeT m) where
#endif
pure = MaybeT . pure . Just
(<*>) = ap
#if __GLASGOW_HASKELL__ < 710
-- Pre-AMP change
instance (Monad m, Applicative m) => Monad (MaybeT m) where
#else
instance (Monad m) => Monad (MaybeT m) where
#endif
return = pure
x >>= f = MaybeT $ runMaybeT x >>= maybe (pure Nothing) (runMaybeT . f)
fail _ = MaybeT $ pure Nothing
#if __GLASGOW_HASKELL__ < 710
-- Pre-AMP change
instance (Monad m, Applicative m) => Alternative (MaybeT m) where
#else
instance (Monad m) => Alternative (MaybeT m) where
#endif
empty = mzero
(<|>) = mplus
#if __GLASGOW_HASKELL__ < 710
-- Pre-AMP change
instance (Monad m, Applicative m) => MonadPlus (MaybeT m) where
#else
instance Monad m => MonadPlus (MaybeT m) where
#endif
mzero = MaybeT $ pure Nothing
p `mplus` q = MaybeT $ do ma <- runMaybeT p
case ma of
Just a -> pure (Just a)
Nothing -> runMaybeT q
liftMaybeT :: Monad m => m a -> MaybeT m a
liftMaybeT act = MaybeT $ Just `liftM` act
{-
************************************************************************
* *
\subsection[MaybeErr type]{The @MaybeErr@ type}
* *
************************************************************************
-}
data MaybeErr err val = Succeeded val | Failed err
instance Functor (MaybeErr err) where
fmap = liftM
instance Applicative (MaybeErr err) where
pure = Succeeded
(<*>) = ap
instance Monad (MaybeErr err) where
return = pure
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
|
