ghc/tests/lib/IO/hGetPosn001.hs

   1 -- !!! Test file positioning
   2
   3 module Main(main) where
   4
   5 import IO
   6 import Monad
   7 import Directory (removeFile, doesFileExist)
   8 #if defined(__MINGW32__)
   9 import PrelHandle(hSetBinaryMode)
  10 #endif
  11
  12 main = do
  13   hIn <- openFile "hGetPosn001.in" ReadMode
  14 # if defined(__MINGW32__)
  15   hSetBinaryMode hIn True
  16 # endif
  17   f <- doesFileExist "hGetPosn001.out"
  18   when f (removeFile "hGetPosn001.out")
  19   hOut <- openFile "hGetPosn001.out" ReadWriteMode
  20 # if defined(__MINGW32__)
  21   hSetBinaryMode hOut True
  22 # endif
  23   bof <- hGetPosn hIn
  24   copy hIn hOut
  25   hSetPosn bof
  26   copy hIn hOut
  27   hSeek hOut AbsoluteSeek 0
  28   stuff <- hGetContents hOut
  29   putStr stuff
  30
  31 copy :: Handle -> Handle -> IO ()
  32 copy hIn hOut =
  33     try (hGetChar hIn) >>=
  34     either (\ err -> if isEOFError err then return () else error "copy")
  35            ( \ x -> hPutChar hOut x >> copy hIn hOut)