MaybeT-0.1.2/0000755000000000000000000000000011123324523011055 5ustar0000000000000000MaybeT-0.1.2/Setup.hs0000644000000000000000000000005611123324523012512 0ustar0000000000000000import Distribution.Simple main = defaultMain MaybeT-0.1.2/MaybeT.cabal0000644000000000000000000000101211123324523013214 0ustar0000000000000000Name: MaybeT Version: 0.1.2 Synopsis: MaybeT monad transformer Description: Support for computations with failures. License: BSD3 License-file: LICENSE Category: Control Author: Eric Kidd Maintainer: Eric Kidd Stability: experimental Build-Type: Simple Build-Depends: base, mtl Exposed-modules: Control.Monad.Maybe ghc-options: -Wall MaybeT-0.1.2/LICENSE0000644000000000000000000000272511123324523012070 0ustar0000000000000000MaybeT monad transformer. Copyright 2007 Eric Kidd. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of this library's contributors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. MaybeT-0.1.2/Control/0000755000000000000000000000000011123324523012475 5ustar0000000000000000MaybeT-0.1.2/Control/Monad/0000755000000000000000000000000011123324523013533 5ustar0000000000000000MaybeT-0.1.2/Control/Monad/Maybe.hs0000644000000000000000000001161611123324523015131 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} {- | Copyright : 2007 Eric Kidd License : BSD3 Stability : experimental Portability : non-portable (multi-parameter type classes, undecidable instances) The 'MaybeT' monad. See for more widely-used version. Our 'Functor' instance and our implementation of '>>=' are borrowed from there. [Computation type:] Computations which may fail or return nothing. [Binding strategy:] Failure returns the value 'Nothing', bypassing any bound functions which follow. Success returns a value wrapped in 'Just'. [Useful for:] Building computations from steps which may fail. No error information is returned. (If error information is required, see 'Control.Monad.Error'.) -} module Control.Monad.Maybe ( MaybeT(..) -- * Limitations -- $Limitations -- * Example -- $MaybeExample ) where import Control.Monad() import Control.Monad.Trans() import Control.Monad.Cont import Control.Monad.Fix() import Control.Monad.Reader import Control.Monad.State import Control.Monad.Writer -- | A monad transformer which adds Maybe semantics to an existing monad. newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } instance (Functor m) => Functor (MaybeT m) where fmap f = MaybeT . fmap (fmap f) . runMaybeT instance (Monad m) => Monad (MaybeT m) where fail _ = MaybeT (return Nothing) return = lift . return x >>= f = MaybeT (runMaybeT x >>= maybe (return Nothing) (runMaybeT . f)) instance (Monad m) => MonadPlus (MaybeT m) where mzero = MaybeT (return Nothing) mplus x y = MaybeT $ do v <- runMaybeT x case v of Nothing -> runMaybeT y Just _ -> return v instance MonadTrans MaybeT where lift x = MaybeT (liftM Just x) instance (MonadCont m) => MonadCont (MaybeT m) where -- Again, I hope this is correct. callCC f = MaybeT (callCC (\c -> runMaybeT (f (wrap c)))) where wrap :: (Maybe a -> m (Maybe b)) -> a -> MaybeT m b wrap c = MaybeT . c . Just -- MonadError: MonadError has fairly weird semantics when lifted by MaybeT, -- so let's skip it for now. instance (MonadIO m) => MonadIO (MaybeT m) where liftIO = lift . liftIO instance (MonadFix m) => MonadFix (MaybeT m) where -- I hope this is correct. At a minimum, it typechecks. mfix f = MaybeT (mfix (maybe (return Nothing) (runMaybeT . f))) -- MonadList: Not implemented. -- MonadPlus: Ambiguous. See note in introduction. -- Requires -fallow-undecidable-instances. instance (MonadReader r m) => MonadReader r (MaybeT m) where ask = lift ask local f m = MaybeT (local f (runMaybeT m)) -- MonadRWS: Not implemented. -- Taken from http://www.haskell.org/haskellwiki/New_monads/MaybeT . instance MonadState s m => MonadState s (MaybeT m) where get = lift get put = lift . put -- Requires -fallow-undecidable-instances. instance (MonadWriter w m) => MonadWriter w (MaybeT m) where tell = lift . tell listen m = MaybeT (listen (runMaybeT m) >>= (return . liftMaybe)) where liftMaybe (Nothing, _) = Nothing liftMaybe (Just x, w) = Just (x,w) -- I'm not sure this is useful, but it's the best I can do: pass m = MaybeT (runMaybeT m >>= maybe (return Nothing) (liftM Just . pass . return)) {- $Limitations The instance @MonadPlus@ is not provided, because it has ambiguous semantics. It could refer to either >instance MonadPlus m => MonadPlus (MaybeT m) ...lifting the semantics of an underlying 'MaybeT' monad, or >instance MonadPlus (MaybeT m) ...with semantics similar to @MonadPlus Maybe@. -} {- $MaybeExample Here is an example that shows how to use 'MaybeT' to propagate an end-of-file condition in the IO monad. In the example below, both @maybeReadLine@ and @failIfQuit@ may cause a failure, which will propagate out to @main@ without further intervention. >import System.Console.Readline >import Data.Maybe >import Control.Monad >import Control.Monad.Trans >import Control.Monad.Maybe > >-- 'MaybeIO' is the type of computations which do IO, and which may fail. >type MaybeIO = MaybeT IO > >-- 'readline' already has type 'String -> IO (Maybe String)'; we just need >-- to wrap it. >maybeReadLine :: String -> MaybeIO String >maybeReadLine prompt = MaybeT (readline prompt) > >-- Fail if 'str' equals "quit". >failIfQuit :: (Monad m) => String -> m () >failIfQuit str = when (str == "quit") (fail "Quitting") > >-- This task may fail in several places. Try typing Control-D or "quit" at >-- any prompt. >concatTwoInputs :: MaybeIO () >concatTwoInputs = do > s1 <- maybeReadLine "String 1> " > failIfQuit s1 > s2 <- maybeReadLine "String 2> " > failIfQuit s2 > liftIO (putStrLn ("Concatenated: " ++ s1 ++ s2)) > >-- Loop until failure. >main :: IO () >main = do > result <- runMaybeT concatTwoInputs > if isNothing result > then putStrLn "Bye!" > else main -}