explicit-exception-0.1.7.1/0000755000000000000000000000000012024050310013644 5ustar0000000000000000explicit-exception-0.1.7.1/LICENSE0000644000000000000000000000261212024050310014652 0ustar0000000000000000Redistribution 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. Neither the name of the ; nor the names of its contributors may 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. explicit-exception-0.1.7.1/Setup.lhs0000644000000000000000000000011512024050310015451 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain explicit-exception-0.1.7.1/explicit-exception.cabal0000644000000000000000000000743512024050310020456 0ustar0000000000000000Name: explicit-exception Version: 0.1.7.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann Maintainer: Henning Thielemann Homepage: http://www.haskell.org/haskellwiki/Exception Category: Control Stability: Experimental Synopsis: Exceptions which are explicit in the type signature. Description: Synchronous and Asynchronous exceptions which are explicit in the type signature. The first ones are very similar to 'Either' and 'Control.Monad.Error.ErrorT'. The second ones are used for 'System.IO.readFile' and 'System.IO.hGetContents'. This package is a proposal for improved exception handling in Haskell. It strictly separates between handling of exceptional situations (file not found, invalid user input, see ) and (programming) errors (division by zero, index out of range, see ). Handling of the first one is called \"exception handling\", whereas handling of errors is better known as \"debugging\". . For applications see the packages @midi@, @spreadsheet@, @http-monad@. . Although I'm not happy with the identifier style of the Monad Transformer Library (partially intended for unqualified use) I have tried to adopt it for this library, in order to let Haskell programmers get accustomed easily to it. . To do: Because many people requested it, we will provide a @bracket@ function that frees a resource both when an exception and an error occurs, that is, it combines exception handling and debugging. However note that freeing resources in case of an error is dangerous and may cause further damage. Tested-With: GHC==6.8.2 Cabal-Version: >=1.6 Build-Type: Simple Source-Repository head type: darcs location: http://code.haskell.org/explicit-exception/ Source-Repository this type: darcs location: http://code.haskell.org/explicit-exception/ tag: 0.1.7.1 Flag buildTests description: Build test suite default: False Flag splitBase description: Choose the smaller, split-up base package from version 2 on. Library Build-Depends: transformers >=0.2 && <0.4 If impl(jhc) Build-Depends: applicative >=1.0 && <1.1, base >= 1 && <2 Else If flag(splitBase) Build-Depends: base >= 2 && <5 Else Build-Depends: special-functors >=1.0 && <1.1, base >= 1 && <2 GHC-Options: -Wall Hs-Source-Dirs: src Exposed-Modules: Control.Monad.Exception.Asynchronous Control.Monad.Exception.Asynchronous.Lazy Control.Monad.Exception.Asynchronous.Strict Control.Monad.Exception.Synchronous If !impl(jhc) Other-Modules: Control.Monad.Exception.Warning Control.Monad.Exception.Label Control.Monad.Label System.IO.Straight System.IO.Exception.File System.IO.Exception.BinaryFile System.IO.Exception.TextFile -- System.IO.Exception.Std -- Debug.Error Executable ee-tar If flag(buildTests) Build-Depends: bytestring >=0.9.0.1 && <0.11, tar >=0.3 && <0.4 Else Buildable: False GHC-Options: -Wall Hs-Source-Dirs: src, spaceleak Main-Is: Tar.hs Executable ee-test If flag(buildTests) Build-Depends: bytestring >=0.9.0.1 && <0.11 Else Buildable: False GHC-Options: -Wall Hs-Source-Dirs: src, spaceleak Main-Is: Example.hs Executable ee-unzip If !flag(buildTests) Buildable: False GHC-Options: -Wall Hs-Source-Dirs: spaceleak Main-Is: Unzip.hs Executable ee-writer If !flag(buildTests) Buildable: False Buildable: False GHC-Options: -Wall Hs-Source-Dirs: spaceleak Main-Is: Writer.hs explicit-exception-0.1.7.1/src/0000755000000000000000000000000012024050310014433 5ustar0000000000000000explicit-exception-0.1.7.1/src/System/0000755000000000000000000000000012024050310015717 5ustar0000000000000000explicit-exception-0.1.7.1/src/System/IO/0000755000000000000000000000000012024050310016226 5ustar0000000000000000explicit-exception-0.1.7.1/src/System/IO/Straight.hs0000644000000000000000000000456412024050310020360 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {- | Module defining the type for exception free I/O. Exceptional results in SIO must be represented by traditional error codes. If you want to turn an IO action into 'SIO' you must convert it to @ExceptionalT IOException SIO a@ by 'ioToExceptionalSIO' (or 'Control.Monad.Trans.liftIO') and then handle the 'IOException's using 'SyncExc.resolveT'. -} module System.IO.Straight ( SIO, sioToIO, ioToExceptionalSIO, unsafeInterleaveSIO, ExceptionalT, IOException, ) where import Control.Monad.Exception.Synchronous (Exceptional(Success, Exception), ExceptionalT(ExceptionalT), ) import Control.Exception (IOException, try) import Control.Monad.IO.Class (MonadIO, liftIO, ) import System.IO.Unsafe (unsafeInterleaveIO, ) {- | An I/O action of type 'SIO' cannot skip following SIO actions as a result of exceptional outcomes like \"File not found\". However an 'error' can well break the program. -} newtype SIO a = SIO (IO a) -- {sioToIO :: IO a} deriving (Functor, Monad) sioToIO :: SIO a -> IO a sioToIO (SIO x) = x ioToExceptionalSIO :: IO a -> ExceptionalT IOException SIO a ioToExceptionalSIO = ExceptionalT . SIO . fmap (either Exception Success) . try unsafeInterleaveSIO :: SIO a -> SIO a unsafeInterleaveSIO (SIO io) = SIO $ unsafeInterleaveIO io -- helper classes for defining the MonadIO instance of SIO {- | Users of the library may define new instances of MonadSIO, but monads other than SIO may not make the absence of exceptions explicit. It is important however, that we do not make the method 'toSIO' public, since this would allow users the unsafe conversion from @IO@ to @SIO@. Maybe we should not be so picky about exceptional monads within exception monad transformers. A monad like @ExceptionalT e0 (StateT s (Exceptional e1))@ may be useful for distinction of non-fatal exceptions @e0@ that can maintain the state @s@ and fatal exceptions @e1@ that prevent generation of an updated state. -} class Monad m => MonadSIO m where toSIO :: IO a -> m a instance MonadSIO SIO where toSIO = SIO class ContainsIOException e where fromIOException :: IOException -> e instance ContainsIOException IOException where fromIOException = id instance (MonadSIO m, ContainsIOException e) => MonadIO (ExceptionalT e m) where liftIO = ExceptionalT . toSIO . fmap (either (Exception . fromIOException) Success) . try explicit-exception-0.1.7.1/src/System/IO/Exception/0000755000000000000000000000000012024050310020164 5ustar0000000000000000explicit-exception-0.1.7.1/src/System/IO/Exception/TextFile.hs0000644000000000000000000000271712024050310022253 0ustar0000000000000000{- | Files with text content. -} module System.IO.Exception.TextFile where import System.IO.Exception.File (EIO, close, ) import qualified Control.Monad.Exception.Synchronous as Sync import qualified Control.Monad.Exception.Asynchronous as Async import Control.Monad.Exception.Synchronous (bracketT, ) import System.IO.Straight (SIO, ioToExceptionalSIO, unsafeInterleaveSIO, ) import System.IO (Handle, IOMode, ) import qualified System.IO as IO import System.IO.Error (isEOFError, ) import Control.Exception (IOException) import Prelude hiding (getChar) open :: FilePath -> IOMode -> EIO Handle open name mode = ioToExceptionalSIO $ IO.openFile name mode with :: FilePath -> IOMode -> (Handle -> EIO r) -> EIO r with name mode = bracketT (open name mode) close getChar :: Handle -> EIO Char getChar h = ioToExceptionalSIO $ IO.hGetChar h getContentsSynchronous :: Handle -> EIO String getContentsSynchronous h = Sync.manyT -- candidate for toMaybe from utility-ht (\e -> if isEOFError e then Nothing else Just e) (:) [] (getChar h) {- | This calls 'unsafeInterleaveIO'. Maybe we should also attach 'unsafe' to this function name? We should use the LazyIO type and manyT here. -} getContentsAsynchronous :: Handle -> SIO (Async.Exceptional IOException String) getContentsAsynchronous h = Async.manySynchronousT unsafeInterleaveSIO (:) [] (getChar h) putChar :: Handle -> Char -> EIO () putChar h c = ioToExceptionalSIO $ IO.hPutChar h c explicit-exception-0.1.7.1/src/System/IO/Exception/BinaryFile.hs0000644000000000000000000000145012024050310022544 0ustar0000000000000000{- | Files with binary content. -} module System.IO.Exception.BinaryFile where import System.IO.Exception.File (EIO, close, ) import Control.Monad.Exception.Synchronous (bracketT, ) import System.IO.Straight (ioToExceptionalSIO, ) import System.IO (Handle, IOMode, ) import qualified System.IO as IO import Data.Word (Word8, ) import Data.Char (ord, chr, ) open :: FilePath -> IOMode -> EIO Handle open name mode = ioToExceptionalSIO $ IO.openBinaryFile name mode with :: FilePath -> IOMode -> (Handle -> EIO r) -> EIO r with name mode = bracketT (open name mode) close getByte :: Handle -> EIO Word8 getByte h = ioToExceptionalSIO $ fmap (fromIntegral . ord) $ IO.hGetChar h putByte :: Handle -> Word8 -> EIO () putByte h c = ioToExceptionalSIO $ IO.hPutChar h (chr . fromIntegral $ c) explicit-exception-0.1.7.1/src/System/IO/Exception/File.hs0000644000000000000000000000046612024050310021405 0ustar0000000000000000module System.IO.Exception.File where import System.IO.Straight (ExceptionalT, IOException, SIO, ioToExceptionalSIO, ) import qualified System.IO as IO -- import System.IO (Handle, IOMode, ) type EIO = ExceptionalT IOException SIO close :: IO.Handle -> EIO () close h = ioToExceptionalSIO $ IO.hClose h explicit-exception-0.1.7.1/src/Control/0000755000000000000000000000000012024050310016053 5ustar0000000000000000explicit-exception-0.1.7.1/src/Control/Monad/0000755000000000000000000000000012024050310017111 5ustar0000000000000000explicit-exception-0.1.7.1/src/Control/Monad/Label.hs0000644000000000000000000000732712024050310020475 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {- | Here we implement a special Reader monad that can be used to manage a call stack. This way you can generate exception messages like \"Corrupt file content encountered while reading file \'foo.txt\' while loading document \'bar.doc\'\" using the functions in "Control.Monad.Exception.Label". However, currently I believe that this datatype is unnecessary, since you can extend exceptions by context information using 'Control.Monad.Exception.Synchronous.mapException'. -} module Control.Monad.Label where import Control.Applicative (Applicative(pure, (<*>))) import Control.Monad (MonadPlus, ap, ) import Control.Monad.Fix (MonadFix) import Control.Monad.IO.Class (MonadIO, ) import Control.Monad.Trans.Class (MonadTrans, ) import qualified Control.Monad.Trans.Reader as Reader import Control.Monad.Trans.Reader (Reader, ReaderT(ReaderT), runReader, runReaderT, ) import Control.Monad.Instances () -- * Plain monad newtype Label l a = Label { runLabelPriv :: Reader [l] a } -- newtype Label l a = Label { runLabelPriv :: [l] -> a } deriving (Functor, Monad, MonadFix) {- instance Functor (Label l) where fmap f m = Label $ \l -> f (runLabelPriv m l) instance Monad (Label l) where return a = Label $ \_ -> a m >>= k = Label $ \l -> runLabelPriv (k (runLabelPriv m l)) l instance MonadFix (Label l) where mfix f = Label $ \l -> let a = runLabelPriv (f a) l in a -} instance Applicative (Label l) where pure = return (<*>) = ap runLabel :: Label l a -> [l] -> a runLabel = runReader . runLabelPriv ask :: Label l [l] ask = Label Reader.ask -- ask = Label id local :: l -> Label l a -> Label l a local l m = Label $ Reader.local (l:) $ runLabelPriv m -- local l m = Label $ runLabelPriv m . (l:) -- * Monad transformer newtype LabelT l m a = LabelT { runLabelPrivT :: ReaderT [l] m a } -- newtype LabelT l m a = LabelT { runLabelPrivT :: l -> m a } deriving (Monad, MonadPlus, MonadFix, MonadTrans, MonadIO) {- instance (Monad m) => Functor (LabelT l m) where fmap f m = LabelT $ \l -> do a <- runLabelPrivT m l return (f a) instance (Monad m) => Monad (LabelT l m) where return a = LabelT $ \_ -> return a m >>= k = LabelT $ \l -> do a <- runLabelPrivT m l runLabelPrivT (k a) l fail msg = LabelT $ \_ -> fail msg instance (MonadPlus m) => MonadPlus (LabelT l m) where mzero = LabelT $ \_ -> mzero m `mplus` n = LabelT $ \l -> runLabelPrivT m l `mplus` runLabelPrivT n l instance (MonadFix m) => MonadFix (LabelT l m) where mfix f = LabelT $ \l -> mfix $ \a -> runLabelPrivT (f a) l instance MonadTrans (LabelT l) where lift m = LabelT $ \_ -> m instance (MonadIO m) => MonadIO (LabelT l m) where liftIO = lift . liftIO -} {- instance Monad m => Applicative (LabelT l m) where pure = return (<*>) = ap -} fmapReaderT :: (Functor f) => (a -> b) -> ReaderT r f a -> ReaderT r f b fmapReaderT f m = ReaderT $ \l -> fmap f $ runReaderT m l instance (Functor m) => Functor (LabelT l m) where fmap f m = LabelT $ fmapReaderT f $ runLabelPrivT m pureReaderT :: (Applicative f) => a -> ReaderT r f a pureReaderT a = ReaderT $ const $ pure a apReaderT :: (Applicative f) => ReaderT r f (a -> b) -> ReaderT r f a -> ReaderT r f b apReaderT f x = ReaderT $ \r -> runReaderT f r <*> runReaderT x r instance Applicative m => Applicative (LabelT l m) where pure a = LabelT $ pureReaderT a f <*> x = LabelT $ runLabelPrivT f `apReaderT` runLabelPrivT x runLabelT :: Monad m => LabelT l m a -> [l] -> m a runLabelT = runReaderT . runLabelPrivT askT :: Monad m => LabelT l m [l] askT = LabelT Reader.ask localT :: Monad m => l -> LabelT l m a -> LabelT l m a localT l m = LabelT $ Reader.local (l:) $ runLabelPrivT m explicit-exception-0.1.7.1/src/Control/Monad/Exception/0000755000000000000000000000000012024050310021047 5ustar0000000000000000explicit-exception-0.1.7.1/src/Control/Monad/Exception/Warning.hs0000644000000000000000000000576612024050310023026 0ustar0000000000000000{- | This module is currently not in use and may be considered a design study. Warning monad is like 'Control.Monad.Writer.Writer' monad, it can be used to record exceptions that do not break program flow. TODO: * Better name for 'Warnable' -} module Control.Monad.Exception.Warning where import qualified Control.Monad.Exception.Synchronous as Sync import Control.Applicative (Applicative(pure, (<*>))) import Control.Monad (mplus) import Data.Maybe (catMaybes) -- * Plain monad {- | Contains a value and possibly warnings that were generated while the computation of that value. -} data Warnable e a = Warnable [Maybe e] a {- | Convert an exception to a warning. -} fromException :: a -> Sync.Exceptional e a -> Warnable e a fromException deflt x = {- Here the list item can only be constructed after the constructor of x is known case x of Sync.Success y -> Warnable [Nothing] y Sync.Exception e -> Warnable [Just e] deflt -} let (e,y) = case x of Sync.Success y0 -> (Nothing, y0) Sync.Exception e0 -> (Just e0, deflt) in Warnable [e] y fromExceptionNull :: Sync.Exceptional e () -> Warnable e () fromExceptionNull = fromException () toException :: ([e0] -> e1) -> Warnable e0 a -> Sync.Exceptional e1 a toException summarize x = case x of Warnable mes y -> case catMaybes mes of [] -> Sync.Success y es -> Sync.Exception (summarize es) warn :: e -> Warnable e () warn e = Warnable [Just e] () instance Functor (Warnable e) where fmap f x = case x of Warnable e a -> Warnable e (f a) instance Applicative (Warnable e) where pure = Warnable [] -- [Nothing]? f <*> x = case f of Warnable e0 g -> case x of Warnable e1 y -> Warnable (mplus e0 e1) (g y) instance Monad (Warnable e) where return = Warnable [] -- [Nothing]? fail _msg = Warnable [Just (error "Warning.fail exception")] (error "Warning.fail result") x >>= f = case x of Warnable e0 y -> case f y of Warnable e1 z -> Warnable (e0 ++ e1) z -- * Monad transformer newtype WarnableT e m a = WarnableT {runWarnableT :: m (Warnable e a)} fromSynchronousT :: Functor m => a -> Sync.ExceptionalT e m a -> WarnableT e m a fromSynchronousT deflt (Sync.ExceptionalT mx) = WarnableT $ fmap (fromException deflt) mx warnT :: (Monad m) => e -> WarnableT e m () warnT = WarnableT . return . warn instance Functor m => Functor (WarnableT e m) where fmap f (WarnableT x) = WarnableT (fmap (fmap f) x) instance Applicative m => Applicative (WarnableT e m) where pure = WarnableT . pure . pure WarnableT f <*> WarnableT x = WarnableT (fmap (<*>) f <*> x) instance Monad m => Monad (WarnableT e m) where return = WarnableT . return . return x0 >>= f = WarnableT $ do Warnable ex x <- runWarnableT x0 Warnable ey y <- runWarnableT (f x) return $ Warnable (ex ++ ey) y explicit-exception-0.1.7.1/src/Control/Monad/Exception/Asynchronous.hs0000644000000000000000000000116512024050310024101 0ustar0000000000000000{- | Asynchronous exceptions can occur during the construction of a lazy data structure. They are represented by a lazy data structure itself. This module re-exports the type with lazy combinators. TODO: * Is the Null type appropriate anywhere? Should it be better a Monoid type with mempty? Shall Monoid.mempty be the default, or functions with explicit default values? * Shall we replace Monad constraint by Functor constraint, where we only need liftM? -} module Control.Monad.Exception.Asynchronous ( module Control.Monad.Exception.Asynchronous.Lazy ) where import Control.Monad.Exception.Asynchronous.Lazy explicit-exception-0.1.7.1/src/Control/Monad/Exception/Label.hs0000644000000000000000000000602512024050310022425 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {- | Here we implement a monad transformer which adds exception handling and labelling of actions (using "Control.Monad.Label") in order to extend exceptions with a kind of call stack. -} module Control.Monad.Exception.Label where import qualified Control.Monad.Exception.Synchronous as Exception import qualified Control.Monad.Label as Label import Control.Monad.Exception.Synchronous (ExceptionalT, mapExceptionT, ) import Control.Monad.Label (LabelT, ) import Control.Monad (liftM, ) import Control.Monad.Fix (MonadFix, ) import Control.Monad.Trans.Class (MonadTrans, lift, ) data LabeledException l e = LabeledException {labels :: [l], exception :: e} newtype LabeledExceptionalT l e m a = LabeledExceptionalT {runLabeledExceptionalT :: LabelT l (ExceptionalT (LabeledException l e) m) a} deriving (Monad, MonadFix) runLabelT :: (Monad m) => LabeledExceptionalT l e m a -> [l] -> ExceptionalT (LabeledException l e) m a runLabelT = Label.runLabelT . runLabeledExceptionalT labelT :: (Monad m) => ExceptionalT (LabeledException l e) m a -> LabeledExceptionalT l e m a labelT = LabeledExceptionalT . lift -- Label.LabelT . ReaderT stripLabelT :: (Monad m) => LabeledExceptionalT l e m a -> ExceptionalT e m a stripLabelT action = mapExceptionT exception (runLabelT action []) decorateLabelT :: (Monad m) => ExceptionalT e m a -> LabeledExceptionalT l e m a decorateLabelT = labelT . mapExceptionT (LabeledException []) getLabels :: (Monad m) => LabeledExceptionalT l e m [l] getLabels = LabeledExceptionalT $ Label.askT throwT :: (Monad m) => e -> LabeledExceptionalT l e m a throwT e = do l <- getLabels labelT $ Exception.throwT (LabeledException l e) {- | Currently 'catchT' calls the exception handler with a full call stack. Since 'catchT' handles exceptions locally it may however clear the call stack before calling the inner action and a re-throw should append the inner call stack to the outer one. For this semantics, a difference list would be more efficient for labels. -} catchT :: (Monad m) => LabeledExceptionalT l e0 m a -> ([l] -> e0 -> LabeledExceptionalT l e1 m a) -> LabeledExceptionalT l e1 m a catchT action handler = do ls <- getLabels labelT $ Exception.catchT (runLabelT action ls) (\(LabeledException l e) -> runLabelT (handler l e) ls) {- | If the enclosed monad has custom exception facilities, they could skip the cleanup code. Make sure, that this cannot happen by choosing an appropriate monad. -} bracketT :: (Monad m) => l -> LabeledExceptionalT l e m h -> (h -> LabeledExceptionalT l e m ()) -> (h -> LabeledExceptionalT l e m a) -> LabeledExceptionalT l e m a bracketT label open close action = do ls <- liftM (label:) getLabels labelT $ Exception.bracketT (runLabelT open ls) (\h -> runLabelT (close h) ls) (\h -> runLabelT (action h) ls) instance MonadTrans (LabeledExceptionalT l e) where lift m = labelT $ lift m explicit-exception-0.1.7.1/src/Control/Monad/Exception/Synchronous.hs0000644000000000000000000003123412024050310023740 0ustar0000000000000000{- | Synchronous exceptions immediately abort a series of computations. We provide monads for describing this behaviour. In contrast to ErrorT from @mtl@ or @transformers@ package we do not pose restrictions on the exception type. How to tell, that a function can possibly throw more than one (kind of) exception? If you would use the exception type @(Either ParserException IOError)@ then this is different from @(Either IOError ParserException)@. Thus we recommned using type classes for exceptions. Then you can use one type containing all exceptions in an application, but the type signature still tells which exceptions are actually possible. Examples: > parser :: ParserException e => ExceptionalT e ParserMonad a > > getLine :: IOException e => ExceptionalT e IO String > > fileParser :: (ParserException e, IOException e) => ExceptionalT e IO String Unfortunately, this way you cannot remove single exceptions from the constraints by catching them. You can only remove all of them using 'resolve' or none. For a more advanced approach, that allows removing exceptions constraints by some non-Haskell-98 type hackery, see the exception package by Joseph Iborra. -} module Control.Monad.Exception.Synchronous ( Exceptional(..), fromMaybe, toMaybe, fromEither, toEither, fromExitCode, toExitCode, getExceptionNull, switch, force, mapException, mapExceptional, throw, assert, catch, resolve, merge, ExceptionalT(..), fromMaybeT, toMaybeT, fromErrorT, toErrorT, fromEitherT, toEitherT, fromExitCodeT, toExitCodeT, switchT, forceT, mapExceptionT, mapExceptionalT, throwT, assertT, catchT, bracketT, resolveT, tryT, manyT, manyMonoidT, mergeT, ) where import Control.Applicative (Applicative(pure, (<*>))) import Control.Monad (liftM, liftM2, {- MonadPlus(mzero, mplus), -}) import Control.Monad.Fix (MonadFix, mfix, ) import Control.Monad.Trans.Class (MonadTrans, lift, ) import Control.Monad.Trans.Error (ErrorT(ErrorT, runErrorT)) import Control.Monad.Trans.Maybe (MaybeT(MaybeT, runMaybeT)) import Data.Monoid(Monoid, mappend, mempty, Endo(Endo, appEndo), ) import System.Exit (ExitCode(ExitSuccess, ExitFailure), ) import Prelude hiding (catch, ) -- * Plain monad {- | Like 'Either', but explicitly intended for handling of exceptional results. In contrast to 'Either' we do not support 'fail'. Calling 'fail' in the 'Exceptional' monad is an error. This way, we do not require that an exception can be derived from a 'String', yet, we require no constraint on the exception type at all. -} data Exceptional e a = Success a | Exception e deriving (Show, Eq) fromMaybe :: e -> Maybe a -> Exceptional e a fromMaybe e = maybe (Exception e) Success fromEither :: Either e a -> Exceptional e a fromEither = either Exception Success toMaybe :: Exceptional e a -> Maybe a toMaybe = switch (const Nothing) Just toEither :: Exceptional e a -> Either e a toEither x = case x of Success a -> Right a Exception e -> Left e toExitCode :: Exceptional Int () -> ExitCode toExitCode e = case e of Success () -> ExitSuccess Exception n -> ExitFailure n fromExitCode :: ExitCode -> Exceptional Int () fromExitCode e = case e of ExitSuccess -> Success () ExitFailure n -> Exception n -- | useful in connection with 'Control.Monad.Exception.Asynchronous.continue' getExceptionNull :: Exceptional e () -> Maybe e getExceptionNull x = case x of Success _ -> Nothing Exception e -> Just e {- | Counterpart to 'either' for 'Either'. -} switch :: (e -> b) -> (a -> b) -> Exceptional e a -> b switch f g x = case x of Success a -> g a Exception e -> f e {- | If you are sure that the value is always a 'Success' you can tell that the run-time system thus making your program lazy. However, try to avoid this function by using 'catch' and friends, since this function is partial. -} force :: Exceptional e a -> Exceptional e a force ~(Success a) = Success a mapException :: (e0 -> e1) -> Exceptional e0 a -> Exceptional e1 a mapException f x = case x of Success a -> Success a Exception e -> Exception (f e) mapExceptional :: (e0 -> e1) -> (a -> b) -> Exceptional e0 a -> Exceptional e1 b mapExceptional f g x = case x of Success a -> Success (g a) Exception e -> Exception (f e) throw :: e -> Exceptional e a throw = Exception assert :: e -> Bool -> Exceptional e () assert e b = if b then Success () else throw e catch :: Exceptional e0 a -> (e0 -> Exceptional e1 a) -> Exceptional e1 a catch x handler = case x of Success a -> Success a Exception e -> handler e {- bracket :: Exceptional e h -> (h -> Exceptional e ()) -> (h -> Exceptional e a) -> Exceptional e a bracket open close action = open >>= \h -> case action h of -} resolve :: (e -> a) -> Exceptional e a -> a resolve handler x = case x of Success a -> a Exception e -> handler e -- like Applicative.<*> infixl 4 `merge`, `mergeT` {- | see 'mergeT' -} merge, mergeLazy, _mergeStrict :: (Monoid e) => Exceptional e (a -> b) -> Exceptional e a -> Exceptional e b merge = mergeLazy mergeLazy ef ea = case ef of Exception e0 -> Exception $ mappend e0 $ case ea of Success _ -> mempty Exception e1 -> e1 Success f -> fmap f ea _mergeStrict ef ea = case (ef,ea) of (Success f, Success a) -> Success $ f a (Exception e, Success _) -> Exception e (Success _, Exception e) -> Exception e (Exception e0, Exception e1) -> Exception $ mappend e0 e1 instance Functor (Exceptional e) where fmap f x = case x of Success a -> Success (f a) Exception e -> Exception e instance Applicative (Exceptional e) where pure = Success f <*> x = case f of Exception e -> Exception e Success g -> case x of Success a -> Success (g a) Exception e -> Exception e instance Monad (Exceptional e) where return = Success fail _msg = Exception (error "Exception.Synchronous: Monad.fail method is not supported") x >>= f = case x of Exception e -> Exception e Success y -> f y {- | I think it is not a good idea to use this instance, maybe we shoul remove it. It expects that the constructor is 'Success' and the result is undefined otherwise. But if the constructor must always be 'Success', why using 'Exceptional' then, at all? -} instance MonadFix (Exceptional e) where mfix f = let unSuccess ~(Success x) = x a = f (unSuccess a) in a {- A MonadPlus instance would require another class, say DefaultException, that provides a default exception used for @mzero@. In Control.Monad.Error this is handled by the Error class. Since String is a typical type used for exceptions - shall there be a DefaultException String instance? -} -- * Monad transformer -- | like ErrorT, but ExceptionalT is the better name in order to distinguish from real (programming) errors newtype ExceptionalT e m a = ExceptionalT {runExceptionalT :: m (Exceptional e a)} _assertMaybeT :: (Monad m) => e -> Maybe a -> ExceptionalT e m a _assertMaybeT e = maybe (throwT e) return fromMaybeT :: Monad m => e -> MaybeT m a -> ExceptionalT e m a fromMaybeT e = ExceptionalT . liftM (fromMaybe e) . runMaybeT toMaybeT :: Monad m => ExceptionalT e m a -> MaybeT m a toMaybeT = MaybeT . liftM toMaybe . runExceptionalT fromErrorT :: Monad m => ErrorT e m a -> ExceptionalT e m a fromErrorT = fromEitherT . runErrorT toErrorT :: Monad m => ExceptionalT e m a -> ErrorT e m a toErrorT = ErrorT . toEitherT fromEitherT :: Monad m => m (Either e a) -> ExceptionalT e m a fromEitherT = ExceptionalT . liftM fromEither toEitherT :: Monad m => ExceptionalT e m a -> m (Either e a) toEitherT = liftM toEither . runExceptionalT toExitCodeT :: (Functor m) => ExceptionalT Int m () -> m ExitCode toExitCodeT act = fmap toExitCode $ runExceptionalT act fromExitCodeT :: (Functor m) => m ExitCode -> ExceptionalT Int m () fromExitCodeT act = ExceptionalT $ fmap fromExitCode act switchT :: (Monad m) => (e -> m b) -> (a -> m b) -> ExceptionalT e m a -> m b switchT e s m = switch e s =<< runExceptionalT m {- | see 'force' -} forceT :: Monad m => ExceptionalT e m a -> ExceptionalT e m a forceT = ExceptionalT . liftM force . runExceptionalT mapExceptionT :: (Monad m) => (e0 -> e1) -> ExceptionalT e0 m a -> ExceptionalT e1 m a mapExceptionT f = ExceptionalT . liftM (mapException f) . runExceptionalT mapExceptionalT :: (m (Exceptional e0 a) -> n (Exceptional e1 b)) -> ExceptionalT e0 m a -> ExceptionalT e1 n b mapExceptionalT f = ExceptionalT . f . runExceptionalT throwT :: (Monad m) => e -> ExceptionalT e m a throwT = ExceptionalT . return . throw assertT :: (Monad m) => e -> Bool -> ExceptionalT e m () assertT e = ExceptionalT . return . assert e catchT :: (Monad m) => ExceptionalT e0 m a -> (e0 -> ExceptionalT e1 m a) -> ExceptionalT e1 m a catchT action handler = ExceptionalT $ runExceptionalT action >>= \x -> case x of Success a -> return $ Success a Exception e -> runExceptionalT $ handler e {- | If the enclosed monad has custom exception facilities, they could skip the cleanup code. Make sure, that this cannot happen by choosing an appropriate monad. -} bracketT :: (Monad m) => ExceptionalT e m h -> (h -> ExceptionalT e m ()) -> (h -> ExceptionalT e m a) -> ExceptionalT e m a bracketT open close action = open >>= \h -> ExceptionalT $ do a <- runExceptionalT (action h) c <- runExceptionalT (close h) return (a >>= \r -> c >> return r) resolveT :: (Monad m) => (e -> m a) -> ExceptionalT e m a -> m a resolveT handler x = do r <- runExceptionalT x resolve handler (fmap return r) tryT :: (Monad m) => ExceptionalT e m a -> m (Exceptional e a) tryT = runExceptionalT {- | Repeat an action until an exception occurs. Initialize the result with @empty@ and add new elements using @cons@ (e.g. @[]@ and @(:)@). The exception handler decides whether the terminating exception is re-raised ('Just') or catched ('Nothing'). -} manyT :: (Monad m) => (e0 -> Maybe e1) {- ^ exception handler -} -> (a -> b -> b) {- ^ @cons@ function -} -> b {- ^ @empty@ -} -> ExceptionalT e0 m a {- ^ atomic action to repeat -} -> ExceptionalT e1 m b manyT handler cons empty action = liftM (flip appEndo empty) $ manyMonoidT handler $ liftM (Endo . cons) action manyMonoidT :: (Monad m, Monoid a) => (e0 -> Maybe e1) {- ^ exception handler -} -> ExceptionalT e0 m a {- ^ atomic action to repeat -} -> ExceptionalT e1 m a manyMonoidT handler action = let recourse = do r <- lift $ tryT action case r of -- Exception e -> maybe (return empty) throwT (handler e) -- more lazy Exception e -> ExceptionalT $ return $ maybe (Success mempty) throw (handler e) Success x -> liftM (mappend x) recourse in recourse {- | This combines two actions similar to Applicative's @<*>@. The result action fails if one of the input action fails, but both actions are executed. E.g. consider a compiler that emits all errors that can be detected independently, but eventually aborts if there is at least one error. The exception type @e@ might be a list type, or an @Endo@ type that implements a difflist. -} mergeT :: (Monoid e, Monad m) => ExceptionalT e m (a -> b) -> ExceptionalT e m a -> ExceptionalT e m b mergeT mf ma = ExceptionalT $ liftM2 merge (runExceptionalT mf) (runExceptionalT ma) instance Functor m => Functor (ExceptionalT e m) where fmap f (ExceptionalT x) = ExceptionalT (fmap (fmap f) x) instance Applicative m => Applicative (ExceptionalT e m) where pure = ExceptionalT . pure . pure ExceptionalT f <*> ExceptionalT x = ExceptionalT (fmap (<*>) f <*> x) instance Monad m => Monad (ExceptionalT e m) where return = ExceptionalT . return . return x0 >>= f = ExceptionalT $ runExceptionalT x0 >>= \x1 -> case x1 of Exception e -> return (Exception e) Success x -> runExceptionalT $ f x {- | Same restrictions applies as for @instance MonadFix (Exceptional e a)@. -} instance (MonadFix m) => MonadFix (ExceptionalT e m) where mfix f = ExceptionalT $ mfix $ \ ~(Success r) -> runExceptionalT $ f r instance MonadTrans (ExceptionalT e) where lift m = ExceptionalT $ liftM Success m {- instance MonadIO m => MonadIO (ExceptionalT e m) where liftIO act = ExceptionalT $ liftIO $ liftM Success act -} explicit-exception-0.1.7.1/src/Control/Monad/Exception/Asynchronous/0000755000000000000000000000000012024050310023542 5ustar0000000000000000explicit-exception-0.1.7.1/src/Control/Monad/Exception/Asynchronous/Lazy.hs0000644000000000000000000004160712024050310025025 0ustar0000000000000000module Control.Monad.Exception.Asynchronous.Lazy ( Exceptional(..), pure, broken, fromSynchronous, fromSynchronousNull, fromSynchronousMonoid, toSynchronous, throw, throwMonoid, eatNothing, zipWith, append, continue, maybeAbort, force, mapException, mapExceptional, simultaneousBind, simultaneousBindM, sequenceF, traverse, sequenceA, mapM, sequence, swapToSynchronousAsynchronous, swapToAsynchronousSynchronous, ExceptionalT(..), fromSynchronousT, fromSynchronousMonoidT, forceT, mapExceptionT, mapExceptionalT, throwMonoidT, eatNothingT, bindT, manySynchronousT, manyMonoidT, processToSynchronousT_, appendM, continueM, ) where import qualified Control.Monad.Exception.Synchronous as Sync import Control.Monad (mplus, liftM, join, ) import Control.Applicative (Applicative, liftA, ) {- import Data.Traversable (Traversable, ) import Data.Foldable (Foldable, ) -} import Data.Monoid(Monoid, mappend, mempty, ) import Prelude hiding (zipWith, sequence, mapM, ) -- * Plain monad {- | Contains a value and a reason why the computation of the value of type @a@ was terminated. Imagine @a@ as a list type, and an according operation like the 'readFile' operation. If the exception part is 'Nothing' then the value could be constructed regularly. If the exception part is 'Just' then the value could not be constructed completely. However you can read the result of type @a@ lazily, even if an exception occurs while it is evaluated. If you evaluate the exception part, then the result value is certainly computed completely. However, we cannot provide general 'Monad' functionality due to the very different ways of combining the results of type @a@. It is recommended to process the result value in an application specific way, and after consumption of the result, throw a synchronous exception using 'toSynchronous'. Maybe in the future we provide a monad instance which considers subsequent actions as simultaneous processes on a lazy data structure. This variant has lazy combinators like 'fmap'. This implies that some laws are not fulfilled, but in practice it saves you some calls to 'force'. -} data Exceptional e a = Exceptional {exception :: Maybe e, result :: a} deriving Show {- | Create an exceptional value without exception. -} pure :: a -> Exceptional e a pure = Exceptional Nothing {- | Create an exceptional value with exception. -} broken :: e -> a -> Exceptional e a broken e = Exceptional (Just e) fromSynchronous :: a -> Sync.Exceptional e a -> Exceptional e a fromSynchronous deflt x = force $ case x of Sync.Success y -> Exceptional Nothing y Sync.Exception e -> Exceptional (Just e) deflt fromSynchronousNull :: Sync.Exceptional e () -> Exceptional e () fromSynchronousNull = fromSynchronous () fromSynchronousMonoid :: Monoid a => Sync.Exceptional e a -> Exceptional e a fromSynchronousMonoid = fromSynchronous mempty toSynchronous :: Exceptional e a -> Sync.Exceptional e a toSynchronous (Exceptional me a) = maybe (Sync.Success a) Sync.Exception me {- | I think in most cases we want throwMonoid, thus we can replace 'throw' by 'throwMonoid'. -} throw :: e -> Exceptional e () throw e = broken e () throwMonoid :: Monoid a => e -> Exceptional e a throwMonoid e = broken e mempty {- | You might use an exception of type @Maybe e@ in 'manyMonoidT' in order to stop the loop. After finishing the loop you will want to turn the @Nothing@ exception into a success. This is achieved by this function. -} eatNothing :: Exceptional (Maybe e) a -> Exceptional e a eatNothing (Exceptional e a) = Exceptional (join e) a -- ** handling of special result types {- | This is an example for application specific handling of result values. Assume you obtain two lazy lists say from 'readFile' and you want to zip their contents. If one of the stream readers emits an exception, we quit with that exception. If both streams have throw an exception at the same file position, the exception of the first stream is propagated. -} zipWith :: (a -> b -> c) -> Exceptional e [a] -> Exceptional e [b] -> Exceptional e [c] zipWith f (Exceptional ea a0) (Exceptional eb b0) = let recourse (a:as) (b:bs) = fmap (f a b :) (recourseF as bs) recourse as _ = Exceptional (case as of [] -> mplus ea eb; _ -> eb) [] recourseF as bs = force $ recourse as bs in recourseF a0 b0 infixr 1 `append`, `continue`, `maybeAbort` {- | This is an example for application specific handling of result values. Assume you obtain two lazy lists say from 'readFile' and you want to append their contents. If the first stream ends with an exception, this exception is kept and the second stream is not touched. If the first stream can be read successfully, the second one is appended until stops. 'append' is less strict than the 'Monoid' method 'mappend' instance. -} append :: Monoid a => Exceptional e a -> Exceptional e a -> Exceptional e a append (Exceptional ea a) b = fmap (mappend a) $ continue ea b continue :: Monoid a => Maybe e -> Exceptional e a -> Exceptional e a continue ea b = force $ case ea of -- Just e -> throwMonoid e Just _ -> Exceptional ea mempty Nothing -> b maybeAbort :: Exceptional e a -> Maybe e -> Exceptional e a maybeAbort ~(Exceptional ea a) eb = Exceptional (mplus ea eb) a {- | 'mappend' must be strict in order to fulfill the Monoid laws @mappend mempty a = a@ and @mappend a mempty = a@ for @a=undefined@. -} instance Monoid a => Monoid (Exceptional e a) where mempty = pure mempty -- mappend = append mappend (Exceptional ea a) (Exceptional eb b) = Exceptional (mplus ea eb) (mappend a (maybe b (const mempty) ea)) {- | construct Exceptional constructor lazily -} {-# INLINE force #-} force :: Exceptional e a -> Exceptional e a force ~(Exceptional e a) = Exceptional e a mapException :: (e0 -> e1) -> Exceptional e0 a -> Exceptional e1 a mapException f ~(Exceptional e a) = Exceptional (fmap f e) a mapExceptional :: (e0 -> e1) -> (a -> b) -> Exceptional e0 a -> Exceptional e1 b mapExceptional f g ~(Exceptional e a) = Exceptional (fmap f e) (g a) {- | fmap (f.g) = fmap f . fmap g The law fmap id = id requires that we match the constructor strictly. Strict matching fmap id undefined = undefined = id undefined Lazy matching fmap id undefined = Exceptional undefined undefined /= undefined = id undefined -} {- This was pointed out by kahl@cas.mcmaster.ca in libraries@haskell.org, 2011-01-22. However, I think we rely a lot on the lazy matching in http-monad and parallelweb. -} instance Functor (Exceptional e) where fmap f ~(Exceptional e a) = Exceptional e (f a) infixr 1 `simultaneousBind`, `simultaneousBindM` {- | I consider both actions to process the data simultaneously through lazy evaluation. If the second one fails too, it must have encountered an exception in the data that was successfully emitted by the first action, and thus the exception of the second action is probably earlier. We cannot check in general whether the two exception occur at the same time, e.g. the second one might occur since the first occured and left an invalid structure. In this case we should emit the first exception, not the second one. Because of this I expect that this function is not particularly useful. Otherwise it could be used as bind operation for a monad instance. -} {-# DEPRECATED simultaneousBind, simultaneousBindM "Check whether this function is really what you need. It generates an unreasonable exception when the second exception is caused by the first one." #-} simultaneousBind :: Exceptional e a -> (a -> Exceptional e b) -> Exceptional e b simultaneousBind ~(Exceptional mea a) actB = let Exceptional meb b = actB a in Exceptional (mplus meb mea) b simultaneousBindM :: (Monad m) => m (Exceptional e a) -> (a -> m (Exceptional e b)) -> m (Exceptional e b) simultaneousBindM actA actB = do Exceptional mea a <- actA Exceptional meb b <- actB a return (Exceptional (mplus meb mea) b) -- | Is there a better name? {-# INLINE sequenceF #-} sequenceF :: Functor f => Exceptional e (f a) -> f (Exceptional e a) sequenceF ~(Exceptional e a) = fmap (Exceptional e) a -- instance Foldable (Exceptional e) where -- instance Traversable (Exceptional e) where {- | @Foldable@ instance would allow to strip off the exception too easily. I like the methods of @Traversable@, but @Traversable@ instance requires @Foldable@ instance. -} {-# INLINE traverse #-} traverse :: Applicative f => (a -> f b) -> Exceptional e a -> f (Exceptional e b) traverse f = sequenceA . fmap f {-# INLINE sequenceA #-} sequenceA :: Applicative f => Exceptional e (f a) -> f (Exceptional e a) sequenceA ~(Exceptional e a) = liftA (Exceptional e) a {-# INLINE mapM #-} mapM :: Monad m => (a -> m b) -> Exceptional e a -> m (Exceptional e b) mapM f = sequence . fmap f {-# INLINE sequence #-} sequence :: Monad m => Exceptional e (m a) -> m (Exceptional e a) sequence ~(Exceptional e a) = liftM (Exceptional e) a {- instance Applicative (Exceptional e) where pure = pure f <*> x = case f of Exceptional e0 g -> case x of Exceptional e1 y -> Exceptional (mplus e0 e1) (g y) instance Monad (Exceptional e) where return = pure fail _msg = Exceptional [Just (error "Asynchronous.fail exception")] (error "Asynchronous.fail result") x >>= f = case x of Exceptional e0 y -> case f y of Exceptional e1 z -> Exceptional (e0 ++ e1) z -} {- | Consider a file format consisting of a header and a data body. The header can only be used if is read completely. Its parsing might stop with an synchronous exception. The data body can also be used if it is truncated by an exceptional event. This is expressed by an asynchronous exception. A loader for this file format can thus fail by a synchronous and an asynchronous exception. Surprisingly, both orders of nesting these two kinds of exceptional actions are equally expressive. This function converts to the form where the synchronous exception is the outer one. This is a specialisation of 'sequence' and friends. -} swapToSynchronousAsynchronous :: Exceptional e0 (Sync.Exceptional e1 a) -> Sync.Exceptional e1 (Exceptional e0 a) swapToSynchronousAsynchronous ~(Exceptional e0 x) = fmap (Exceptional e0) x swapToAsynchronousSynchronous :: Sync.Exceptional e1 (Exceptional e0 a) -> Exceptional e0 (Sync.Exceptional e1 a) swapToAsynchronousSynchronous x = -- Traversable.sequenceA x force $ case x of Sync.Exception e1 -> pure $ Sync.Exception e1 Sync.Success s -> fmap Sync.Success s -- * Monad/Monoid transformer {- | In contrast to synchronous exceptions, the asynchronous monad transformer is not quite a monad. You must use the 'Monoid' interface or 'bindT' instead. -} newtype ExceptionalT e m a = ExceptionalT {runExceptionalT :: m (Exceptional e a)} fromSynchronousT :: Functor m => a -> Sync.ExceptionalT e m a -> ExceptionalT e m a fromSynchronousT deflt = ExceptionalT . fmap (fromSynchronous deflt) . Sync.runExceptionalT fromSynchronousMonoidT :: (Functor m, Monoid a) => Sync.ExceptionalT e m a -> ExceptionalT e m a fromSynchronousMonoidT = fromSynchronousT mempty instance Functor m => Functor (ExceptionalT e m) where fmap f (ExceptionalT x) = ExceptionalT (fmap (fmap f) x) instance (Monad m, Monoid a) => Monoid (ExceptionalT e m a) where mempty = ExceptionalT $ return mempty mappend x y = ExceptionalT $ appendM (runExceptionalT x) (runExceptionalT y) {- instance Applicative m => Applicative (ExceptionalT e m) where pure = ExceptionalT . pure . pure ExceptionalT f <*> ExceptionalT x = ExceptionalT (fmap (<*>) f <*> x) instance Monad m => Monad (ExceptionalT e m) where return = ExceptionalT . return . return x0 >>= f = ExceptionalT $ do Exceptional ex x <- runExceptionalT x0 Exceptional ey y <- runExceptionalT (f x) return $ Exceptional (ex ++ ey) y -} {- | see 'force' -} forceT :: Monad m => ExceptionalT e m a -> ExceptionalT e m a forceT = ExceptionalT . liftM force . runExceptionalT mapExceptionT :: (Monad m) => (e0 -> e1) -> ExceptionalT e0 m a -> ExceptionalT e1 m a mapExceptionT f = ExceptionalT . liftM (mapException f) . runExceptionalT mapExceptionalT :: (m (Exceptional e0 a) -> n (Exceptional e1 b)) -> ExceptionalT e0 m a -> ExceptionalT e1 n b mapExceptionalT f = ExceptionalT . f . runExceptionalT throwMonoidT :: (Monad m, Monoid a) => e -> ExceptionalT e m a throwMonoidT = ExceptionalT . return . throwMonoid eatNothingT :: Monad m => ExceptionalT (Maybe e) m a -> ExceptionalT e m a eatNothingT = mapExceptionalT (liftM eatNothing) infixl 1 `bindT` {- | The monadic bind operation. It cannot be made an instance of the Monad class method @(>>=)@ since it requires a default return value in case the first action fails. We get this default value by the 'Monoid' method 'mempty'. -} bindT :: (Monad m, Monoid b) => ExceptionalT e m a -> (a -> ExceptionalT e m b) -> ExceptionalT e m b bindT x y = ExceptionalT $ runExceptionalT x >>= \r -> runExceptionalT $ maybe (y $ result r) throwMonoidT (exception r) infixr 1 {- `bindM`, -} `appendM`, `continueM` {- bindM :: (Monad m, Monoid b) => SynchronousExceptional m a -> (a -> AsynchronousExceptional m b) -> AsynchronousExceptional m b bindM x y = Sync.tryT x >>= \result -> liftM Async.force (case result of Sync.Exception e -> return $ Async.throwMonoid e Sync.Success s -> y s) -} appendM :: (Monad m, Monoid a) => m (Exceptional e a) -> m (Exceptional e a) -> m (Exceptional e a) appendM x y = do r <- x liftM (fmap (mappend (result r))) $ continueMPlain (exception r) y continueM :: (Monad m, Monoid a) => m (Maybe e) -> m (Exceptional e a) -> m (Exceptional e a) continueM mx y = mx >>= \x -> continueMPlain x y continueMPlain :: (Monad m, Monoid a) => Maybe e -> m (Exceptional e a) -> m (Exceptional e a) continueMPlain x y = maybe y (return . throwMonoid) x {- | Repeat an action with synchronous exceptions until an exception occurs. Combine all atomic results using the @bind@ function. It may be @cons = (:)@ and @empty = []@ for @b@ being a list type. The @defer@ function may be @id@ or @unsafeInterleaveIO@ for lazy read operations. The exception is returned as asynchronous exception. -} manySynchronousT :: (Monad m) => (m (Exceptional e b) -> m (Exceptional e b)) {- ^ @defer@ function -} -> (a -> b -> b) {- ^ @cons@ function -} -> b {- ^ @empty@ -} -> Sync.ExceptionalT e m a {- ^ atomic action to repeat -} -> m (Exceptional e b) manySynchronousT defer cons empty action = let recourse = liftM force $ defer $ do r <- Sync.tryT action case r of Sync.Exception e -> return (Exceptional (Just e) empty) Sync.Success x -> liftM (fmap (cons x)) recourse in recourse {-# DEPRECATED manySynchronousT "use manyMonoidT with appropriate Monad like LazyIO and result Monoid like Endo instead" #-} {- | We advise to use the Endo Monoid when you want to read a series of characters into a list. This means you use the difference lists technique in order to build the list, which is efficient. > import Data.Monoid (Endo, appEndo, ) > import Control.Exception (try, ) > import qualified Control.Monad.Exception.Synchronous as Sync > fmap (flip appEndo []) $ manyMonoidT (fromSynchronousMonoidT $ fmap (Endo . (:)) $ Sync.fromEitherT $ try getChar) If you want Lazy IO you must additionally convert @getChar@ to LazyIO monad. -} manyMonoidT :: (Monad m, Monoid a) => ExceptionalT e m a {- ^ atomic action to repeat -} -> ExceptionalT e m a manyMonoidT act = let -- like fmap, but doesn't require Functor instance of @m@ customFmap f = mapExceptionalT (liftM (fmap f)) go = act `bindT` \r -> customFmap (mappend r) go in go {- | Scan @x@ using the @decons@ function and run an action with synchronous exceptions for each element fetched from @x@. Each invocation of an element action may stop this function due to an exception. If all element actions can be performed successfully and if there is an asynchronous exception then at the end this exception is raised as synchronous exception. @decons@ function might be @Data.List.HT.viewL@. -} processToSynchronousT_ :: (Monad m) => (b -> Maybe (a,b)) {- ^ decons function -} -> (a -> Sync.ExceptionalT e m ()) {- ^ action that is run for each element fetched from @x@ -} -> Exceptional e b {- ^ value @x@ of type @b@ with asynchronous exception -} -> Sync.ExceptionalT e m () processToSynchronousT_ decons action (Exceptional me x) = let recourse b0 = maybe (maybe (return ()) Sync.throwT me) (\(a,b1) -> action a >> recourse b1) (decons b0) in recourse x explicit-exception-0.1.7.1/src/Control/Monad/Exception/Asynchronous/Strict.hs0000644000000000000000000004053712024050310025357 0ustar0000000000000000module Control.Monad.Exception.Asynchronous.Strict ( Exceptional(..), pure, broken, fromSynchronous, fromSynchronousNull, fromSynchronousMonoid, toSynchronous, throw, throwMonoid, eatNothing, zipWith, append, continue, maybeAbort, force, mapException, mapExceptional, simultaneousBind, simultaneousBindM, sequenceF, traverse, sequenceA, mapM, sequence, swapToSynchronousAsynchronous, swapToAsynchronousSynchronous, ExceptionalT(..), fromSynchronousT, fromSynchronousMonoidT, forceT, mapExceptionT, mapExceptionalT, throwMonoidT, eatNothingT, bindT, manySynchronousT, manyMonoidT, processToSynchronousT_, appendM, continueM, ) where import qualified Control.Monad.Exception.Synchronous as Sync import Control.Monad (mplus, liftM, join, ) import Control.Applicative (Applicative, liftA, ) {- import Data.Traversable (Traversable, ) import Data.Foldable (Foldable, ) -} import Data.Monoid(Monoid, mappend, mempty, ) import Prelude hiding (zipWith, sequence, mapM, ) -- * Plain monad {- | Contains a value and a reason why the computation of the value of type @a@ was terminated. Imagine @a@ as a list type, and an according operation like the 'readFile' operation. If the exception part is 'Nothing' then the value could be constructed regularly. If the exception part is 'Just' then the value could not be constructed completely. However you can read the result of type @a@ lazily, even if an exception occurs while it is evaluated. If you evaluate the exception part, then the result value is certainly computed completely. However, we cannot provide general 'Monad' functionality due to the very different ways of combining the results of type @a@. It is recommended to process the result value in an application specific way, and after consumption of the result, throw a synchronous exception using 'toSynchronous'. Maybe in the future we provide a monad instance which considers subsequent actions as simultaneous processes on a lazy data structure. -} data Exceptional e a = Exceptional {exception :: Maybe e, result :: a} deriving Show {- | Create an exceptional value without exception. -} pure :: a -> Exceptional e a pure = Exceptional Nothing {- | Create an exceptional value with exception. -} broken :: e -> a -> Exceptional e a broken e = Exceptional (Just e) fromSynchronous :: a -> Sync.Exceptional e a -> Exceptional e a fromSynchronous deflt x = case x of Sync.Success y -> Exceptional Nothing y Sync.Exception e -> Exceptional (Just e) deflt fromSynchronousNull :: Sync.Exceptional e () -> Exceptional e () fromSynchronousNull = fromSynchronous () fromSynchronousMonoid :: Monoid a => Sync.Exceptional e a -> Exceptional e a fromSynchronousMonoid = fromSynchronous mempty toSynchronous :: Exceptional e a -> Sync.Exceptional e a toSynchronous (Exceptional me a) = maybe (Sync.Success a) Sync.Exception me {- | I think in most cases we want throwMonoid, thus we can replace 'throw' by 'throwMonoid'. -} throw :: e -> Exceptional e () throw e = broken e () throwMonoid :: Monoid a => e -> Exceptional e a throwMonoid e = broken e mempty {- | You might use an exception of type @Maybe e@ in 'manyMonoidT' in order to stop the loop. After finishing the loop you will want to turn the @Nothing@ exception into a success. This is achieved by this function. -} eatNothing :: Exceptional (Maybe e) a -> Exceptional e a eatNothing (Exceptional e a) = Exceptional (join e) a -- ** handling of special result types {- | This is an example for application specific handling of result values. Assume you obtain two lazy lists say from 'readFile' and you want to zip their contents. If one of the stream readers emits an exception, we quit with that exception. If both streams have throw an exception at the same file position, the exception of the first stream is propagated. -} zipWith :: (a -> b -> c) -> Exceptional e [a] -> Exceptional e [b] -> Exceptional e [c] zipWith f (Exceptional ea a0) (Exceptional eb b0) = let recourse (a:as) (b:bs) = fmap (f a b :) (recourseF as bs) recourse as _ = Exceptional (case as of [] -> mplus ea eb; _ -> eb) [] recourseF as bs = recourse as bs in recourseF a0 b0 infixr 1 `append`, `continue`, `maybeAbort` {- | This is an example for application specific handling of result values. Assume you obtain two lazy lists say from 'readFile' and you want to append their contents. If the first stream ends with an exception, this exception is kept and the second stream is not touched. If the first stream can be read successfully, the second one is appended until stops. 'append' is less strict than the 'Monoid' method 'mappend' instance. -} append :: Monoid a => Exceptional e a -> Exceptional e a -> Exceptional e a append (Exceptional ea a) b = fmap (mappend a) $ continue ea b continue :: Monoid a => Maybe e -> Exceptional e a -> Exceptional e a continue ea b = case ea of -- Just e -> throwMonoid e Just _ -> Exceptional ea mempty Nothing -> b maybeAbort :: Exceptional e a -> Maybe e -> Exceptional e a maybeAbort (Exceptional ea a) eb = Exceptional (mplus ea eb) a {- | 'mappend' must be strict in order to fulfill the Monoid laws @mappend mempty a = a@ and @mappend a mempty = a@ for @a=undefined@. -} instance Monoid a => Monoid (Exceptional e a) where mempty = pure mempty -- mappend = append mappend (Exceptional ea a) (Exceptional eb b) = Exceptional (mplus ea eb) (mappend a (maybe b (const mempty) ea)) {- | construct Exceptional constructor lazily -} {-# INLINE force #-} force :: Exceptional e a -> Exceptional e a force ~(Exceptional e a) = Exceptional e a mapException :: (e0 -> e1) -> Exceptional e0 a -> Exceptional e1 a mapException f (Exceptional e a) = Exceptional (fmap f e) a mapExceptional :: (e0 -> e1) -> (a -> b) -> Exceptional e0 a -> Exceptional e1 b mapExceptional f g (Exceptional e a) = Exceptional (fmap f e) (g a) {- This definition actually fulfills the Functor laws: > fmap (f.g) = fmap f . fmap g > fmap id = id -} instance Functor (Exceptional e) where fmap f (Exceptional e a) = Exceptional e (f a) infixr 1 `simultaneousBind`, `simultaneousBindM` {- | I consider both actions to process the data simultaneously through lazy evaluation. If the second one fails too, it must have encountered an exception in the data that was successfully emitted by the first action, and thus the exception of the second action is probably earlier. We cannot check in general whether the two exception occur at the same time, e.g. the second one might occur since the first occured and left an invalid structure. In this case we should emit the first exception, not the second one. Because of this I expect that this function is not particularly useful. Otherwise it could be used as bind operation for a monad instance. -} {-# DEPRECATED simultaneousBind, simultaneousBindM "Check whether this function is really what you need. It generates an unreasonable exception when the second exception is caused by the first one." #-} simultaneousBind :: Exceptional e a -> (a -> Exceptional e b) -> Exceptional e b simultaneousBind (Exceptional mea a) actB = let Exceptional meb b = actB a in Exceptional (mplus meb mea) b simultaneousBindM :: (Monad m) => m (Exceptional e a) -> (a -> m (Exceptional e b)) -> m (Exceptional e b) simultaneousBindM actA actB = do Exceptional mea a <- actA Exceptional meb b <- actB a return (Exceptional (mplus meb mea) b) -- | Is there a better name? {-# INLINE sequenceF #-} sequenceF :: Functor f => Exceptional e (f a) -> f (Exceptional e a) sequenceF (Exceptional e a) = fmap (Exceptional e) a -- instance Foldable (Exceptional e) where -- instance Traversable (Exceptional e) where {- | @Foldable@ instance would allow to strip off the exception too easily. I like the methods of @Traversable@, but @Traversable@ instance requires @Foldable@ instance. -} {-# INLINE traverse #-} traverse :: Applicative f => (a -> f b) -> Exceptional e a -> f (Exceptional e b) traverse f = sequenceA . fmap f {-# INLINE sequenceA #-} sequenceA :: Applicative f => Exceptional e (f a) -> f (Exceptional e a) sequenceA (Exceptional e a) = liftA (Exceptional e) a {-# INLINE mapM #-} mapM :: Monad m => (a -> m b) -> Exceptional e a -> m (Exceptional e b) mapM f = sequence . fmap f {-# INLINE sequence #-} sequence :: Monad m => Exceptional e (m a) -> m (Exceptional e a) sequence (Exceptional e a) = liftM (Exceptional e) a {- instance Applicative (Exceptional e) where pure = pure f <*> x = case f of Exceptional e0 g -> case x of Exceptional e1 y -> Exceptional (mplus e0 e1) (g y) instance Monad (Exceptional e) where return = pure fail _msg = Exceptional [Just (error "Asynchronous.fail exception")] (error "Asynchronous.fail result") x >>= f = case x of Exceptional e0 y -> case f y of Exceptional e1 z -> Exceptional (e0 ++ e1) z -} {- | Consider a file format consisting of a header and a data body. The header can only be used if is read completely. Its parsing might stop with an synchronous exception. The data body can also be used if it is truncated by an exceptional event. This is expressed by an asynchronous exception. A loader for this file format can thus fail by a synchronous and an asynchronous exception. Surprisingly, both orders of nesting these two kinds of exceptional actions are equally expressive. This function converts to the form where the synchronous exception is the outer one. This is a specialisation of 'sequence' and friends. -} swapToSynchronousAsynchronous :: Exceptional e0 (Sync.Exceptional e1 a) -> Sync.Exceptional e1 (Exceptional e0 a) swapToSynchronousAsynchronous (Exceptional e0 x) = fmap (Exceptional e0) x swapToAsynchronousSynchronous :: Sync.Exceptional e1 (Exceptional e0 a) -> Exceptional e0 (Sync.Exceptional e1 a) swapToAsynchronousSynchronous x = -- Traversable.sequenceA x case x of Sync.Exception e1 -> pure $ Sync.Exception e1 Sync.Success s -> fmap Sync.Success s -- * Monad/Monoid transformer {- | In contrast to synchronous exceptions, the asynchronous monad transformer is not quite a monad. You must use the 'Monoid' interface or 'bindT' instead. -} newtype ExceptionalT e m a = ExceptionalT {runExceptionalT :: m (Exceptional e a)} fromSynchronousT :: Functor m => a -> Sync.ExceptionalT e m a -> ExceptionalT e m a fromSynchronousT deflt = ExceptionalT . fmap (fromSynchronous deflt) . Sync.runExceptionalT fromSynchronousMonoidT :: (Functor m, Monoid a) => Sync.ExceptionalT e m a -> ExceptionalT e m a fromSynchronousMonoidT = fromSynchronousT mempty instance Functor m => Functor (ExceptionalT e m) where fmap f (ExceptionalT x) = ExceptionalT (fmap (fmap f) x) instance (Monad m, Monoid a) => Monoid (ExceptionalT e m a) where mempty = ExceptionalT $ return mempty mappend x y = ExceptionalT $ appendM (runExceptionalT x) (runExceptionalT y) {- instance Applicative m => Applicative (ExceptionalT e m) where pure = ExceptionalT . pure . pure ExceptionalT f <*> ExceptionalT x = ExceptionalT (fmap (<*>) f <*> x) instance Monad m => Monad (ExceptionalT e m) where return = ExceptionalT . return . return x0 >>= f = ExceptionalT $ do Exceptional ex x <- runExceptionalT x0 Exceptional ey y <- runExceptionalT (f x) return $ Exceptional (ex ++ ey) y -} {- | see 'force' -} forceT :: Monad m => ExceptionalT e m a -> ExceptionalT e m a forceT = ExceptionalT . liftM force . runExceptionalT mapExceptionT :: (Monad m) => (e0 -> e1) -> ExceptionalT e0 m a -> ExceptionalT e1 m a mapExceptionT f = ExceptionalT . liftM (mapException f) . runExceptionalT mapExceptionalT :: (m (Exceptional e0 a) -> n (Exceptional e1 b)) -> ExceptionalT e0 m a -> ExceptionalT e1 n b mapExceptionalT f = ExceptionalT . f . runExceptionalT throwMonoidT :: (Monad m, Monoid a) => e -> ExceptionalT e m a throwMonoidT = ExceptionalT . return . throwMonoid eatNothingT :: Monad m => ExceptionalT (Maybe e) m a -> ExceptionalT e m a eatNothingT = mapExceptionalT (liftM eatNothing) infixl 1 `bindT` {- | The monadic bind operation. It cannot be made an instance of the Monad class method @(>>=)@ since it requires a default return value in case the first action fails. We get this default value by the 'Monoid' method 'mempty'. -} bindT :: (Monad m, Monoid b) => ExceptionalT e m a -> (a -> ExceptionalT e m b) -> ExceptionalT e m b bindT x y = ExceptionalT $ runExceptionalT x >>= \r -> runExceptionalT $ maybe (y $ result r) throwMonoidT (exception r) infixr 1 {- `bindM`, -} `appendM`, `continueM` {- bindM :: (Monad m, Monoid b) => SynchronousExceptional m a -> (a -> AsynchronousExceptional m b) -> AsynchronousExceptional m b bindM x y = Sync.tryT x >>= \result -> liftM Async.force (case result of Sync.Exception e -> return $ Async.throwMonoid e Sync.Success s -> y s) -} appendM :: (Monad m, Monoid a) => m (Exceptional e a) -> m (Exceptional e a) -> m (Exceptional e a) appendM x y = do r <- x liftM (fmap (mappend (result r))) $ continueMPlain (exception r) y continueM :: (Monad m, Monoid a) => m (Maybe e) -> m (Exceptional e a) -> m (Exceptional e a) continueM mx y = mx >>= \x -> continueMPlain x y continueMPlain :: (Monad m, Monoid a) => Maybe e -> m (Exceptional e a) -> m (Exceptional e a) continueMPlain x y = maybe y (return . throwMonoid) x {- | Repeat an action with synchronous exceptions until an exception occurs. Combine all atomic results using the @bind@ function. It may be @cons = (:)@ and @empty = []@ for @b@ being a list type. The @defer@ function may be @id@ or @unsafeInterleaveIO@ for lazy read operations. The exception is returned as asynchronous exception. -} manySynchronousT :: (Monad m) => (m (Exceptional e b) -> m (Exceptional e b)) {- ^ @defer@ function -} -> (a -> b -> b) {- ^ @cons@ function -} -> b {- ^ @empty@ -} -> Sync.ExceptionalT e m a {- ^ atomic action to repeat -} -> m (Exceptional e b) manySynchronousT defer cons empty action = let recourse = defer $ do r <- Sync.tryT action case r of Sync.Exception e -> return (Exceptional (Just e) empty) Sync.Success x -> liftM (fmap (cons x)) recourse in recourse {-# DEPRECATED manySynchronousT "use manyMonoidT with appropriate Monad like LazyIO and result Monoid like Endo instead" #-} {- | We advise to use the Endo Monoid when you want to read a series of characters into a list. This means you use the difference lists technique in order to build the list, which is efficient. > import Data.Monoid (Endo, appEndo, ) > import Control.Exception (try, ) > import qualified Control.Monad.Exception.Synchronous as Sync > fmap (flip appEndo []) $ manyMonoidT (fromSynchronousMonoidT $ fmap (Endo . (:)) $ Sync.fromEitherT $ try getChar) If you want Lazy IO you must additionally convert @getChar@ to LazyIO monad. -} manyMonoidT :: (Monad m, Monoid a) => ExceptionalT e m a {- ^ atomic action to repeat -} -> ExceptionalT e m a manyMonoidT act = let -- like fmap, but doesn't require Functor instance of @m@ customFmap f = mapExceptionalT (liftM (fmap f)) go = act `bindT` \r -> customFmap (mappend r) go in go {- | Scan @x@ using the @decons@ function and run an action with synchronous exceptions for each element fetched from @x@. Each invocation of an element action may stop this function due to an exception. If all element actions can be performed successfully and if there is an asynchronous exception then at the end this exception is raised as synchronous exception. @decons@ function might be @Data.List.HT.viewL@. -} processToSynchronousT_ :: (Monad m) => (b -> Maybe (a,b)) {- ^ decons function -} -> (a -> Sync.ExceptionalT e m ()) {- ^ action that is run for each element fetched from @x@ -} -> Exceptional e b {- ^ value @x@ of type @b@ with asynchronous exception -} -> Sync.ExceptionalT e m () processToSynchronousT_ decons action (Exceptional me x) = let recourse b0 = maybe (maybe (return ()) Sync.throwT me) (\(a,b1) -> action a >> recourse b1) (decons b0) in recourse x explicit-exception-0.1.7.1/spaceleak/0000755000000000000000000000000012024050310015574 5ustar0000000000000000explicit-exception-0.1.7.1/spaceleak/Unzip.hs0000644000000000000000000000120712024050310017235 0ustar0000000000000000{- | This module implements something that is very similar to our asynchronous exception approach. However, it does not expose a memory leak. Why? -} module Main where unzipPattern :: [(a,b)] -> ([a], [b]) unzipPattern = foldr (\(a,b) ~(as,bs) -> (a:as, b:bs)) ([], []) unzipSelector :: [(a,b)] -> ([a], [b]) unzipSelector = foldr (\(a,b) asbs -> (a : fst asbs, b : snd asbs)) ([], []) noSpaceLeak :: IO () noSpaceLeak = let xs = repeat ('a', 42::Int) (ys,zs) = unzipSelector xs in do mapM_ putChar ys print $ last zs {- ee-unzip +RTS -M1m -c30 -RTS -} main :: IO () main = noSpaceLeak explicit-exception-0.1.7.1/spaceleak/Tar.hs0000644000000000000000000000350312024050310016657 0ustar0000000000000000module Main where import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Entry as TarEntry import Control.Monad.Exception.Asynchronous (Exceptional(Exceptional), force, pure, throwMonoid, result, exception, ) import qualified Data.ByteString.Lazy as B convert :: Tar.Entries -> Exceptional String [Tar.Entry] convert = force . Tar.foldEntries (\entry -> fmap (entry:)) (pure []) throwMonoid -- the String argument prevents caching and thus a space-leak infinite :: String -> Tar.Entries infinite name = let tar = Tar.Next (TarEntry.directoryEntry $ either error id $ TarEntry.toTarPath True name) tar in tar test :: String test = map (const 'a') $ result $ convert $ infinite "test" spaceLeak0 :: IO () spaceLeak0 = let r = convert $ infinite "bla" e = exception r xs = result r in do mapM_ print [ "dir" | Tar.NormalFile _ _ <- map Tar.entryContent xs ] print e spaceLeak1 :: IO () spaceLeak1 = let Exceptional e xs = convert $ infinite "bla" in do mapM_ print [ "dir" | Tar.NormalFile _ _ <- map Tar.entryContent xs ] print e {- tar c /data1/ | ghc +RTS -M32m -c30 -RTS -e spaceLeak src/Tar.hs tar c /data1/ | ./dist/build/ee-tar/ee-tar +RTS -M32m -c30 -RTS -} spaceLeak :: IO () spaceLeak = do tar <- B.getContents let a = convert (Tar.read tar) -- e = exception a xs = result a print [ B.length bs | Tar.NormalFile bs _ <- map Tar.entryContent xs ] -- print e tarFold :: IO () tarFold = do tar <- B.getContents Tar.foldEntries (\x rest -> case Tar.entryContent x of Tar.NormalFile bs _ -> print (B.length bs) >> rest _ -> rest) (return ()) print (Tar.read tar) main :: IO () main = spaceLeak1 explicit-exception-0.1.7.1/spaceleak/Example.hs0000644000000000000000000000456312024050310017533 0ustar0000000000000000module Main where import Control.Monad.Exception.Asynchronous (Exceptional(Exceptional), force, pure, throwMonoid, broken, result, exception, ) import Control.Monad (mplus, ) import Data.Monoid (Monoid, mappend, mempty, ) convert :: [Either String a] -> Exceptional String [a] convert = emconcat . map (force . either throwMonoid (pure . (:[]))) emconcat :: Monoid a => [Exceptional e a] -> Exceptional e a emconcat = force . foldr (\(Exceptional e a) ~(Exceptional es as) -> Exceptional (mplus e es) (mappend a as)) (pure mempty) econcat :: [Exceptional e a] -> Exceptional e [a] econcat = force . foldr (\(Exceptional e a) ~(Exceptional es as) -> Exceptional (mplus e es) (a:as)) (pure []) convert0 :: [Either String a] -> Exceptional String [a] convert0 = force . -- not quite mconcat, because we need lazy matching on the right operand foldr (\a b -> mappend a (force b)) (pure []) . map (either throwMonoid (pure . (:[]))) convert1 :: [Either String a] -> Exceptional String [a] convert1 = force . foldr (\ea -> force . either (mappend . throwMonoid) (\entry -> fmap (entry:)) ea) (pure []) -- the String argument prevents caching and thus a space-leak infinite :: String -> [Either String Integer] infinite msg = map Right (iterate (1+) 0) ++ [Left msg] -- the String argument prevents caching and thus a space-leak infiniteExc :: String -> [Exceptional String Integer] infiniteExc msg = map (Exceptional Nothing) (iterate (1+) 0) ++ [broken msg 0] skip :: [a] -> [a] skip = map head . iterate (drop 1000) spaceLeak0 :: IO () spaceLeak0 = let r = convert $ infinite "bla" e = exception r xs = result r in do mapM_ print $ skip xs print e spaceLeak1 :: IO () spaceLeak1 = let Exceptional e xs = convert $ infinite "bla" in do mapM_ print $ skip xs print e spaceLeak2 :: IO () spaceLeak2 = let Exceptional e xs = econcat $ infiniteExc "bla" in do mapM_ print $ skip xs print e noSpaceLeak0 :: IO () noSpaceLeak0 = let r = convert $ infinite "bla" _e = exception r xs = result r in mapM_ print $ skip xs noSpaceLeak1 :: IO () noSpaceLeak1 = let Exceptional _e xs = convert $ infinite "bla" in mapM_ print $ skip xs {- ee-test +RTS -M32m -c30 -RTS -} main :: IO () main = spaceLeak2 explicit-exception-0.1.7.1/spaceleak/Writer.hs0000644000000000000000000000122012024050310017377 0ustar0000000000000000{- | This module implements something that is very similar to our asynchronous exception approach. However, it does not expose a memory leak. Why? -} module Main where import qualified Control.Monad.Trans.Writer as W import qualified Data.Monoid as Mn noSpaceLeak0 :: IO () noSpaceLeak0 = let (xs,m) = W.runWriter $ sequence $ repeat $ return 'a' in do mapM_ putChar xs print $ (m :: Mn.Last Int) noSpaceLeak1 :: IO () noSpaceLeak1 = let p = W.runWriter $ sequence $ repeat $ return 'a' in do mapM_ putChar (fst p) print $ (snd p :: Mn.Last Int) {- ee-writer +RTS -M1m -c30 -RTS -} main :: IO () main = noSpaceLeak1