PrelIO.hsc 19.4 KB
Newer Older
1
2
3
4
5
{-# OPTIONS -fno-implicit-prelude #-}

#undef DEBUG_DUMP

-- -----------------------------------------------------------------------------
6
-- $Id: PrelIO.hsc,v 1.13 2001/09/17 14:58:09 simonmar Exp $
7
8
9
10
11
12
13
14
15
16
--
-- (c) The University of Glasgow, 1992-2001
--
-- Module PrelIO

-- This module defines all basic IO operations.
-- These are needed for the IO operations exported by Prelude,
-- but as it happens they also do everything required by library
-- module IO.

17
18
19
20
21
22
module PrelIO ( 
   putChar, putStr, putStrLn, print, getChar, getLine, getContents,
   interact, readFile, writeFile, appendFile, readLn, readIO, hReady,
   hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
   hPutStrLn, hPrint
 ) where
23

rrt's avatar
rrt committed
24
#include "HsStd.h"
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
#include "PrelHandle_hsc.h"

import PrelBase

import PrelPosix
import PrelMarshalUtils
import PrelStorable
import PrelCError
import PrelCString
import PrelCTypes
import PrelCTypesISO

import PrelIOBase
import PrelHandle	-- much of the real stuff is in here

import PrelMaybe
import PrelReal
import PrelNum
43
import PrelRead
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
import PrelShow
import PrelMaybe	( Maybe(..) )
import PrelPtr
import PrelList
import PrelException    ( ioError, catch, throw )
import PrelConc

-- -----------------------------------------------------------------------------
-- Standard IO

putChar         :: Char -> IO ()
putChar c       =  hPutChar stdout c

putStr          :: String -> IO ()
putStr s        =  hPutStr stdout s

putStrLn        :: String -> IO ()
putStrLn s      =  do putStr s
                      putChar '\n'

print           :: Show a => a -> IO ()
print x         =  putStrLn (show x)

getChar         :: IO Char
getChar         =  hGetChar stdin

getLine         :: IO String
getLine         =  hGetLine stdin

getContents     :: IO String
getContents     =  hGetContents stdin

interact        ::  (String -> String) -> IO ()
interact f      =   do s <- getContents
                       putStr (f s)

readFile        :: FilePath -> IO String
readFile name	=  openFile name ReadMode >>= hGetContents

writeFile       :: FilePath -> String -> IO ()
writeFile name str = do
    hdl <- openFile name WriteMode
    hPutStr hdl str
    hClose hdl

appendFile      :: FilePath -> String -> IO ()
appendFile name str = do
    hdl <- openFile name AppendMode
    hPutStr hdl str
    hClose hdl

readLn          :: Read a => IO a
readLn          =  do l <- getLine
                      r <- readIO l
                      return r

100
101
102
103
104
105
106
107
108
109
110
111
112
113
  -- raises an exception instead of an error
readIO          :: Read a => String -> IO a
readIO s        =  case (do { (x,t) <- reads s ;
			      ("","") <- lex t ;
                              return x }) of
#ifndef NEW_READS_REP
			[x]    -> return x
			[]     -> ioError (userError "Prelude.readIO: no parse")
			_      -> ioError (userError "Prelude.readIO: ambiguous parse")
#else
                        Just x -> return x
                        Nothing  -> ioError (userError "Prelude.readIO: no parse")
#endif

114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
-- ---------------------------------------------------------------------------
-- Simple input operations

-- Computation "hReady hdl" indicates whether at least
-- one item is available for input from handle "hdl".

-- If hWaitForInput finds anything in the Handle's buffer, it
-- immediately returns.  If not, it tries to read from the underlying
-- OS handle. Notice that for buffered Handles connected to terminals
-- this means waiting until a complete line is available.

hReady :: Handle -> IO Bool
hReady h = hWaitForInput h 0

hWaitForInput :: Handle -> Int -> IO Bool
hWaitForInput h msecs = do
  wantReadableHandle "hReady" h $ \ handle_ -> do
  let ref = haBuffer handle_
  buf <- readIORef ref

  if not (bufferEmpty buf)
	then return True
	else do

  r <- throwErrnoIfMinus1Retry "hReady"
	  (inputReady (fromIntegral (haFD handle_)) (fromIntegral msecs))
  return (r /= 0)

foreign import "inputReady" 
  inputReady :: CInt -> CInt -> IO CInt

-- ---------------------------------------------------------------------------
-- hGetChar

-- hGetChar reads the next character from a handle,
-- blocking until a character is available.

hGetChar :: Handle -> IO Char
hGetChar handle =
  wantReadableHandle "hGetChar" handle $ \handle_ -> do

  let fd = haFD handle_
      ref = haBuffer handle_

  buf <- readIORef ref
  if not (bufferEmpty buf)
	then hGetcBuffered fd ref buf
	else do

  -- buffer is empty.
  case haBufferMode handle_ of
    LineBuffering    -> do
	new_buf <- fillReadBuffer fd True buf
	hGetcBuffered fd ref new_buf
    BlockBuffering _ -> do
	new_buf <- fillReadBuffer fd False buf
	hGetcBuffered fd ref new_buf
    NoBuffering -> do
	-- make use of the minimal buffer we already have
	let raw = bufBuf buf
	r <- throwErrnoIfMinus1RetryMayBlock "hGetChar"
	        (read_off (fromIntegral fd) raw 0 1)
	        (threadWaitRead fd)
	if r == 0
	   then ioe_EOF
	   else do (c,_) <- readCharFromBuffer raw 0
		   return c

hGetcBuffered fd ref buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w }
 = do (c,r) <- readCharFromBuffer b r
      let new_buf | r == w    = buf{ bufRPtr=0, bufWPtr=0 }
	          | otherwise = buf{ bufRPtr=r }
      writeIORef ref new_buf
      return c

-- ---------------------------------------------------------------------------
-- hGetLine

-- If EOF is reached before EOL is encountered, ignore the EOF and
-- return the partial line. Next attempt at calling hGetLine on the
-- handle will yield an EOF IO exception though.

-- ToDo: the unbuffered case is wrong: it doesn't lock the handle for
-- the duration.
hGetLine :: Handle -> IO String
hGetLine h = do
  m <- wantReadableHandle "hGetLine" h $ \ handle_ -> do
    	case haBufferMode handle_ of
    	   NoBuffering      -> return Nothing
    	   LineBuffering    -> do
    	      l <- hGetLineBuffered handle_
    	      return (Just l)
    	   BlockBuffering _ -> do 
    	      l <- hGetLineBuffered handle_
    	      return (Just l)
  case m of
	Nothing -> hGetLineUnBuffered h
	Just l  -> return l


hGetLineBuffered handle_ = do
  let ref = haBuffer handle_
  buf <- readIORef ref
  hGetLineBufferedLoop handle_ ref buf []


hGetLineBufferedLoop handle_ ref 
	buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } xss =
  let 
	-- find the end-of-line character, if there is one
	loop raw r
	   | r == w = return (False, w)
	   | otherwise =  do
		(c,r') <- readCharFromBuffer raw r
		if c == '\n' 
		   then return (True, r) -- NB. not r': don't include the '\n'
		   else loop raw r'
  in do
  (eol, off) <- loop raw r

#ifdef DEBUG_DUMP
  puts ("hGetLineBufferedLoop: r=" ++ show r ++ ", w=" ++ show w ++ ", off=" ++ show off ++ "\n")
#endif

  xs <- unpack raw r off
  if eol
	then do if w == off + 1
		   then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
		   else writeIORef ref buf{ bufRPtr = off + 1 }
	        return (concat (reverse (xs:xss)))
	else do
	     maybe_buf <- maybeFillReadBuffer (haFD handle_) True 
				buf{ bufWPtr=0, bufRPtr=0 }
	     case maybe_buf of
		-- Nothing indicates we caught an EOF, and we may have a
		-- partial line to return.
		Nothing -> let str = concat (reverse (xs:xss)) in
		     	   if not (null str)
			      then return str
			      else ioe_EOF
		Just new_buf -> 
		     hGetLineBufferedLoop handle_ ref new_buf (xs:xss)


258
259
260
261
262
263
264
265
266
267
maybeFillReadBuffer fd is_line buf
  = catch 
     (do buf <- fillReadBuffer fd is_line buf
	 return (Just buf)
     )
     (\e -> do if isEOFError e 
		  then return Nothing 
		  else throw e)


268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
unpack :: RawBuffer -> Int -> Int -> IO [Char]
unpack buf r 0   = return ""
unpack buf (I## r) (I## len) = IO $ \s -> unpack [] (len -## 1##) s
   where
    unpack acc i s
     | i <## r  = (## s, acc ##)
     | otherwise = 
          case readCharArray## buf i s of
	    (## s, ch ##) -> unpack (C## ch : acc) (i -## 1##) s


hGetLineUnBuffered :: Handle -> IO String
hGetLineUnBuffered h = do
  c <- hGetChar h
  if c == '\n' then
     return ""
   else do
    l <- getRest
    return (c:l)
 where
  getRest = do
    c <- 
      catch 
        (hGetChar h)
        (\ err -> do
          if isEOFError err then
	     return '\n'
	   else
	     ioError err)
    if c == '\n' then
       return ""
     else do
       s <- getRest
       return (c:s)

-- -----------------------------------------------------------------------------
-- hGetContents

-- hGetContents returns the list of characters corresponding to the
-- unread portion of the channel or file managed by the handle, which
-- is made semi-closed.

310
311
312
-- hGetContents on a DuplexHandle only affects the read side: you can
-- carry on writing to it afterwards.

313
hGetContents :: Handle -> IO String
314
315
hGetContents handle = 
    withHandle "hGetContents" handle $ \handle_ ->
316
317
318
    case haType handle_ of 
      ClosedHandle 	   -> ioe_closedHandle
      SemiClosedHandle 	   -> ioe_closedHandle
319
320
      AppendHandle 	   -> ioe_notReadable
      WriteHandle 	   -> ioe_notReadable
321
322
323
324
      _ -> do xs <- lazyRead handle
	      return (handle_{ haType=SemiClosedHandle}, xs )

-- Note that someone may close the semi-closed handle (or change its
325
326
-- buffering), so each time these lazy read functions are pulled on,
-- they have to check whether the handle has indeed been closed.
327
328
329
330

lazyRead :: Handle -> IO String
lazyRead handle = 
   unsafeInterleaveIO $
331
	withHandle "lazyRead" handle $ \ handle_ -> do
332
	case haType handle_ of
333
	  ClosedHandle     -> return (handle_, "")
334
335
336
337
338
339
340
341
342
343
344
345
346
	  SemiClosedHandle -> lazyRead' handle handle_
	  _ -> ioException 
	 	  (IOError (Just handle) IllegalOperation "lazyRead"
			"illegal handle type" Nothing)

lazyRead' h handle_ = do
  let ref = haBuffer handle_
      fd  = haFD handle_

  -- even a NoBuffering handle can have a char in the buffer... 
  -- (see hLookAhead)
  buf <- readIORef ref
  if not (bufferEmpty buf)
347
	then lazyReadHaveBuffer h handle_ fd ref buf
348
349
350
351
352
353
354
	else do

  case haBufferMode handle_ of
     NoBuffering      -> do
	-- make use of the minimal buffer we already have
	let raw = bufBuf buf
	    fd  = haFD handle_
355
	r <- throwErrnoIfMinus1RetryMayBlock "lazyRead"
356
357
358
	        (read_off (fromIntegral fd) raw 0 1)
	        (threadWaitRead fd)
	if r == 0
359
360
	   then do handle_ <- hClose_help handle_ 
		   return (handle_, "")
361
362
	   else do (c,_) <- readCharFromBuffer raw 0
		   rest <- lazyRead h
363
		   return (handle_, c : rest)
364

365
366
     LineBuffering    -> lazyReadBuffered h handle_ fd ref buf
     BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf
367
368
369

-- we never want to block during the read, so we call fillReadBuffer with
-- is_line==True, which tells it to "just read what there is".
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
lazyReadBuffered h handle_ fd ref buf = do
   catch 
   	(do buf <- fillReadBuffer fd True{-is_line-} buf
	    lazyReadHaveBuffer h handle_ fd ref buf
     	)
	-- all I/O errors are discarded.  Additionally, we close the handle.
     	(\e -> do handle_ <- hClose_help handle_
		  return (handle_, "")
	)

lazyReadHaveBuffer h handle_ fd ref buf = do
   more <- lazyRead h
   writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
   s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
   return (handle_, s)
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473


unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]
unpackAcc buf r 0 acc  = return ""
unpackAcc buf (I## r) (I## len) acc = IO $ \s -> unpack acc (len -## 1##) s
   where
    unpack acc i s
     | i <## r  = (## s, acc ##)
     | otherwise = 
          case readCharArray## buf i s of
	    (## s, ch ##) -> unpack (C## ch : acc) (i -## 1##) s

-- ---------------------------------------------------------------------------
-- hPutChar

-- `hPutChar hdl ch' writes the character `ch' to the file or channel
-- managed by `hdl'.  Characters may be buffered if buffering is
-- enabled for `hdl'.

hPutChar :: Handle -> Char -> IO ()
hPutChar handle c = 
    c `seq` do   -- must evaluate c before grabbing the handle lock
    wantWritableHandle "hPutChar" handle $ \ handle_  -> do
    let fd = haFD handle_
    case haBufferMode handle_ of
	LineBuffering    -> hPutcBuffered handle_ True  c
	BlockBuffering _ -> hPutcBuffered handle_ False c
	NoBuffering      ->
		withObject (castCharToCChar c) $ \buf ->
		throwErrnoIfMinus1RetryMayBlock_ "hPutChar"
		   (c_write (fromIntegral fd) buf 1)
		   (threadWaitWrite fd)


hPutcBuffered handle_ is_line c = do
  let ref = haBuffer handle_
  buf <- readIORef ref
  let w = bufWPtr buf
  w'  <- writeCharIntoBuffer (bufBuf buf) w c
  let new_buf = buf{ bufWPtr = w' }
  if bufferFull new_buf || is_line && c == '\n'
     then do 
  	flushed_buf <- flushWriteBuffer (haFD handle_) new_buf
  	writeIORef ref flushed_buf
     else do 
  	writeIORef ref new_buf


hPutChars :: Handle -> [Char] -> IO ()
hPutChars handle [] = return ()
hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs

-- ---------------------------------------------------------------------------
-- hPutStr

-- `hPutStr hdl s' writes the string `s' to the file or
-- hannel managed by `hdl', buffering the output if needs be.

-- We go to some trouble to avoid keeping the handle locked while we're
-- evaluating the string argument to hPutStr, in case doing so triggers another
-- I/O operation on the same handle which would lead to deadlock.  The classic
-- case is
--
--		putStr (trace "hello" "world")
--
-- so the basic scheme is this:
--
--	* copy the string into a fresh buffer,
--	* "commit" the buffer to the handle.
--
-- Committing may involve simply copying the contents of the new
-- buffer into the handle's buffer, flushing one or both buffers, or
-- maybe just swapping the buffers over (if the handle's buffer was
-- empty).  See commitBuffer below.

hPutStr :: Handle -> String -> IO ()
hPutStr handle str = do
    buffer_mode <- wantWritableHandle "hPutStr" handle 
			(\ handle_ -> do getSpareBuffer handle_)
    case buffer_mode of
       (NoBuffering, _) -> do
	    hPutChars handle str	-- v. slow, but we don't care
       (LineBuffering, buf) -> do
	    writeLines handle buf str
       (BlockBuffering _, buf) -> do
            writeBlocks handle buf str


getSpareBuffer :: Handle__ -> IO (BufferMode, Buffer)
474
475
476
477
getSpareBuffer Handle__{haBuffer=ref, 
			haBuffers=spare_ref,
			haBufferMode=mode}
 = do
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
   case mode of
     NoBuffering -> return (mode, error "no buffer!")
     _ -> do
          bufs <- readIORef spare_ref
	  buf  <- readIORef ref
	  case bufs of
 	    BufferListCons b rest -> do
		writeIORef spare_ref rest
		return ( mode, newEmptyBuffer b WriteBuffer (bufSize buf))
	    BufferListNil -> do
		new_buf <- allocateBuffer (bufSize buf) WriteBuffer
		return (mode, new_buf)


writeLines :: Handle -> Buffer -> String -> IO ()
writeLines hdl Buffer{ bufBuf=raw, bufSize=len } s =
  let
   shoveString :: Int -> [Char] -> IO ()
	-- check n == len first, to ensure that shoveString is strict in n.
   shoveString n cs | n == len = do
	new_buf <- commitBuffer hdl raw len n True{-needs flush-} False
499
	writeLines hdl new_buf cs
500
501
502
503
504
   shoveString n [] = do
	commitBuffer hdl raw len n False{-no flush-} True{-release-}
	return ()
   shoveString n (c:cs) = do
	n' <- writeCharIntoBuffer raw n c
505
506
507
	if (c == '\n') 
	   then do 
		new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False
508
		writeLines hdl new_buf cs
509
510
	   else	
		shoveString n' cs
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
  in
  shoveString 0 s

writeBlocks :: Handle -> Buffer -> String -> IO ()
writeBlocks hdl Buffer{ bufBuf=raw, bufSize=len } s =
  let
   shoveString :: Int -> [Char] -> IO ()
	-- check n == len first, to ensure that shoveString is strict in n.
   shoveString n cs | n == len = do
	new_buf <- commitBuffer hdl raw len n True{-needs flush-} False
	writeBlocks hdl new_buf cs
   shoveString n [] = do
	commitBuffer hdl raw len n False{-no flush-} True{-release-}
	return ()
   shoveString n (c:cs) = do
	n' <- writeCharIntoBuffer raw n c
	shoveString n' cs
  in
  shoveString 0 s

-- -----------------------------------------------------------------------------
-- commitBuffer handle buf sz count flush release
-- 
-- Write the contents of the buffer 'buf' ('sz' bytes long, containing
-- 'count' bytes of data) to handle (handle must be block or line buffered).
-- 
-- Implementation:
-- 
--    for block/line buffering,
-- 	 1. If there isn't room in the handle buffer, flush the handle
-- 	    buffer.
-- 
-- 	 2. If the handle buffer is empty,
-- 		 if flush, 
-- 		     then write buf directly to the device.
-- 		     else swap the handle buffer with buf.
-- 
-- 	 3. If the handle buffer is non-empty, copy buf into the
-- 	    handle buffer.  Then, if flush != 0, flush
-- 	    the buffer.

commitBuffer
	:: Handle			-- handle to commit to
	-> RawBuffer -> Int		-- address and size (in bytes) of buffer
	-> Int				-- number of bytes of data in buffer
	-> Bool				-- flush the handle afterward?
	-> Bool 			-- release the buffer?
	-> IO Buffer

commitBuffer hdl raw sz count flush release = do
  wantWritableHandle "commitAndReleaseBuffer" hdl $ 
    \ handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } -> do

#ifdef DEBUG_DUMP
      puts ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
	    ++ ", flush=" ++ show flush ++ ", release=" ++ show release ++"\n")
#endif

      old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
	  <- readIORef ref

      buf_ret <-
        -- enough room in handle buffer?
	 if (not flush && (size - w > count))
		-- The > is to be sure that we never exactly fill
		-- up the buffer, which would require a flush.  So
		-- if copying the new data into the buffer would
		-- make the buffer full, we just flush the existing
		-- buffer and the new data immediately, rather than
		-- copying before flushing.

		-- not flushing, and there's enough room in the buffer:
		-- just copy the data in and update bufWPtr.
	    then do memcpy_off old_raw w raw (fromIntegral count)
		    writeIORef ref old_buf{ bufWPtr = w + count }
		    return (newEmptyBuffer raw WriteBuffer sz)

		-- else, we have to flush
	    else do flushed_buf <- flushWriteBuffer fd old_buf

		    let this_buf = 
			    Buffer{ bufBuf=raw, bufState=WriteBuffer, 
				    bufRPtr=0, bufWPtr=count, bufSize=sz }

			-- if:  (a) we don't have to flush, and
			--      (b) size(new buffer) == size(old buffer), and
			--      (c) new buffer is not full,
			-- we can just just swap them over...
		    if (not flush && sz == size && count /= sz)
			then do 
			  writeIORef ref this_buf
			  return flushed_buf			     

			-- otherwise, we have to flush the new data too,
			-- and start with a fresh buffer
			else do 
			  flushWriteBuffer fd this_buf
			  writeIORef ref flushed_buf
			    -- if the sizes were different, then allocate
			    -- a new buffer of the correct size.
			  if sz == size
			     then return (newEmptyBuffer raw WriteBuffer sz)
			     else allocateBuffer size WriteBuffer

      -- release the buffer if necessary
      if release && bufSize buf_ret == size
	 then do
	      spare_bufs <- readIORef spare_buf_ref
	      writeIORef spare_buf_ref 
		(BufferListCons (bufBuf buf_ret) spare_bufs)
	      return buf_ret
	 else
	      return buf_ret


626
foreign import "memcpy_PrelIO_wrap" unsafe 
627
628
   memcpy_off :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
#def inline \
629
void *memcpy_PrelIO_wrap(char *dst, HsInt dst_off, const char *src, size_t sz) \
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
{ return memcpy(dst+dst_off, src, sz); }

-- ---------------------------------------------------------------------------
-- hPutStrLn

-- Derived action `hPutStrLn hdl str' writes the string `str' to
-- the handle `hdl', adding a newline at the end.

hPutStrLn :: Handle -> String -> IO ()
hPutStrLn hndl str = do
 hPutStr  hndl str
 hPutChar hndl '\n'

-- ---------------------------------------------------------------------------
-- hPrint

-- Computation `hPrint hdl t' writes the string representation of `t'
-- given by the `shows' function to the file or channel managed by `hdl'.

hPrint :: Show a => Handle -> a -> IO ()
hPrint hdl = hPutStrLn hdl . show