summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/lib/IO/hGetPosn001.hs
blob: 5a0d7d482727fe7618977c0c7155c176aba40f36 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
-- !!! Test file positioning

module Main(main) where

import Control.Monad
import System.Directory (removeFile, doesFileExist)
import System.IO
import System.IO.Error

main = do
  hIn <- openFile "hGetPosn001.in" ReadMode
  f <- doesFileExist "hGetPosn001.out"
  when f (removeFile "hGetPosn001.out")
  hOut <- openFile "hGetPosn001.out" ReadWriteMode
  bof <- hGetPosn hIn
  putStrLn (show bof)  -- you can show HandlePosns
  copy hIn hOut
  hSetPosn bof
  copy hIn hOut
  hSeek hOut AbsoluteSeek 0
  stuff <- hGetContents hOut
  putStr stuff

copy :: Handle -> Handle -> IO ()
copy hIn hOut =
    try (hGetChar hIn) >>=
    either (\ err -> if isEOFError err then return () else error "copy")
	   ( \ x -> hPutChar hOut x >> copy hIn hOut)