safe-lazy-io (empty) → 0.1
raw patch · 15 files changed
+1292/−0 lines, 15 filesdep +basedep +extensible-exceptionsdep +parallelsetup-changed
Dependencies added: base, extensible-exceptions, parallel, strict-io
Files
- LICENSE +28/−0
- README +337/−0
- Setup.lhs +3/−0
- System/IO/Lazy/Input.hs +218/−0
- System/IO/Lazy/Input/Extra.hs +137/−0
- System/IO/Lazy/Input/Internals.hs +145/−0
- System/IO/Lazy/Input/Tests.hs +175/−0
- System/IO/Unsafe/GetContents.hs +126/−0
- examples/cksum.hs +4/−0
- examples/count-words.hs +23/−0
- examples/std-lazy-io/count-lines-better.hs +2/−0
- examples/std-lazy-io/count-lines-good.hs +3/−0
- examples/swap-case.hs +7/−0
- examples/testhgetcontents.hs +41/−0
- safe-lazy-io.cabal +43/−0
+ LICENSE view
@@ -0,0 +1,28 @@+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+ README view
@@ -0,0 +1,337 @@+Hi folks,++We have good news (nevertheless we hope) for all the lazy guys standing there.+Since their birth, lazy IOs have been a great way to modularly leverage all the+good things we have with *pure*, *lazy*, *Haskell* functions to the real world+of files.++We are happy to present the safe-lazy-io package [1] that does exactly this+and is going to be explained and motivated in the rest of this post.++=== The context ===++Although these times were hard with the Lazy/IO technique, some people continue+to defend them arguing that all discovered problems about it was not that harmful+and that taking care was sufficient. Indeed some issues have been discovered about+Lazy/IOs, some have been fixed in the underlying machinery, some have just been+hidden and some others are still around.++== An alternative ==++An alternative design has been proposed --and is still evolving--, it is called+"Iteratee" [2] and has been designed by Oleg Kiselyov. This new design has tons+of advantages over standard imperative IOs, and shares some of the goals of+Lazy/IOs. Iteratee provides a way to do incremental processing in a+high-level style. Indeed both processed data (via enumerators) and processing+code (called iteratee) can be modularly composed. The handling of file-system+resources is precise and safe. Catching errors can be done precisely and can+be interleaved with the processing. In spite of all this, there is an important+drawback: a lot of code has to be re-written and thought in another way.+Processing becomes explicitly chunked which is not always needed and, even+worse, exceptions handling also becomes very explicit. While this makes sense+in a wide range of applications it makes things less natural than the general+case of pure functions. We think that Iteratee have too be studied more, and+we recommend them when you have incrementally react to IO errors.++== Issues of Standard Lazy/IO ==++We think that we can save Lazy/IO cheaply, but before explaining the way we+solve such and such issue, let's first expose Lazy/IO and its issues.++One of the main Lazy/IO functions is 'readFile': it takes a file path opens it+and returns the list of characters until the end of the file is reached. The+characteristic of 'readFile' is that only the opening is done strictly, while+the reading is performed lazily as much as the output list is processed.++Cousins of 'readFile' are 'hGetContents' that takes a file handle and 'getContents'+that reads on the standard input.++This technique enables to process a file as if the file was completely stored+in memory. Because it is read lazily one knows that only the required part of+the file will be read. Even better, if the input is consumed to produce a+small output or the output is emitted incrementally, then the processing can+be done in constant memory space.++Examples:+-- Prints the number of words read on stdin+> countWords = print . length . words =<< getContents+-- Prints the length of the longest line+> maxLineLen = print . maximum . map length . lines =<< getContents+-- Prints in lower case the text read on stdin+> lowerText = interact (map toLower)+-- Alternatively+> lowerText = putStr . map toLower =<< getContents++All these examples are pretty idiomatic Haskell code and make a simple+use of Lazy/IOs. Each of them runs in constant memory space even+if they are declared as if the whole contents were available at once.++By using stream fusion or 'ByteString''s one can get even faster code while+keeping the code almost the same. Here we will stay with the default list+of 'Char''s data type. However one goal of our approach is to be trivially+adaptable to those data types.++Using our library will be rougly a matter of namespace switch plus a running+function:++> lowerText = LI.run' (SIO.putStr . map toLower <$> LI.getContents)++However we will introducing this library as one goes along.++Here is another example where the Lazy/IO are still easy to use but no longer+scales well. This program counts the lines of all the files given in arguments:++> countLines = print . length . lines . concat =<< mapM readFile =<< getArgs++Here the problem is the limitation of simultaneous opened files. Indeed,+all the files are opened at the beginning therefore reaching the limit easily.++It's time to recall when the files are closed. With standard Lazy/IOs the+handle is closed when you reach the end of the file, and so when you've+explored the whole list returned by 'readFile'.++Note also that if you manually open the file and get a handle, then you can+manually close the file, however if by misfortune you close the file and+then still consume the lazy list you will get a truncated list, observing+how much of the file has been read. This last point is due to the fact+that 'readFile' considers the reading error as the end of the file.++In particular one can fix this program, by simply counting the number of lines+of each file separately and then compute the sum to get the final result.++> countLines = print . sum =<< mapM (fmap (length . lines) . readFile) =<< getArgs++However once again this program exhausts the handle resources. Trying+to close the files will not save us either, one just risks getting truncated+files. Indeed the list of intermediate results is produced eagerly but each+intermediate result is lazy and then each file is opened but not immediately+closed since the computation is delayed.+Hopefully adding a bit of strictness cures the problem:++> countLines = print . sum =<< mapM ((return' . length . lines =<<) . readFile) =<< getArgs+> where return' x = x `seq` return x++Until there, we have disclosed three problems:+ * while reading is lazy, opening is strict, which leads to a less+ natural processing of multiple files+ * the closing of files is hard to predict+ * the errors during reading are silently discarded++The last one is a bit trickier and has recently been exposed by Oleg Kiselyov [3].+The problem appears when one gets twice the contents of the same stream---or some kind+of inter-dependent streams. Because reading is implicitly driven by the consumer, the interleaving+of reading may then depend on the reduction strategy employed. This is the case even+if the consumer is a pure function.++Basically in this example one can observe different values when using one of these functions:+> f1 x y = x `seq` y `seq` x - y+> f2 x y = y `seq` x `seq` x - y++In this example one reads stdin twice and relies on the error handling to end one stream while+keeping the other opened. Moreover there are other ways to achieve this like the+use of unix fifo files, or using 'getChanContents' from the "Control.Concurrent.Chan"+module.++=== Our solution ===++Here we will present another design, based on a very simple idea. Our goal is+to provide IO processing in a style very similar to standard Lazy/IO with the+following differences:+ - preservation of the determinism;+ - a simple control exceptions;+ - and a precise management of resources.++Our solution is made of three key ingredients: a bit of strictness, some predefined+schemas to interleave inputs, some scopes and abstract types to delimit lazy input+operations from strict IO operations.++== Dealing with a single input ==++Let's present the first ingredient alone through a first example:++> mapHandleContents :: NFData sa => Handle -> (String -> sa) -> IO sa+> mapHandleContents h f = do+> s <- hGetContents h+> return' (f s) `finally` hClose h++> return' :: (Monad m, NFData sa) => sa -> m sa+> return' x = rnf x `seq` return x++It implements some combination of 'fmap' and 'hGetContents'.+Actually some of our examples fit nicely in that model:++> countWords = print =<< mapHandleContents stdin (length . words)+> maxLineLen = print =<< mapHandleContents stdin (maximum . map length . lines)+> lowerText = putStr =<< mapHandleContents stdin (map toLower)++However while the two first examples work well in this setting, the third one+tries to allocate the whole result in memory before printing it.++Here the ingredient that is used is strictness: the purpose in forcing the+result is to be sure that all the needed input is read, before the file is+closed.++So here we rely on 'NFData' instances to really perform deep forcing---this+kind of assumption is a bit like 'Typeable' instances.+In particular functions must not be an instance of 'NFData': indeed, we have+no way to force lazy values that are stored in the closure of a function.++The same remark applies to the 'IO' monad for at least three reasons:+'IO' if often represented by functions; lazy 'IORef''s could be used+to hide one input for later use; exceptions with a lazy contents could+also be used to make a lazy value escape.++Let's now add some more strictness into the meal: the 'SIO' monad!++== The 'SIO' monad ==++The 'SIO' monad is a thin layer over the 'IO' monad, populated only by+strict 'IO' operations. In particular these operations are strict+in the output, which means that once the output is produced then we know+that the given arguments cannot be further evaluated/forced.+Here is an example of strict IO using the 'SIO' monad:++> import qualified System.IO.Strict as SIO+> import System.IO.Strict (SIO)+> countWords = SIO.run (SIO.print . length . words =<< SIO.getContents)++Of course this function does not scale well since it reads the whole+contents in memory before processing it.++For now the strict-io [4] package contains wrappers for functions+in "System.IO", and strict 'IORef''s.++One can now introduce a function in lines of 'mapHandleContents':++> withHandleContents :: NFData sa => Handle -> (String -> SIO sa) -> IO sa+> withHandleContents h f = do+> s <- hGetContents h+> SIO.run (f s) `finally` hClose h++One can then rewrite 'lowerText' as follow:++> lowerText = withHandleContents stdin (SIO.putStr . map toLower)++Until there one can deal quite nicely with single input, many outputs+processing. Currently the only requirement is to delimit a scope where+the resource will be used to return a strict value.++Dealing with multiple inputs will lead us to our final design of lazy+inputs.++== Introducing 'LI', Lazy Inputs ==++We first introduce a type for these lazy inputs namely 'LI'.+This type is abstract and we will progressively introduce functions+to build, combine and run them.++The 'LI' type is a pointed functor, but not necessarily a monad nor+an applicative functor.++Therefore one exports the 'pure' function as 'pureLI'. Building primitives+allow to read files or handles:++> LI.pureLI :: a -> LI a+> LI.hGetContents :: Handle -> LI String+> LI.getContents :: LI String+> LI.readFile :: FilePath -> LI String+> LI.getChanContents :: Chan a -> LI [a]++Being a functor is important: it allows to wholly transform the underlying+input lazily using standard functions about lists for instance:++> length <$> LI.readFile "foo"+> words <$> LI.readFile "foo"++Extracting a final value of a lazy input ('LI' type) is a matter of using:++> LI.run :: (NFData sa) => LI sa -> IO sa+Or+> LI.run' :: (NFData sa) => LI (SIO a) -> IO sa++One can therefore re-write our examples using lazy inputs:++> -- embedded printing+> countWords = LI.run' (SIO.print . length . words <$> LI.getContents)+> -- external printing+> maxLineLen = print =<< LI.run (maximum . map length . lines <$> LI.getContents)+> lowerText = LI.run' (SIO.putStr . map toLower <$> LI.getContents)++== Combining inputs ==++Finally we come to managing multiple inputs. To get both laziness and+precise resource management we will provide dedicated combinators.+The first one is as simple as appending.++> LI.append :: NFData sa => LI [sa] -> LI [sa] -> LI [sa]++This one produces a single stream out that sequences the two given streams.+It also sequences the usage of resources: the first resource is closed and+then the second one is opened.++Note that this combinator is still quite general since one can process each+input beforehand:++> -- one can drop parts of the inputs+> (take 100 <$> i1) `LI.append` (drop 100 <$> i2)+> -- one can tag each input to know where they come from+> Left <$> i1 `LI.append` Right <$> i2++The second one is 'LI.zipWith' which opens the two resources and joins the items+into a single stream. Again, since 'LI' is a functor one can join not only+characters but also words, lines, chunks... A problem with zipping is that it+stops on the shorter input (loosing a part of the other), hopefully one can+prolongate them:++> zipMaybesWith :: (NFData sa, NFData sb) -> (Maybe sa -> Maybe sb -> c) -> LI [sa] -> LI [sb] -> LI [c]+> zipMaybesWith f xs ys =+> map (uncurry f) . takeWhile someJust <$> zip (prolongate <$> xs) (prolongate <$> ys)+> where someJust (Nothing, Nothing) = False+> someJust _ = True+> prolongate :: [a] -> [Maybe a]+> prolongate zs = map Just zs ++ repeat Nothing++The last one is 'LI.interleave':++> LI.interleave :: (NFData sa) -> LI [sa] -> LI [sa] -> LI [sa]++This function is currently left biased, moreover each resource is closed as soon+as we reach its end. However since the inputs are mixed up together one generally+prefers a tagged version trivially build upon this one:++> interleaveEither :: (NFData sa, NFData sb) => LI [sa] -> LI [sb] -> LI [Either sa sb]+> interleaveEither a b = interleave (map Left <$> a) (map Right <$> b)++Here are some final programs that scale well with the number of files.++> -- number of words in the given files+> main = print =<< LI.run . fmap (length . words) . LI.concat . map LI.readFile =<< getArgs++> -- almost the same thing but counts words independently in each file+> main = print+> =<< LI.run . fmap sum . LI.sequence . map (fmap (length . words) . LI.readFile)+> =<< getArgs++> -- prints to stdout swap-cased concatenation of all input files+> main = LI.run' . (fmap (SIO.putStr . fmap swapCase) . LI.concat . map LI.readFile) =<< getArgs+> where swapCase c | isUpper c = toLower c+> | otherwise = toUpper c++> -- sums character code points of inputs+> main = print =<< LI.run . fmap (sum . map (toInteger . ord)) . LI.concat . map LI.readFile =<< getArgs++Our solution is from now widely available as an Hackage package named "safe-lazy-io" [4].++We hope you will freely enjoy using Lazy/IO again!++As usual, criticisms, comments, and help are expected!++Finally, I would like to thank Benoit Montagu and Francois Pottier for helping+me out to polish this work!++Nicolas Pouillard++[1]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/safe-lazy-io+[2]: http://okmij.org/ftp/Streams.html+[3]: http://www.haskell.org/pipermail/haskell/2009-March/021064.html+[4]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/strict-io
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ System/IO/Lazy/Input.hs view
@@ -0,0 +1,218 @@+--------------------------------------------------------------------+-- !+-- Module : System.IO.Lazy.Input+-- Copyright : (c) Nicolas Pouillard 2009+-- License : BSD3+--+-- Maintainer : Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++module System.IO.Lazy.Input+(+ -- * Types+ LI,++ -- * Running+ run, -- :: (NFData sa) => LI sa -> IO sa+ run', -- :: (NFData sa) => LI (SIO a) -> IO sa+ runAsSIO, -- :: (NFData sa) => LI sa -> SIO sa+ runAsSIO', -- :: (NFData sa) => LI sa -> SIO sa++ -- * Basic inputs+ pureLI, -- :: a -> LI a+ hGetContents, -- :: Handle -> LI String+ getContents, -- :: LI String+ readFile, -- :: FilePath -> LI String+ getChanContents, -- :: Chan a -> LI [a]++ -- * Combining multiple inputs lazily++ -- ** Combining them in sequence+ append, -- :: (NFData sa) => LI [sa] -> LI [sa] -> LI [sa]+ concat, -- :: (NFData sa) => [LI [sa]] -> LI [sa]++ -- ** Combining them in parallel+ interleave, -- :: (NFData sa) => LI [sa] -> LI [sa] -> LI [sa]+ interleaveEither, -- :: (NFData sa, NFData sb) => LI [sa] -> LI [sb] -> LI [Either sa sb]+ -- interleaveHandles, -- :: Handle -> Handle -> LI [Either Char Char]+ zip, -- :: (NFData sa, NFData sb) => LI [sa] -> LI [sb] -> LI [(sa, sb)]+ zipWith, -- :: (NFData sa, NFData sb) => (sa -> sb -> c) -> LI [sa] -> LI [sb] -> LI [c]+ zipMaybesWith, -- :: (NFData sa, NFData sb) => (Maybe sa -> Maybe sb -> c) -> LI [sa] -> LI [sb] -> LI [c]+ zipHandles, -- :: Handle -> Handle -> LI [(Char, Char)]++ -- * Debugging+ trace -- :: String -> LI a -> LI a+)+where++import Prelude hiding (zip, zipWith, readFile, concat, sequence, getContents)+import qualified Data.List as L+import System.IO (Handle)+import qualified System.IO as IO+import System.IO.Unsafe (unsafeInterleaveIO)+import qualified System.IO.Strict as SIO+import qualified System.IO.Strict.Internals as SIO.Internals+import System.IO.Lazy.Input.Internals+import System.IO.Unsafe.GetContents (unsafeHGetContents)+import System.IO.Strict (SIO, return')+import Data.Function+import Control.Parallel.Strategies (NFData(..))+import Control.Concurrent.Chan (Chan)+import qualified Control.Concurrent.Chan as CH+import Control.Applicative+import Control.Monad hiding (sequence)++-- | Any pure data can lifted as lazy input.+pureLI :: a -> LI a+pureLI = LI . return . pure++-- | Extract the data from a lazy input, this is commonly+-- used to actually run the given process over lazy inputs.+-- As in all the functions that requires a 'NFData' instance+-- this means the result will forced using 'rnf'.+run :: NFData sa => LI sa -> IO sa+run = run' . fmap return'++-- | Pretty much as 'run' expect that one can use strict+-- /IO/s ("System.IO.Strict") to produce the final result.+run' :: NFData sa => LI (SIO sa) -> IO sa+run' (LI startX) = startX >>= finalize . fmap SIO.run++-- | Pretty much as 'run' but live in the 'SIO' monad instead of 'IO'.+runAsSIO :: NFData sa => LI sa -> SIO sa+runAsSIO = SIO.Internals.wrap1 run++-- | Pretty much as 'run'' but live in the 'SIO' monad instead of 'IO'.+runAsSIO' :: NFData sa => LI (SIO sa) -> SIO sa+runAsSIO' = SIO.Internals.wrap1 run'++-- | Returns the contents of the given handle lazily.+hGetContents :: Handle -> LI String+hGetContents h = unsafeHGetContents h `finallyLI` IO.hClose h++-- | Returns the contents of standard input lazily.+getContents :: LI String+getContents = hGetContents IO.stdin++-- | Add debugging messages using the given string.+-- This will returns the same lazy input but more verbose.+trace :: String -> LI a -> LI a+trace msg (LI startA) = LI $ do putStrLn $ "Starting " ++ msg+ a `Finally` releaseA <- startA+ putStrLn $ "Started " ++ msg+ return $ Finally a $ do+ putStrLn $ "Stopping " ++ msg+ releaseA+ putStrLn $ "Stopped " ++ msg++-- | Sequence two lazy inputs that produces lists as one only+-- list. Note that the resource management is precise. As+-- soon as the beginning of the second input is required,+-- the resource of the first input is released and the+-- the second resource is acquired.+append :: NFData sa => LI [sa] -> LI [sa] -> LI [sa]+append (LI startA) (LI startB) = LI $ do+ xs `Finally` releaseA <- startA+ ~(ys `Finally` releaseB) <- unsafeInterleaveIO $ releaseA >> startB+ return $ (rnfList xs ++ ys) `Finally` releaseB++-- | Same as 'append' but for a list of inputs.+concat :: (NFData sa) => [LI [sa]] -> LI [sa]+concat = foldr append (pureLI [])++-- | Takes two lazy inputs and returns a single interleaved lazy input.+-- Note that this function is left biased, this is always the left+-- canal that is read first. This function is rarely used directly+-- with file contents since it mixes the two contents, one generally+-- use some tagging to separate them back. Look at 'interleaveEither'+-- for such a function.+interleave :: (NFData sa) => LI [sa] -> LI [sa] -> LI [sa]+interleave (LI startA) (LI startB) = LI $ do+ xs0 `Finally` releaseA <- startA+ ys0 `Finally` releaseB <- startB+ lazyReleaseA <- unsafeInterleaveIO releaseA+ lazyReleaseB <- unsafeInterleaveIO releaseB+ let loopLeft (x:xs) ys = rnf x `seq` (x : loopRight xs ys)+ loopLeft [] ys = lazyReleaseA `seq` ys+ loopRight xs (y:ys) = rnf y `seq` (y : loopLeft xs ys)+ loopRight xs [] = lazyReleaseB `seq` xs+ return $ loopLeft xs0 ys0 `Finally` (lazyReleaseA `seq` lazyReleaseB `seq` return ())++-- | Like 'interleave' but it starts by tagging the left input by 'Left' and right+-- input by 'Right' leading to lazy input of 'Either's.+interleaveEither :: (NFData sa, NFData sb) => LI [sa] -> LI [sb] -> LI [Either sa sb]+interleaveEither a b = interleave (map Left <$> a) (map Right <$> b)+ +-- use select+{-+-- | This function is very close to a combination of 'interleaveEither' and two+-- 'hGetContents', however it will wait for the first input that is ready+-- to be read. So this one is not left biased.+interleaveHandles :: Handle -> Handle -> LI [Either Char Char]+interleaveHandles h1 h2 = LI $ loop >>= (`Finally` (IO.hClose h1 >> IO.hClose h2))+ where loop = unsafeInterleaveIO $+ (do h1ready <- IO.hReady h1+ if h1ready then readLeft else readRight+ ) `catchEOF` (map Right <$> unsafeHGetContents h2)+ readRight = (do c <- IO.hGetChar h2+ rest <- loop+ return (Right c : rest)+ ) `catchEOF` (map Left <$> unsafeHGetContents h1)+ readLeft = do c <- IO.hGetChar h1+ rest <- loop+ return (Left c : rest)+-}++-- | Combine two lazy inputs as a single lazy input of pairs.+--+-- Note that if one input list is short, excess elements of the longer list are discarded.+zip :: (NFData sa, NFData sb) => LI [sa] -> LI [sb] -> LI [(sa, sb)]+zip = zipWith (,)++-- | 'zipWith' generalize 'zip' with any combining function.+zipWith :: (NFData sa, NFData sb) => (sa -> sb -> c) -> LI [sa] -> LI [sb] -> LI [c]+zipWith f (LI startA) (LI startB) = LI $ do+ xs `Finally` releaseA <- startA+ ys `Finally` releaseB <- startB+ let f' x y = rnf x `seq` rnf y `seq` f x y+ return $ L.zipWith f' xs ys `Finally` (releaseA >> releaseB)++zipMaybesWith :: (NFData sa, NFData sb) => (Maybe sa -> Maybe sb -> c) -> LI [sa] -> LI [sb] -> LI [c]+zipMaybesWith f xs ys =+ map (uncurry f) . takeWhile someJust <$> zip (prolongate <$> xs) (prolongate <$> ys)+ where someJust (Nothing, Nothing) = False+ someJust _ = True+ prolongate :: [a] -> [Maybe a]+ prolongate zs = map Just zs ++ repeat Nothing++-- | A shorthand for @\\h1 h2-> zip (hGetContents h1) (hGetContents h2)@.+zipHandles :: Handle -> Handle -> LI [(Char, Char)]+zipHandles = zip `on` hGetContents++-- | Like 'hGetContents' but it takes a 'FilePath'.+readFile :: FilePath -> LI String+readFile fp = LI $ do+ h <- IO.openFile fp IO.ReadMode+ x <- unsafeHGetContents h+ return $ x `Finally` IO.hClose h++-- |Return a lazy list representing the contents of the supplied+-- 'Chan', much like 'System.IO.hGetContents'.+getChanContents :: Chan a -> LI [a]+getChanContents ch = nonFinalized go+ where go = unsafeInterleaveIO $ do+ x <- CH.readChan ch+ xs <- go+ return (x:xs)++{-+joinLISIO :: LI (SIO a) -> LI a+joinLISIO x = x !>>= id++runSIOinIO :: NFData a => LI (SIO a) -> IO a+runSIOinIO = runIO . joinLISIO+-}+
+ System/IO/Lazy/Input/Extra.hs view
@@ -0,0 +1,137 @@+--------------------------------------------------------------------+-- !+-- Module : System.IO.Lazy.Input+-- Copyright : (c) Nicolas Pouillard 2009+-- License : BSD3+--+-- Maintainer : Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++module System.IO.Lazy.Input.Extra+(+ -- ** Various strictier input sequencing+ lift2MayForceFirst, -- :: (NFData sa) => (sa -> b -> c) -> LI sa -> LI b -> LI c+ lift2ForceFirst, -- :: (NFData sa) => (sa -> b -> c) -> LI sa -> LI b -> LI c+ lift2ForceSecond, -- :: (NFData sb) => (a -> sb -> c) -> LI a -> LI sb -> LI c+ lift2ForceBoth, -- :: (NFData sa, NFData sb) => (sa -> sb -> c) -> LI sa -> LI sb -> LI c+ (!>>=), -- :: (NFData sa) => LI sa -> (sa -> LI b) -> LI b+ (=<<!), -- :: (NFData sa) => (sa -> LI b) -> LI sa -> LI b+ ap', -- :: (NFData sa) => LI (sa -> b) -> LI sa -> LI b+ sequence, -- :: (NFData sa) => [LI sa] -> LI [sa]+)+where++import Prelude hiding (zip, zipWith, readFile, concat, sequence, getContents)+import System.IO.Unsafe (unsafeInterleaveIO)+import System.IO.Lazy.Input.Internals+import System.IO.Lazy.Input+import Control.Parallel.Strategies (NFData(..))+import Control.Applicative+import Control.Monad hiding (sequence)++{- | Lift a pure two arguments function, to a function over lazy inputs.++ Note that the only the first argument /may/ be deeply forced.+ In particular it is deeply forced if the function use its second argument.++ The strictness is here to enforce the evaluation order of reading inputs.++ Since too much strictness breaks the interest of lazy inputs, one provides+ more specific but lazier combinators like 'append', 'interleave', and 'zip'.+-}+lift2MayForceFirst :: (NFData sa) => (sa -> b -> c) -> LI sa -> LI b -> LI c+lift2MayForceFirst f (LI startA) (LI startB) = LI $ do+ x `Finally` releaseA <- startA+ y `Finally` releaseB <- startB+ lazyReleaseA <- unsafeInterleaveIO releaseA+ let r = f x (rnf x `seq` lazyReleaseA `seq` y)+ return $ r `Finally` (lazyReleaseA `seq` releaseB)++{- | Lift a pure two arguments function, to a function over lazy inputs.++ Note that the only the first argument is deeply forced before calling the function.++ The strictness is here to enforce the evaluation order of reading inputs.++ This lifting function can be generalized to n-ary functions, all arguments+ but the last one will be deeply forced.++ @+ liftN f mx1 mx2 ... mxN = mx1 !>>= \x1 -> mx2 !>>= \x2 -> ... f x1 x2 <$> mxN+ @+-}+lift2ForceFirst :: (NFData sa) => (sa -> b -> c) -> LI sa -> LI b -> LI c+lift2ForceFirst f mx my = mx !>>= \x -> f x <$> my++{- Like 'lift2ForceFirst' but only force the second argument.++ This lifting function can be generalized to n-ary functions, all arguments+ but the first one will be deeply forced.++ @+ liftN f mx1 mx2 ... mxN = f <$> mx1 `ap'` mx2 `ap'` ... `ap'` mxN+ @+-}+lift2ForceSecond :: (NFData sb) => (a -> sb -> c) -> LI a -> LI sb -> LI c+lift2ForceSecond f mx my = f <$> mx `ap'` my++{- | Lift a pure two arguments function, to a function over lazy inputs.++ Note that both arguments are deeply forced before calling the function.+ See 'lift2ForceFirst' and 'lift2ForceSecond' for lazier versions.++ This one can also be generalized to n-ary functions:++ @+ liftN f mx1 mx2 ... mxN = pureLI f `ap'` mx1 `ap'` mx2 `ap'` ... `ap'` mxN+ @+-}+lift2ForceBoth :: (NFData sa, NFData sb) => (sa -> sb -> c) -> LI sa -> LI sb -> LI c+lift2ForceBoth f mx my = pureLI f `ap'` mx `ap'` my++-- | Combines a function wrapped as a lazy input and an argument.+-- This is like 'ap' or '<*>' but stricter.+--+-- Note that since functions types are not member of 'NFData', this function+-- is the only one dealing with functions wrapped as lazy inputs.+--+-- However as with 'ap' or '<*>', this function generalize 'lift2ForceSecond', 'lift3Fst'...+--+-- Example:+-- @+-- lift3Fst f x y z = f <$> x `ap'` y `ap'` z+--+-- lift3strict f x y z = pureLI f `ap'` x `ap'` y `ap'` z+-- @+--+-- The 'ap'' function only deeply force the second argument, so in the case+-- of chaining, the arguments will be forced from left to right. Note that+-- if one starts the chain by lifting the function using 'pureLI', then all+-- the arguments will be forced. One can let one of the arguments lazy+-- by using note however that if one start the chain with '<$>' (same as+-- 'fmap' or 'liftM') then the first argument would not be forced, but one+-- can start with 'pureLI'+ap' :: (NFData sa) => LI (sa -> b) -> LI sa -> LI b+ap' (LI startF) marg = LI $ do+ f `Finally` releaseF <- startF+ arg <- run marg+ return $ f arg `Finally` releaseF+infixl 4 `ap'`++-- | Turns a list of lazy inputs as an input of list.+sequence :: (NFData sa) => [LI sa] -> LI [sa]+sequence = foldr (lift2ForceFirst (:)) (pureLI [])++-- | A kind of strict /bind/ over lazy inputs.+infixl 1 !>>=+(!>>=) :: (NFData sa) => LI sa -> (sa -> LI b) -> LI b+ma !>>= f = LI $ run ma >>= startLI . f++-- | Same as '!>>=' but with arguments flipped.+infixr 1 =<<!+(=<<!) :: (NFData sa) => (sa -> LI b) -> LI sa -> LI b+(=<<!) = flip (!>>=)+
+ System/IO/Lazy/Input/Internals.hs view
@@ -0,0 +1,145 @@+--------------------------------------------------------------------+-- |+-- Module : System.IO.Lazy.Input.Internals+-- Copyright : (c) Nicolas Pouillard 2009+-- License : BSD3+--+-- Maintainer : Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++module System.IO.Lazy.Input.Internals+(+ -- * Finalized values+ Finalized(..),+ finalize,++ -- * Lazy inputs internals+ LI(..),+ nonFinalized,+ finallyLI,++ -- * Misc+ mapFinalized,+ catchEOF,+ -- simpleUnsafeHGetContents,+ chanFromList,+ rnfList+)+where++import System.IO (Handle)+import qualified System.IO as IO+import qualified System.IO.Error as IO+import System.IO.Unsafe (unsafeInterleaveIO)+import Control.Exception (finally, throwIO)+import Control.Parallel.Strategies (NFData(..))+import Control.Concurrent.Chan (Chan)+import qualified Control.Concurrent.Chan as CH+import Control.Monad+import Control.Applicative++-- | Values with their finalizer.+data Finalized a = Finally { finalized :: a+ , finalizer :: IO () -- NOTE this field must be lazy, look at 'append'+ }++instance Functor Finalized where+ fmap f (a `Finally` finalizeA) = f a `Finally` finalizeA++instance Applicative Finalized where+ pure x = x `Finally` return ()+ (f `Finally` finalizeF) <*> (x `Finally` finalizeX) = f x `Finally` (finalizeF >> finalizeX)++-- | Run a /finalized/ computation.+finalize :: Finalized (IO a) -> IO a+finalize (f `Finally` finalizeF) = f `finally` finalizeF++-- | This the type lazy input data.+--+-- Note that the lazy input type ('LI') is a member of 'Functor',+-- this means that one can update the contents of the input with+-- any pure function.+--+-- 'LI' could be a strict monad and a strict applicative functor.+-- However it is not a lazy monad nor a lazy applicative functor as required Haskell.+-- Hopefully it is a lazy (pointed) functor at least.+newtype LI a = LI { startLI :: IO (Finalized a) }++instance Functor LI where+ fmap f = LI . fmap (fmap f) . startLI++-- | Update the underlying 'Finalized' value.+mapFinalized :: (Finalized a -> Finalized b) -> LI a -> LI b+mapFinalized f = LI . fmap f . startLI++-- | Build lazy input ('LI') from an 'IO' computation and a 'finalizer'.+finallyLI :: IO a -> IO () -> LI a+finallyLI x finalizeX = LI $ (`Finally` finalizeX) <$> x++-- | Build lazy input ('LI') from an 'IO' computation.+-- Use this function when the computation does not require a finalizer.+nonFinalized :: IO a -> LI a+nonFinalized = LI . fmap pure++{-+-- |+-- 'simpleUnsafeHGetContents' behave pretty much the same as+-- 'System.IO.hGetContents' but does not discard I\/O errors encountered+-- which a handle is semi-closed, this is mhy this function is unsafe.+--+-- Computation 'simpleUnsafeGetContents' @hdl@ returns the list of characters+-- corresponding to the unread portion of the channel or file managed+-- by @hdl@, which is put into an intermediate state, /semi-closed/.+-- In this state, @hdl@ is effectively closed,+-- but items are read from @hdl@ on demand and accumulated in a special+-- list returned by 'simpleUnsafeGetContents' @hdl@.+--+-- Any operation that fails because a handle is closed,+-- also fails if a handle is semi-closed. The only exception is 'hClose'.+-- A semi-closed handle becomes closed:+--+-- * if 'hClose' is applied to it;+--+-- * if an I\/O error occurs when reading an item from the handle;+--+-- * or once the entire contents of the handle has been read.+--+-- Once a semi-closed handle becomes closed, the contents of the+-- associated list becomes fixed. The contents of this final list is+-- only partially specified: it will contain at least all the items of+-- the stream that were evaluated prior to the handle becoming closed.+--+-- Any I\/O errors encountered while a handle is semi-closed are simply+-- discarded.+--+-- This operation may fail with:+--+-- * 'isEOFError' if the end of file has been reached.+simpleUnsafeHGetContents :: Handle -> IO String+simpleUnsafeHGetContents h = unsafeInterleaveIO $ (do+ x <- IO.hGetChar h+ xs <- simpleUnsafeHGetContents h+ return (x : xs)+ ) `catchEOF` return []+-}++-- | @x \`catchEOF\` y@ performs @x@ and if it fails due to the EOF error then performs @y@.+catchEOF :: IO a -> IO a -> IO a+x `catchEOF` y = x `catch` (\e -> if IO.isEOFError e then y else throwIO e)++-- | Take a list and returns a new channel the list written in it.+chanFromList :: [a] -> IO (Chan a)+chanFromList xs = do+ ch <- CH.newChan+ CH.writeList2Chan ch xs+ return ch++-- | This function lazily returns an element strict list.+-- It is lazier than @rnf@ and stricter than @map (\\x-> rnf x `seq` x)@.+rnfList :: NFData sa => [sa] -> [sa]+rnfList [] = []+rnfList (x:xs) = rnf x `seq` (x:rnfList xs)+
+ System/IO/Lazy/Input/Tests.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE Rank2Types #-}+--------------------------------------------------------------------+-- |+-- Module : System.IO.Lazy.Input.Tests+-- Copyright : (c) Nicolas Pouillard 2009+-- License : BSD3+--+-- Maintainer : Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++module System.IO.Lazy.Input.Tests where++import Prelude hiding (zipWith)+import qualified Data.List as L+import qualified System.IO as IO+import System.IO.Unsafe (unsafeInterleaveIO)+import Control.Parallel.Strategies (NFData(..))+import Control.Applicative+import Control.Monad+import Data.IORef+import System.IO.Strict (SIO, return')+import qualified System.IO.Strict as SIO+import qualified System.IO.Strict.Internals as SIO+import qualified System.IO.Lazy.Input as LI+import qualified System.IO.Lazy.Input.Extra as LI+import System.IO.Lazy.Input.Internals (LI(..), Finalized(..), chanFromList)+import System.IO.Lazy.Input.Extra ((!>>=), (=<<!), ap')+import System.IO.Lazy.Input (pureLI)+import Debug.Trace (trace)++harness :: LI [a] -> LI [a]+harness (LI start) = LI $ do isOpenRef <- newIORef True+ xs0 `Finally` release <- start+ let go [] = return []+ go (x:xs) = do isOpen <- readIORef isOpenRef+ unless isOpen $ fail msg+ xs' <- unsafeInterleaveIO $ go xs+ return $ x : xs'+ msg = "System.IO.Lazy.Input.harness: try to read a closed input"+ xs0' <- unsafeInterleaveIO $ go xs0+ return $ xs0' `Finally` (release >> writeIORef isOpenRef False)++wrongInterleave :: LI [sa] -> LI [sa] -> LI [sa]+wrongInterleave (LI startA) (LI startB) = LI $ do+ xs0 `Finally` releaseA <- startA+ ys0 `Finally` releaseB <- startB+ lazyReleaseA <- unsafeInterleaveIO releaseA+ lazyReleaseB <- unsafeInterleaveIO releaseB+ let loopLeft (x:xs) ys = x : loopRight xs ys+ loopLeft [] ys = lazyReleaseA `seq` ys+ loopRight xs (y:ys) = y : loopLeft xs ys+ loopRight xs [] = lazyReleaseB `seq` xs+ return $ loopLeft xs0 ys0 `Finally` (lazyReleaseA `seq` lazyReleaseB `seq` return ())++wrongZipWith :: (sa -> sb -> c) -> LI [sa] -> LI [sb] -> LI [c]+wrongZipWith f (LI startA) (LI startB) = LI $ do+ xs `Finally` releaseA <- startA+ ys `Finally` releaseB <- startB+ return $ L.zipWith f xs ys `Finally` (releaseA >> releaseB)++wrongLift2 :: (NFData sc) => (a -> b -> sc) -> LI a -> LI b -> LI sc+wrongLift2 f (LI startA) (LI startB) = LI $ do+ x `Finally` releaseA <- startA+ y `Finally` releaseB <- startB+ let r = f x y+ return $ (rnf r `seq` r) `Finally` (releaseA >> releaseB)++wrongAp :: LI (a -> b) -> LI a -> LI b+wrongAp (LI startF) (LI startArg) = LI $ do+ f `Finally` releaseF <- startF+ arg `Finally` releaseArg <- startArg+ return $ f arg `Finally` (releaseF >> releaseArg)+infixl 4 `wrongAp`++{- does not compose well since it cannot returns functions+ap' :: (NFData sb) => LI (a -> sb) -> LI a -> LI sb+ap' (LI startF) (LI startArg) = LI $ do+ f `Finally` releaseF <- startF+ arg `Finally` releaseArg <- startArg+ let r = f arg+ rnf r `seq` (releaseF >> releaseArg)+ return $ r `Finally` return ()+infixl 4 `ap'`+-}++wrongBind :: LI a -> (a -> LI b) -> LI b+LI startA `wrongBind` f =+ LI $ do a `Finally` releaseA <- startA+ r `Finally` releaseR <- startLI $ f a+ return $ r `Finally` (releaseA >> releaseR)++wrongRun :: NFData a => LI a -> IO a+wrongRun (LI start) = do r `Finally` release <- start+ release+ return' r++wrongRun' :: NFData a => LI (SIO a) -> IO a+wrongRun' (LI start) = do f `Finally` release <- start+ r <- SIO.rawRun f+ release+ return' r++shallowed :: [a] -> [a]+shallowed model = map (model!!) [0..]++wrongAppend :: NFData sa => LI [sa] -> LI [sa] -> LI [sa]+wrongAppend (LI startA) (LI startB) = LI $ do+ xs `Finally` releaseA <- startA+ ~(ys `Finally` releaseB) <- unsafeInterleaveIO $ releaseA >> startB+ return $ (map (\x->rnf x `seq` x) xs ++ ys) `Finally` releaseB++veryWrongAppend :: LI [a] -> LI [a] -> LI [a]+veryWrongAppend (LI startA) (LI startB) = LI $ do+ xs `Finally` releaseA <- startA+ ~(ys `Finally` releaseB) <- unsafeInterleaveIO $ releaseA >> startB+ return $ (xs ++ ys) `Finally` releaseB++testAppend :: (forall sa . NFData sa => LI [sa] -> LI [sa] -> LI [sa]) -> IO Bool+testAppend appe = do ch <- chanFromList [1,(2::Int)]+ let mxs = take 2 <$> harness (LI.getChanContents ch)+ (==[[4],[3],[1,2]]) <$> LI.run (reverse <$> appe ((:[[3]]) <$> mxs) (pureLI [[4]]))++test :: ([Int] -> [Int]) -> (([Int] -> [Int] -> Int) -> LI [Int] -> LI [Int] -> LI Int) -> IO Bool+test rewrap tested = (==) <$> g f1 <*> g f2+ where f1 x y = x `seq` y `seq` x - y+ f2 x y = y `seq` x `seq` x - y+ g f = do ch <- chanFromList [1,2]+ let mxs = rewrap <$> harness (shallowed <$> LI.getChanContents ch)+ LI.run $ tested (\ a b -> f (head a) (head b)) mxs mxs++runTests :: IO ()+runTests = do+ assertIO "lift2ForceFirst" $ test (take 1) LI.lift2ForceFirst+ assertIO "lift2ForceSecond" $ test (take 1) LI.lift2ForceSecond+ assertIO "lift2ForceBoth" $ test (take 1) LI.lift2ForceBoth+ assertIOwrong "wrongLift2" $ test id wrongLift2+ assertIO "lift2MayForceFirst" $ test (take 1) LI.lift2MayForceFirst+ assertIO "zipWith" $ test (take 1) (wrapZipWith LI.zipWith)+ assertIOwrong "wrongZipWith" $ test id (wrapZipWith wrongZipWith)+ assertIOwrong "wrongInterleave" $ test id (wrapInterleave wrongInterleave)+ assertIO "interleave" $ test (take 1) (wrapInterleave LI.interleave)+ assertIO "ap'" $ test (take 1) (\f x y -> f <$> x `ap'` y)+ assertIOwrong "wrongAp" $ test id (\f x y -> f <$> x `wrongAp` y)+ assertIO "!>>=" $ test (take 1) (\f mx my -> mx !>>= \x-> my !>>= \y-> pureLI (f x y))+ assertIOwrong "wrongBind" $ test (take 1) (\f mx my -> mx `wrongBind` \x-> my `wrongBind` \y-> pureLI (f x y))+ assertIO "wrongRun'/return'" $ testHarness wrongRun' (return' <$>)+ assertIOwrong "wrongRun'/return" $ testHarness wrongRun' (return <$>)+ assertIO "LI.append" $ test (take 1) (wrapAppend LI.append)+ assertIOwrong "veryWrongAppend" $ test (take 1) (wrapAppend veryWrongAppend)+ assertIOwrong "wrongAppend" $ test (take 1) (wrapAppend wrongAppend)+ assertIO "testAppend LI.append" $ testAppend LI.append+ assertIOwrong "testAppend wrongAppend" $ testAppend wrongAppend+ assertIOwrong "testAppend veryWrongAppend" $ testAppend veryWrongAppend+ testUnused "id" id+ testUnused "LI.append" $ (\i -> take 3 <$> (pureLI "123" `LI.append` i))+ where+ assertIOgen pass fail' name mb = do b <- mb `catch` (\e -> trace (show e) (return False))+ putStr (name ++ ": ")+ IO.hFlush IO.stdout+ putStrLn (if b then pass else fail')+ assertIO = assertIOgen (green "PASS") (red "FAIL")+ assertIOwrong = assertIOgen (red "PASS (not expected)") (green "FAIL (as expected)")+ green x = "\027[K\027[32m" ++ x ++ "\027[0m"+ red x = "\027[K\027[31m" ++ x ++ "\027[0m"+ wrapZipWith zipW f xs ys = uncurry f . head <$> zipW (,) ((:[]) <$> xs) ((:[]) <$> ys)+ wrapInterleave inte f xs ys = let g [a, b] = f a b in g <$> inte ((:[]) <$> xs) ((:[]) <$> ys)+ wrapAppend appe f xs ys = let g [a, b] = f [a] [b] in g <$> appe xs ys+ testEq ref comp = (==ref) <$> comp+ testHarness runner f = testEq [1::Int ..10] $ runner (f $ harness (pureLI [1..10]))+ testUnused name f =+ assertIOwrong ("testUnused " ++ name) $ LI.run (const True <$> f (LI.readFile "DOESNOTEXISTS"))+
+ System/IO/Unsafe/GetContents.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE MagicHash, UnboxedTuples #-}+-----------------------------------------------------------------------------+-- |+-- Module : System.IO.Unsafe.GetContents+-- Copyright : (c) The University of Glasgow, 1992-2001+-- License : see GHC sources in libraries/base/LICENSE+-- +-- Maintainer : Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability : internal+-- Portability : non-portable+--+-- This code is extracted from GHC sources and changed to no longer+-- discards I\/O errors.+-----------------------------------------------------------------------------++module System.IO.Unsafe.GetContents+ (unsafeHGetContents+ ,lazyRead)+where++import Prelude hiding (catch)+import Control.Exception.Extensible (catch)+import System.IO.Unsafe (unsafeInterleaveIO)+import Data.IORef+import GHC.Base+import GHC.Handle+import GHC.IOBase (Buffer(..), Handle__(..), Handle, RawBuffer, IO(IO), FD+ ,BufferMode(..), HandleType(..), IOException(..)+ ,IOErrorType(..), ioException, bufferEmpty)+++-- | 'unsafeHGetContents' is pretty much like 'hGetContents' but does not+-- discards I\/O errors get during the lazy reading.+--+-- This code was copy/pasted from the GHC version of hGetContents.+unsafeHGetContents :: Handle -> IO String+unsafeHGetContents handle = + withHandle "unsafeHGetContents" handle $ \handle_ ->+ case haType handle_ of + ClosedHandle -> ioe_closedHandle+ SemiClosedHandle -> ioe_closedHandle+ AppendHandle -> ioe_notReadable+ WriteHandle -> ioe_notReadable+ _ -> do xs <- lazyRead handle+ return (handle_{ haType=SemiClosedHandle}, xs )++-- Note that someone may close the semi-closed handle (or change its+-- buffering), so each time these lazy read functions are pulled on,+-- they have to check whether the handle has indeed been closed.++lazyRead :: Handle -> IO String+lazyRead handle = + unsafeInterleaveIO $+ withHandle "lazyRead" handle $ \ handle_ -> do+ case haType handle_ of+ -- here we do not silently returns an empty stream on a closed handle+ -- ClosedHandle -> return (handle_, "")+ SemiClosedHandle -> lazyRead' handle handle_+ _ -> ioException + (IOError (Just handle) IllegalOperation "lazyRead"+ "illegal handle type" Nothing) -- Nothing)++lazyRead' :: Handle -> Handle__ -> IO (Handle__, [Char])+lazyRead' h handle_ = do+ let ref = haBuffer handle_+ fd = haFD handle_++ -- even a NoBuffering handle can have a char in the buffer... + -- (see hLookAhead)+ buf <- readIORef ref+ if not (bufferEmpty buf)+ then lazyReadHaveBuffer h handle_ fd ref buf+ else do++ case haBufferMode handle_ of+ NoBuffering -> do+ -- make use of the minimal buffer we already have+ let raw = bufBuf buf+ r <- readRawBuffer "lazyRead" fd (haIsStream handle_) raw 0 1+ if r == 0+ then do (handle_', _) <- hClose_help handle_ + return (handle_', "")+ else do (c,_) <- readCharFromBuffer raw 0+ rest <- lazyRead h+ return (handle_, c : rest)++ LineBuffering -> lazyReadBuffered h handle_ fd ref buf+ BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf++-- we never want to block during the read, so we call fillReadBuffer with+-- is_line==True, which tells it to "just read what there is".+lazyReadBuffered :: Handle -> Handle__ -> FD -> IORef Buffer -> Buffer+ -> IO (Handle__, [Char])+lazyReadBuffered h handle_ fd ref buf = -- do+ catch + (do buf' <- fillReadBuffer fd True{-is_line-} (haIsStream handle_) buf+ lazyReadHaveBuffer h handle_ fd ref buf'+ )+ (\IOError{ioe_type=EOF} -> do (handle_', _) <- hClose_help handle_+ return (handle_', "")+ )+-- Here we do not discard I/O errors, only EOF is caught.+{-+ -- all I/O errors are discarded. Additionally, we close the handle.+ (\(_ :: SomeException) -> do (handle_', _) <- hClose_help handle_+ return (handle_', "")+ )+-}++lazyReadHaveBuffer :: Handle -> Handle__ -> FD -> IORef Buffer -> Buffer -> IO (Handle__, [Char])+lazyReadHaveBuffer h handle_ _ ref buf = do+ more <- lazyRead h+ writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }+ s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more+ return (handle_, s)+++unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]+unpackAcc _ _ 0 acc = return acc+unpackAcc buf (I# r) (I# len) acc0 = IO $ \s -> unpackRB acc0 (len -# 1#) s+ where+ unpackRB acc i s+ | i <# r = (# s, acc #)+ | otherwise = + case readCharArray# buf i s of+ (# s', ch #) -> unpackRB (C# ch : acc) (i -# 1#) s'
+ examples/cksum.hs view
@@ -0,0 +1,4 @@+import qualified System.IO.Lazy.Input as LI+import System.Environment (getArgs)+import Data.Char+main = print =<< LI.run . fmap (sum . map (toInteger . ord)) . LI.concat . map LI.readFile =<< getArgs
+ examples/count-words.hs view
@@ -0,0 +1,23 @@+import qualified System.IO.Lazy.Input as LI+import System.Environment (getArgs)++main = print =<< LI.run . fmap (length . words) . LI.concat . map LI.readFile =<< getArgs++-- some experimentations++-- main = print =<< fmap sum . mapM (fmap (length . words) . readFile) =<< getArgs+-- main = print =<< LI.run . fmap sum . mapM (fmap (length . words) . LI.readFile) =<< getArgs+-- main = print =<< LI.run . fmap (length . words) . concatLI . map LI.readFile =<< getArgs+-- main = print =<< LI.run . fmap sum . LI.sequence . map (fmap (length . words) . LI.readFile) =<< getArgs+-- main = print =<< LI.run . fmap (length . words . D.toList . runW) . concatLI . map (fmap (W . D.fromList)) . map LI.readFile =<< getArgs++{-+main =+ do args <- getArgs+ let onEachFile filePath = do contents <- LI.readFile filePath+ return $ length $ words contents+ i <- LI.run $ do+ counts <- mapM onEachFile args+ return $ sum counts+ print i+-}
+ examples/std-lazy-io/count-lines-better.hs view
@@ -0,0 +1,2 @@+import System.Environment+main = print . sum =<< mapM (fmap (length . lines) . readFile) =<< getArgs
+ examples/std-lazy-io/count-lines-good.hs view
@@ -0,0 +1,3 @@+import System.Environment+main = print . sum =<< mapM ((return' . length . lines =<<) . readFile) =<< getArgs+ where return' x = x `seq` return x
+ examples/swap-case.hs view
@@ -0,0 +1,7 @@+import System.Environment (getArgs)+import qualified System.IO.Lazy.Input as LI+import qualified System.IO.Strict as SIO+import Data.Char+main = LI.run' . (fmap (SIO.putStr . fmap swapCase) . LI.concat . map LI.readFile) =<< getArgs+ where swapCase c | isUpper c = toLower c+ | otherwise = toUpper c
+ examples/testhgetcontents.hs view
@@ -0,0 +1,41 @@+import Prelude hiding (catch)+import System.IO+import System.IO.Unsafe.GetContents+import GHC.Handle+import Control.Exception++test name k = do+ putStrLn $ " " ++ name+ putStrLn . (replicate 4 ' '++) =<<+ (fmap show (evaluate =<< k)+ `catch` (\e -> return $ "error: " ++ show (e :: SomeException)))++tests hGetC = do+ test "Length OK" $ do+ h <- openFile "testhgetcontents.hs" ReadMode+ xs <- hGetC h+ return $ length xs+ test "Length but closed" $ do+ h <- openFile "testhgetcontents.hs" ReadMode+ xs <- hGetC h+ hClose h+ return $ length xs+ test "Lengths on Double get" $ do+ h <- openFile "testhgetcontents.hs" ReadMode+ xs <- hGetC h+ ys <- hGetC h+ let l1 = length xs+ l1 `seq` return (l1, length ys)+ test "Lengths on dupped get" $ do+ h <- openFile "testhgetcontents.hs" ReadMode+ duph <- hDuplicate h+ xs <- hGetC h+ ys <- hGetC duph+ let l1 = length xs+ l1 `seq` return (l1, length ys)++main = do+ putStrLn "using hGetContents"+ tests hGetContents+ putStrLn "using unsafeHGetContents"+ tests unsafeHGetContents
+ safe-lazy-io.cabal view
@@ -0,0 +1,43 @@+name: safe-lazy-io+cabal-Version: >=1.6+version: 0.1+license: BSD3+license-File: LICENSE+copyright: (c) Nicolas Pouillard+author: Nicolas Pouillard+maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+category: System+synopsis: A library providing safe lazy IO features.+description: Provides a safer API for incremental IO processing in a way very+ close to standard lazy IO.+stability: Provisional+build-type: Simple++extra-source-files:+ README+ System/IO/Lazy/Input/Tests.hs+ examples/count-words.hs+ examples/testhgetcontents.hs+ examples/cksum.hs+ examples/std-lazy-io/count-lines-good.hs+ examples/std-lazy-io/count-lines-better.hs+ examples/swap-case.hs+++library+ build-depends: base>=3.0, parallel, strict-io>=0.1, extensible-exceptions+ exposed-modules: System.IO.Lazy.Input+ System.IO.Lazy.Input.Internals+ System.IO.Lazy.Input.Extra+ System.IO.Unsafe.GetContents+ ghc-options: -Wall -O2++-- source-repository head+-- type: darcs+-- location: http://patch-tag.com/publicrepos/safe-lazy-io++-- source-repository this+-- type: darcs+-- location: http://patch-tag.com/publicrepos/safe-lazy-io+-- tag: 0.1+