explicit-exception 0.1.4 → 0.1.5

raw patch · 10 files changed

+311/−20 lines, 10 filesdep +applicativedep +bytestringdep +special-functorsdep ~basedep ~transformersnew-component:exe:ee-tarnew-component:exe:ee-testnew-component:exe:ee-unzipnew-component:exe:ee-writerPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: applicative, bytestring, special-functors, tar

Dependency ranges changed: base, transformers

API changes (from Hackage documentation)

Files

• explicit-exception.cabal +67/−11
• spaceleak/Example.hs +96/−0
• spaceleak/Tar.hs +73/−0
• spaceleak/Unzip.hs +34/−0
• spaceleak/Writer.hs +29/−0
• src/Control/Monad/Exception/Asynchronous.hs +1/−0
• src/Control/Monad/Exception/Label.hs +1/−1
• src/Control/Monad/Exception/Synchronous.hs +1/−1
• src/Control/Monad/Label.hs +2/−1
• src/System/IO/Straight.hs +7/−6

@@ -1,5 +1,5 @@ Name:             explicit-exception-Version:          0.1.4+Version:          0.1.5 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -46,23 +46,79 @@ Source-Repository this   type:     darcs   location: http://code.haskell.org/explicit-exception/-  tag:      0.1.4+  tag:      0.1.5 +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: base >= 2, transformers >=0.0 && <0.2+  Build-Depends: transformers >=0.2 && <0.3+  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.Synchronous-  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+  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.10,+      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.10+  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

@@ -0,0 +1,96 @@+module 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

@@ -0,0 +1,73 @@+module 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

@@ -0,0 +1,34 @@+{- |+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

@@ -0,0 +1,29 @@+{- |+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

@@ -222,6 +222,7 @@   {- | construct Exceptional constructor lazily -}+{-# INLINE force #-} force :: Exceptional e a -> Exceptional e a force ~(Exceptional e a) = Exceptional e a 

@@ -15,7 +15,7 @@  import Control.Monad (liftM, ) import Control.Monad.Fix (MonadFix, )-import Control.Monad.Trans (MonadTrans, lift, )+import Control.Monad.Trans.Class (MonadTrans, lift, )   data LabeledException l e =

@@ -60,7 +60,7 @@ import Control.Applicative (Applicative(pure, (<*>))) import Control.Monad (liftM, {- MonadPlus(mzero, mplus), -}) import Control.Monad.Fix (MonadFix, mfix, )-import Control.Monad.Trans (MonadTrans, lift, {- MonadIO(liftIO), -} )+import Control.Monad.Trans.Class (MonadTrans, lift, ) import Control.Monad.Trans.Error (ErrorT(ErrorT, runErrorT)) import Data.Monoid(Monoid, mappend, mempty, Endo(Endo, appEndo), ) 

@@ -18,7 +18,8 @@  import Control.Monad (MonadPlus, ap, ) import Control.Monad.Fix (MonadFix)-import Control.Monad.Trans (MonadTrans, MonadIO)+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 ()

@@ -18,7 +18,7 @@ import qualified Control.Monad.Exception.Synchronous as SyncExc import Control.Exception (IOException) import System.IO.Error (try)-import Control.Monad.Trans (MonadIO, liftIO, )+import Control.Monad.IO.Class (MonadIO, liftIO, )  import System.IO.Unsafe (unsafeInterleaveIO, ) @@ -45,11 +45,12 @@  -- helper classes for defining the MonadIO instance of SIO -{--It's important that no-one else can define instances of MonadSIO-because we cannot assert absence of exceptions in other monads.-It is also important not to export 'toSIO',-since we can also not assert absence of exceptions in IO actions.+{- |+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@. -} class Monad m => MonadSIO m where toSIO :: IO a -> m a instance MonadSIO SIO where toSIO = SIO