diff --git a/lazyio.cabal b/lazyio.cabal --- a/lazyio.cabal +++ b/lazyio.cabal @@ -1,5 +1,5 @@ Name: lazyio -Version: 0.0.1 +Version: 0.0.2 License: BSD3 License-File: LICENSE Author: Henning Thielemann @@ -23,13 +23,17 @@ Source-Repository this type: darcs location: http://code.haskell.org/~thielema/lazyio/ - tag: 0.0.1 + tag: 0.0.2 Flag splitBase description: Choose the new smaller, split-up base package. +Flag buildTests + description: Build test executables + default: False + Library - Build-Depends: mtl >=1.1 && <1.2 + Build-Depends: transformers >=0.0 && <0.2 If flag(splitBase) Build-Depends: base >= 2 Else @@ -42,3 +46,12 @@ Other-Modules: Data.ApplicativeChain System.IO.Lazy.Applicative + + +Executable test + If !flag(buildTests) + Buildable: False + + GHC-Options: -Wall + Hs-source-dirs: src + Main-Is: Test/Main.hs diff --git a/src/System/IO/Lazy.hs b/src/System/IO/Lazy.hs --- a/src/System/IO/Lazy.hs +++ b/src/System/IO/Lazy.hs @@ -34,6 +34,8 @@ Because only the first line is needed, only the first prompt and the first 'getLine' is executed. +We advise to lift strict IO functions into the lazy IO monad. +Lifting a function like @readFile@ may lead to unintended interleaving. -} module System.IO.Lazy ( T, @@ -41,7 +43,7 @@ ) where import Control.Monad.Trans (MonadIO(liftIO), ) -import Control.Monad.State (StateT(StateT), mapStateT, evalStateT, {- runStateT, -} ) +import Control.Monad.Trans.State (StateT(StateT), mapStateT, evalStateT, {- runStateT, -} ) import Control.Monad (ap, {- liftM2, -} ) import Control.Applicative (Applicative(pure, (<*>)), ) import System.IO.Unsafe (unsafeInterleaveIO, ) diff --git a/src/Test/Main.hs b/src/Test/Main.hs new file mode 100644 --- /dev/null +++ b/src/Test/Main.hs @@ -0,0 +1,168 @@ +module Main where + +import qualified System.IO.Lazy as LazyIO +import qualified System.IO as IO +import Control.Monad.Trans (MonadIO(liftIO), ) +import Control.Monad.Trans.Reader (ReaderT, runReaderT, asks, ) + +import Control.Monad (liftM2, ) +import System.Exit (exitFailure, ) + +import Prelude hiding (getLine, ) + + +inputName, outputName :: FilePath +inputName = "input" +outputName = "output" + +assert :: Bool -> IO () +assert b = + if b + then putStrLn "test ok" + else putStrLn "failure" >> exitFailure + + +class HasReadHandle h where + getReadHandle :: h -> IO.Handle + +class HasWriteHandle h where + getWriteHandle :: h -> IO.Handle + + +newtype ReadHandle = ReadHandle IO.Handle + +instance HasReadHandle ReadHandle where + getReadHandle (ReadHandle h) = h + + +data ReadWriteHandle = ReadWriteHandle IO.Handle IO.Handle + +instance HasReadHandle ReadWriteHandle where + getReadHandle (ReadWriteHandle h _) = h + +instance HasWriteHandle ReadWriteHandle where + getWriteHandle (ReadWriteHandle _ h) = h + + + +getLine :: HasReadHandle h => ReaderT h LazyIO.T String +getLine = + asks getReadHandle >>= \h -> liftIO $ IO.hGetLine h + +getLinePair :: HasReadHandle h => ReaderT h LazyIO.T (String, String) +getLinePair = + do x <- getLine + y <- getLine + return (x,y) + +getLinePairOfPairs :: HasReadHandle h => + ReaderT h LazyIO.T ((String, String), (String, String)) +getLinePairOfPairs = + do x <- getLinePair + y <- getLinePair + return (x,y) + +forever :: (Monad m) => m a -> m [a] +forever x = liftM2 (:) x (forever x) + +runReadTest :: + String -> ReaderT ReadHandle LazyIO.T a -> (a -> IO ()) -> IO () +runReadTest content action check = + do writeFile inputName content + IO.withFile inputName IO.ReadMode $ \h -> + do check =<< LazyIO.run (runReaderT action (ReadHandle h)) + IO.hIsEOF h >>= assert + + +putLine :: HasWriteHandle h => String -> ReaderT h LazyIO.T () +putLine str = + asks getWriteHandle >>= \h -> liftIO $ IO.hPutStrLn h str + +runReadWriteTest :: + String -> String -> ReaderT ReadWriteHandle LazyIO.T a -> (a -> IO ()) -> IO () +runReadWriteTest inputContent outputContent action check = + do writeFile inputName inputContent + IO.withFile inputName IO.ReadMode $ \hr -> + IO.withFile outputName IO.WriteMode $ \hw -> + do check =<< LazyIO.run (runReaderT action (ReadWriteHandle hr hw)) + IO.hIsEOF hr >>= assert + assert . (outputContent ==) =<< readFile outputName + + +{- | +This test works by observing things that should not be observable. +(Yes, in the IO monad it would also be possible to observe memory consumption +and thus whether laziness works or not.) +Be warned again, that you should not use LazyIO in that way, +but restrict its use to a set of IO actions, +that is safe when run lazily. +-} +main :: IO () +main = + do runReadTest "bla\n" + (do a <- getLinePair + return (fst a)) + (\str -> assert (str == "bla")) + + runReadTest "bla\nblub\n" + (do a <- getLinePair + return (snd a)) + (\str -> assert (str == "blub")) + + runReadTest "1\n" + (do a <- getLinePairOfPairs + return (fst $ fst a)) + (\str -> assert (str == "1")) + + runReadTest "1\n2\n" + (do a <- getLinePairOfPairs + return (snd $ fst a)) + (\str -> assert (str == "2")) + + runReadTest "1\n2\n3\n" + (do a <- getLinePairOfPairs + return (fst $ snd a)) + (\str -> assert (str == "3")) + + runReadTest "1\n2\n3\n4\n" + (do a <- getLinePairOfPairs + return (snd $ snd a)) + (\str -> assert (str == "4")) + + runReadTest "1\n2\n3\n4\n" + getLinePairOfPairs + (\r -> assert (snd (snd r) == "4" && fst (fst r) == "1")) + + runReadTest "1\n2\n3\n4\n" + getLinePairOfPairs + (\r -> + do assert (snd (snd r) == "4") + assert (snd (fst r) == "2") + assert (fst (fst r) == "1") + assert (fst (snd r) == "3")) + + runReadTest "0\n1\n2\n3\n" + (forever getLine) + (\r -> + do assert (r!!2 == "2") + assert (r!!1 == "1") + assert (r!!3 == "3") + assert (r!!0 == "0")) + + + runReadWriteTest "0\n1\n2\n3\n" + (concat $ replicate 4 "bla\n") + (forever (putLine "bla" >> getLine)) + (\r -> + do assert (r!!3 == "3")) + + runReadWriteTest "0\n1\n2\n3\n" + "a\nb\nc\nd\n" + (mapM (\c -> putLine [c] >> getLine) ['a'..]) + (\r -> + do assert (r!!3 == "3")) + + runReadWriteTest "end\n" + "A\nB\nC\nD\n" + (mapM (\c -> putLine [c]) ['A'..'D'] >> getLine) + (\str -> assert (str == "end"))