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