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