ghc/tests/lib/should_run/io001.hs

   1 -- !!! Testing hGetPosn and hSetPosn
   2 module Main(main) where
   3
   4 import IO
   5 import IOExts
   6
   7 getPos :: HandlePosn -> HandlePosition
   8 getPos (HandlePosn _ x) = x
   9
  10 getPosnAndPrint h = do
  11   x <- hGetPosn h
  12   v <- hGetChar h
  13   putStrLn ("At position: " ++ show (getPos x) ++ ", found: " ++ show v)
  14   return x
  15
  16 recordDoAndRepos h a = do
  17   x <- getPosnAndPrint h
  18   a
  19   hSetPosn x
  20   getPosnAndPrint h
  21   return ()
  22
  23 recordDoAndRepos2 h a = do
  24   x <- getPosnAndPrint h
  25   a
  26   hSeek h AbsoluteSeek (getPos x)
  27   getPosnAndPrint h
  28   return ()
  29
  30 recordDoAndRepos3 h a = do
  31   x <- getPosnAndPrint h
  32   a
  33   hSeek h SeekFromEnd (negate (getPos x + 1))
  34   getPosnAndPrint h
  35   return ()
  36
  37 main :: IO ()
  38 main = do
  39   h  <- openFile "io001.hs" ReadMode
  40   recordDoAndRepos h $
  41    recordDoAndRepos h $
  42     recordDoAndRepos h $
  43      recordDoAndRepos h $
  44       recordDoAndRepos h $
  45        putStrLn ""
  46   hClose h
  47   putStrLn ""
  48   h  <- openFileEx "io001.hs" (BinaryMode ReadMode)
  49   recordDoAndRepos h $
  50    recordDoAndRepos h $
  51     recordDoAndRepos h $
  52      recordDoAndRepos h $
  53       recordDoAndRepos h $
  54        putStrLn ""
  55   hClose h
  56   putStrLn "\nUsing hSeek/AbsoluteSeek: "
  57   h  <- openFile "io001.hs" ReadMode
  58   recordDoAndRepos2 h $
  59    recordDoAndRepos2 h $
  60     recordDoAndRepos2 h $
  61      recordDoAndRepos2 h $
  62       recordDoAndRepos2 h $
  63        putStrLn ""
  64
  65   hClose h
  66   putStrLn "\nUsing hSeek/SeekFromEnd: "
  67   putStrLn "(Don't worry if you're seeing differing numbers here, it might be down to '\\n' vs '\\r\\n')"
  68   h  <- openFile "io001.hs" ReadMode
  69   recordDoAndRepos3 h $
  70    recordDoAndRepos3 h $
  71     recordDoAndRepos3 h $
  72      recordDoAndRepos3 h $
  73       recordDoAndRepos3 h $
  74        putStrLn ""