diff --git a/AbortT-transformers.cabal b/AbortT-transformers.cabal new file mode 100644 --- /dev/null +++ b/AbortT-transformers.cabal @@ -0,0 +1,18 @@ +Name: AbortT-transformers +Version: 1.0 +License: BSD3 +License-file: LICENSE +Author: Gregory Crosswhite +Maintainer: Gregory Crosswhite +Stability: Provisional +Homepage: http://github.com/gcross/AbortT-transformers +Synopsis: A monad and monadic transformer providing "abort" functionality +Description: This module provides a monad and a monad transformer that allow the user to abort a monadic computation and immediately return a result. +Cabal-version: >=1.2.3 +Build-type: Simple +Category: Control + +Library + Build-depends: base >= 3 && < 5, + transformers >= 0.2 && <0.3 + Exposed-modules: Control.Monad.Trans.Abort diff --git a/Control/Monad/Trans/Abort.hs b/Control/Monad/Trans/Abort.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Trans/Abort.hs @@ -0,0 +1,102 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.Trans.Abort +-- Copyright : (c) Gregory Crosswhite 2010 +-- License : BSD3 +-- Maintainer : gcross@phys.washington.edu +-- Stability : provisional +-- Portability : portable +-- +-- This module provides a monad and a monad transformer that allow the +-- user to abort a monadic computation and immediately return a +-- result. +----------------------------------------------------------------------------- + +module Control.Monad.Trans.Abort ( + -- * The Abort monad + Abort, + runAbort, + -- * The AbortT monad transformer + AbortT(..), + runAbortT, + -- * Abort operations + abort + ) where + +import Control.Applicative +import Control.Monad.IO.Class +import Control.Monad.Trans.Class + +import Data.Functor +import Data.Functor.Identity + +-- --------------------------------------------------------------------------- +-- | An abort monad, parametrized by the type @r@ of the value to return. +type Abort r = AbortT r Identity + +-- | Execute the abort monad computation and return the resulting value. +runAbort :: Abort r r -- ^ the monadic computation to run + -> r -- ^ the result of the computation +runAbort = runIdentity . runAbortT + +-- --------------------------------------------------------------------------- +-- | An abort monad transformer parametrized by +-- +-- * @r@ - the value that will ultimately be returned; and +-- +-- * @m@ - the inner monad. +-- +-- The 'AbortT' type wraps a monadic value that is either +-- +-- * 'Left' @r@, which indicates that the monadic computation has +-- terminated with result @r@ and so all further steps in the computation +-- should be ignored; or +-- +-- * 'Right' @a@, which indicates that the computation is proceding normally +-- and that its current value is @a@. +newtype AbortT r m a = AbortT { unwrapAbortT :: m (Either r a) } + +instance Functor m => Functor (AbortT r m) where + fmap f = AbortT . fmap (either Left (Right . f)) . unwrapAbortT + +instance Applicative m => Applicative (AbortT r m) where + pure = AbortT . fmap Right . pure + (AbortT m) <*> (AbortT x) = AbortT ((fmap h m) <*> x) + where + h (Left g) = const (Left g) + h (Right f) = either Left (Right . f) + +instance Monad m => Monad (AbortT r m) where + return = AbortT . return . Right + (AbortT m) >>= f = AbortT $ m >>= either (return . Left) (unwrapAbortT . f) + +instance MonadIO m => MonadIO (AbortT r m) where + liftIO = lift . liftIO + +instance MonadTrans (AbortT r) where + lift = AbortT . (>>= return . Right) + +-- | Execute the abort monad computation and return the resulting +-- (monadic) value. +runAbortT :: Monad m + => AbortT r m r -- ^ the monadic computation to run + -> m r -- ^ the (monadic) result of the computation +runAbortT (AbortT m) = m >>= either return return + +-- --------------------------------------------------------------------------- +-- | Abort the computation and immediately return a result; all steps +-- in the computation after this monadic computation will be ignored. +-- +-- Note that since no further computation is performed after this, there is +-- no way for subsequent computations to access the monadic value, and so it +-- can be assigned an arbitrary type. +abort :: Monad m + => r -- ^ the result to return + -> AbortT r m a -- ^ a monadic value that has the effect of + -- terminating the computation and immediately + -- returning a value; note that since all + -- subsequent steps in the computation will be + -- ignored, this monadic value can take an + -- arbitrary type since its value will never + -- be accessed +abort = AbortT . return . Left diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +Copyright (c) 2010, Gregory Crosswhite +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. + +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain