ghc/lib/prelude/PreludeWriteTextIO.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1994
   3 %
   4 \section[PrelWriteTextIO]{Haskell 1.3 Text Output}
   5
   6 This module defines the standard set of output operations for writing
   7 characters and strings to text files, using
   8 $handles$
   9
  10 \begin{code}
  11 module PreludeWriteTextIO (
  12     hPutChar,
  13     putChar,
  14     hPutStr,
  15     putStr,
  16     hPutText,
  17     putText,
  18     print13,
  19     writeFile13,
  20     appendFile13
  21   ) where
  22
  23 import Cls
  24 import Core
  25 import IChar
  26 import IInt
  27 import IList
  28 import List             ( splitAt, (++) )
  29 import Prel             ( ord, (.), otherwise )
  30 import Text
  31 import TyArray          -- instance _CCallable (_ByteArray a)
  32 import TyComplex
  33
  34 import PreludeIOError
  35 import PreludeMonadicIO
  36 import PreludePrimIO
  37 import PreludeGlaST
  38 import PreludeStdIO
  39 import PS
  40
  41 hPutChar :: Handle -> Char -> IO ()
  42 hPutChar handle c =
  43     takeMVar handle                                 >>= \ htype ->
  44     case htype of
  45       _ErrorHandle ioError ->
  46           putMVar handle htype                      >>
  47           failWith ioError
  48       _ClosedHandle ->
  49           putMVar handle htype                      >>
  50           failWith (IllegalOperation "handle is closed")
  51       _SemiClosedHandle _ _ ->
  52           putMVar handle htype                      >>
  53           failWith (IllegalOperation "handle is closed")
  54       _ReadHandle _ _ _ ->
  55           putMVar handle htype                      >>
  56           failWith (IllegalOperation "handle is not open for writing")
  57       other ->
  58           _ccall_ filePutc (_filePtr other) (ord c) `thenPrimIO` \ rc ->
  59           putMVar handle (_markHandle htype)        >>
  60           if rc == 0 then
  61               return ()
  62           else
  63               _constructError                       `thenPrimIO` \ ioError ->
  64               failWith ioError
  65
  66 putChar :: Char -> IO ()
  67 putChar = hPutChar stdout13
  68
  69 \end{code}
  70
  71 Computation $hPutChar hdl c$ writes the character {\em c} to the file
  72 or channel managed by {\em hdl}.  Characters may be buffered if
  73 buffering is enabled for {\em hdl}.
  74
  75 \begin{code}
  76 hPutStr :: Handle -> String -> IO ()
  77 hPutStr handle str =
  78     takeMVar handle                                 >>= \ htype ->
  79     case htype of
  80       _ErrorHandle ioError ->
  81           putMVar handle htype                      >>
  82           failWith ioError
  83       _ClosedHandle ->
  84           putMVar handle htype                      >>
  85           failWith (IllegalOperation "handle is closed")
  86       _SemiClosedHandle _ _ ->
  87           putMVar handle htype                      >>
  88           failWith (IllegalOperation "handle is closed")
  89       _ReadHandle _ _ _ ->
  90           putMVar handle htype                      >>
  91           failWith (IllegalOperation "handle is not open for writing")
  92       other ->
  93           _getBufferMode other                      `thenPrimIO` \ other ->
  94           (case _bufferMode other of
  95             Just LineBuffering ->
  96                 writeLines (_filePtr other) str
  97             Just (BlockBuffering (Just size)) ->
  98                 writeBlocks (_filePtr other) size str
  99             Just (BlockBuffering Nothing) ->
 100                 writeBlocks (_filePtr other) ``BUFSIZ'' str
 101             _ -> -- Nothing is treated pessimistically as NoBuffering
 102                 writeChars (_filePtr other) str
 103           )                                         `thenPrimIO` \ success ->
 104             putMVar handle (_markHandle other)      `seqPrimIO`
 105           if success then
 106               return ()
 107           else
 108               _constructError                       `thenPrimIO` \ ioError ->
 109               failWith ioError
 110
 111   where
 112
 113     writeBlocks :: _Addr -> Int -> String -> PrimIO Bool
 114     writeBlocks fp size "" = returnPrimIO True
 115     writeBlocks fp size s =
 116         let
 117             (some, more) = splitAt size s
 118         in
 119             _packBytesForCST some                   `thenPrimIO`
 120               \ bytes@(_ByteArray (0, count) _) ->
 121             _ccall_ writeFile bytes fp (count+1)    `thenPrimIO` \ rc ->
 122             if rc == 0 then
 123                 writeBlocks fp size more
 124             else
 125                 returnPrimIO False
 126
 127     writeLines :: _Addr -> String -> PrimIO Bool
 128     writeLines fp "" = returnPrimIO True
 129     writeLines fp s =
 130         let
 131             (some, more) = breakLine s
 132         in
 133             _packBytesForCST some                   `thenPrimIO`
 134               \ bytes@(_ByteArray (0, count) _) ->
 135             _ccall_ writeFile bytes fp (count+1)    `thenPrimIO` \ rc ->
 136             if rc == 0 then
 137                 writeLines fp more
 138             else
 139                 returnPrimIO False
 140       where
 141         breakLine ""    = ("","")
 142         breakLine (x:xs)
 143           | x == '\n'   = ([x],xs)
 144           | otherwise   = let (ys,zs) = breakLine xs in (x:ys,zs)
 145
 146     writeChars :: _Addr -> String -> PrimIO Bool
 147     writeChars fp "" = returnPrimIO True
 148     writeChars fp (c:cs) =
 149         _ccall_ filePutc fp (ord c)                 `thenPrimIO` \ rc ->
 150         if rc == 0 then
 151             writeChars fp cs
 152         else
 153             returnPrimIO False
 154
 155 putStr :: String -> IO ()
 156 putStr = hPutStr stdout13
 157
 158 hPutText :: Text a => Handle -> a -> IO ()
 159 hPutText hdl = hPutStr hdl . show
 160
 161 putText :: Text a => a -> IO ()
 162 putText = hPutText stdout13
 163
 164 print13 :: Text a => a -> IO ()
 165 print13 x = putText x >> putChar '\n'
 166
 167 \end{code}
 168
 169 Computation $hPutStr hdl s$ writes the string {\em s} to the file or
 170 channel managed by {\em hdl}.
 171
 172 Computation $putStr s$ writes the string {\em s} to $stdout$.
 173
 174 Computation $hPutText hdl t$ writes the string representation of {\em
 175 t} given by the $shows$ function to the file or channel managed by
 176 {\em hdl}.
 177
 178 \begin{code}
 179
 180 writeFile13 :: FilePath -> String -> IO ()
 181 writeFile13 name str =
 182  openFile name WriteMode >>= \hdl -> hPutStr hdl str >> hClose hdl
 183
 184 appendFile13 :: FilePath -> String -> IO ()
 185 appendFile13 name str =
 186  openFile name AppendMode >>= \hdl -> hPutStr hdl str >> hClose hdl
 187
 188 \end{code}
 189
 190 $writeFile file s$ replaces the contents of {\em file} by the string
 191 {\em s}. $appendFile file s$ appends string {\em s} to {\em file}.