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