ghc/tests/lib/IO/hSetBuffering003.hs

   1 -- !!! Reconfiguring the buffering of a handle
   2 module Main(main) where
   3
   4 import IO
   5
   6 queryBuffering :: String -> Handle -> IO ()
   7 queryBuffering handle_nm handle = do
   8   bufm  <- hGetBuffering handle
   9   putStrLn ("Buffering for " ++ handle_nm ++ " is: " ++ show bufm)
  10
  11 main = do
  12   queryBuffering "stdin" stdin
  13   queryBuffering "stdout" stdout
  14   queryBuffering "stderr" stderr
  15
  16    -- twiddling the setting for stdin.
  17   hSetBuffering stdin NoBuffering
  18   queryBuffering "stdin" stdin
  19   hSetBuffering stdin LineBuffering
  20   queryBuffering "stdin" stdin
  21   hSetBuffering stdin (BlockBuffering (Just 2))
  22   queryBuffering "stdin" stdin
  23   hSetBuffering stdin (BlockBuffering Nothing)
  24   queryBuffering "stdin" stdin
  25   let bmo = BlockBuffering (Just (-3))
  26   hSetBuffering stdin bmo `catch` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stdin " ++ showParen True (showsPrec 9 bmo) [])
  27
  28   putChar '\n'
  29
  30    -- twiddling the buffering for stdout
  31   hPutStr stdout "Hello stdout 1"
  32   hSetBuffering stdout NoBuffering
  33   queryBuffering "stdout" stdout
  34   hPutStr stdout "Hello stdout 2"
  35   hSetBuffering stdout LineBuffering
  36   queryBuffering "stdout" stdout
  37   hPutStr stdout "Hello stdout 3"
  38   hSetBuffering stdout (BlockBuffering (Just 2))
  39   queryBuffering "stdout" stdout
  40   hPutStr stdout "Hello stdout 4"
  41   hSetBuffering stdout (BlockBuffering Nothing)
  42   queryBuffering "stdout" stdout
  43   hPutStr stdout "Hello stdout 5"
  44   let bmo = BlockBuffering (Just (-3))
  45   hSetBuffering stdout bmo `catch` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stdout " ++ showParen True (showsPrec 9 bmo) [])
  46
  47   putChar '\n'
  48
  49    -- twiddling the buffering for stderr
  50   hPutStr stderr "Hello stderr 1"
  51   hSetBuffering stderr NoBuffering
  52   queryBuffering "stderr" stderr
  53   hPutStr stderr "Hello stderr 2"
  54   hSetBuffering stderr LineBuffering
  55   queryBuffering "stderr" stderr
  56   hPutStr stderr "Hello stderr 3"
  57   hSetBuffering stderr (BlockBuffering (Just 2))
  58   queryBuffering "stderr" stderr
  59   hPutStr stderr "Hello stderr 4"
  60   hSetBuffering stderr (BlockBuffering Nothing)
  61   queryBuffering "stderr" stderr
  62   hPutStr stderr "Hello stderr 5"
  63   let bmo = BlockBuffering (Just (-3))
  64   hSetBuffering stderr bmo `catch` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stderr " ++ showParen True (showsPrec 9 bmo) [])
  65
  66   ls  <- hGetContents stdin
  67   ls' <- putLine ls
  68   hSetBuffering stdin NoBuffering
  69   putLine ls'
  70   return ()
  71
  72 putLine :: String -> IO String
  73 putLine [] = return []
  74 putLine (x:xs) = do
  75    putChar x
  76    case x of
  77      '\n' -> return xs
  78      _    -> putLine xs
  79