never executed always true always false

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