import System.IO import GHC.IO.Handle import Control.Monad import Data.List (intercalate) newlines = ["\n","\r","\r\n","\n\r","\n\n","\r\r"] -- make sure the file ends in '\r': that's a tricky case for CRLF -- conversion, because the IO library has to check whether there's a -- following \n before returning the \r. content = concat [ show i ++ t | (i,t) <- zip [1..100] (cycle newlines) ] filename = "newline001.out" fromCRLF [] = [] fromCRLF ('\r':'\n':cs) = '\n' : fromCRLF cs fromCRLF (c:cs) = c : fromCRLF cs toCRLF [] = [] toCRLF ('\n':cs) = '\r':'\n': toCRLF cs toCRLF (c:cs) = c : toCRLF cs main = do h <- openBinaryFile filename WriteMode hPutStr h content hClose h testinput NoBuffering testinput LineBuffering testinput (BlockBuffering Nothing) testinput (BlockBuffering (Just 3)) testinput (BlockBuffering (Just 7)) testinput (BlockBuffering (Just 16)) testoutput NoBuffering testoutput LineBuffering testoutput (BlockBuffering Nothing) testoutput (BlockBuffering (Just 3)) testoutput (BlockBuffering (Just 7)) testoutput (BlockBuffering (Just 16)) testinput b = do h <- openFile filename ReadMode hSetBuffering h b hSetNewlineMode h noNewlineTranslation str <- hGetContents h check "in1" b str content hClose h h <- openFile filename ReadMode hSetBuffering h b hSetNewlineMode h noNewlineTranslation str <- read_chars h check "in2" b str content hClose h h <- openFile filename ReadMode hSetBuffering h b hSetNewlineMode h noNewlineTranslation str <- read_lines h check "in3" b str content hClose h h <- openFile filename ReadMode hSetBuffering h b hSetNewlineMode h NewlineMode{ inputNL=CRLF, outputNL=LF } str <- hGetContents h check "in4" b str (fromCRLF content) hClose h h <- openFile filename ReadMode hSetBuffering h b hSetNewlineMode h NewlineMode{ inputNL=CRLF, outputNL=LF } str <- read_chars h check "in5" b str (fromCRLF content) hClose h h <- openFile filename ReadMode hSetBuffering h b hSetNewlineMode h NewlineMode{ inputNL=CRLF, outputNL=LF } str <- read_lines h check "in6" b str (fromCRLF content) hClose h testoutput b = do h <- openFile filename WriteMode hSetBuffering h b hSetNewlineMode h NewlineMode{ inputNL=LF, outputNL=CRLF } hPutStr h content hClose h h <- openBinaryFile filename ReadMode str <- hGetContents h check "out1" b (toCRLF content) str hClose h h <- openFile filename WriteMode hSetBuffering h b hSetNewlineMode h NewlineMode{ inputNL=LF, outputNL=CRLF } mapM_ (hPutChar h) content hClose h h <- openBinaryFile filename ReadMode str <- hGetContents h check "out2" b (toCRLF content) str hClose h check s b str1 str2 = when (str1 /= str2) $ error ("failed: " ++ s ++ ", " ++ show b ++ '\n':show str1 ++ '\n':show str2) read_chars :: Handle -> IO String read_chars h = loop h "" where loop h acc = do b <- hIsEOF h if b then return (reverse acc) else do c <- hGetChar h loop h (c:acc) read_lines :: Handle -> IO String read_lines h = loop h [] where loop h acc = do b <- hIsEOF h if b then return (intercalate "\n" (reverse acc)) else do l <- hGetLine h loop h (l : acc)