ghc/tests/lib/IO/hSeek003.hs

   1 -- !!! file positions (hGetPosn and hSetPosn)
   2 module Main(main) where
   3
   4 import IO
   5 import Monad ( sequence )
   6 #if defined(__MINGW32__)
   7 import PrelHandle(hSetBinaryMode)
   8 #endif
   9
  10 testPosns :: Handle -> BufferMode -> IO ()
  11 testPosns hdl bmo = do
  12    hSetBuffering hdl bmo
  13    putStrLn ("Testing positioning with buffer mode set to: " ++ show bmo)
  14    testPositioning hdl
  15
  16 bmo_ls = [NoBuffering, LineBuffering, BlockBuffering Nothing,
  17           BlockBuffering (Just 511),BlockBuffering (Just 3), BlockBuffering (Just 11)]
  18
  19 main = do
  20   hdl  <- openFile "hSeek003.hs" ReadMode
  21 # if defined(__MINGW32__)
  22   hSetBinaryMode hdl True
  23 # endif
  24   sequence (zipWith testPosns (repeat hdl) bmo_ls)
  25   hClose hdl
  26
  27 testPositioning hdl = do
  28   hSeek hdl AbsoluteSeek 0  -- go to the beginning of the file again.
  29   ps   <- getFilePosns 10 hdl
  30   hSeek hdl AbsoluteSeek 0
  31   putStr "First ten chars: "
  32   ls   <- hGetChars 10 hdl
  33   putStrLn ls
  34     -- go to the end
  35   hSeek hdl SeekFromEnd 0
  36   ls   <- sequence (map (\ p -> hSetPosn p >> hGetChar hdl) ps)
  37   putStr "First ten chars: "
  38   putStrLn ls
  39
  40     -- position ourselves in the middle.
  41   sz <- hFileSize hdl
  42   hSeek hdl AbsoluteSeek (sz `div` 2)
  43   ls   <- sequence (map (\ p -> hSetPosn p >> hGetChar hdl) ps)
  44   putStr "First ten chars: "
  45   putStrLn ls
  46
  47 hGetChars :: Int -> Handle -> IO String
  48 hGetChars n h = sequence (replicate n (hGetChar h))
  49
  50 getFilePosns :: Int -> Handle -> IO [HandlePosn]
  51 getFilePosns 0 h = return []
  52 getFilePosns x h = do
  53    p <- hGetPosn h
  54    hGetChar h
  55    ps <- getFilePosns (x-1) h
  56    return (p:ps)