1{-# LANGUAGE Safe #-}
2-----------------------------------------------------------------------------
3-- |
4-- Module      :  System.IO.Strict
5-- Copyright   :  (c) Don Stewart 2007
6-- License     :  BSD-style (see the file libraries/base/LICENSE)
7--
8-- Maintainer  :  dons@galois.com
9-- Stability   :  stable
10-- Portability :  portable
11--
12-- The standard IO input functions using strict IO.
13--
14-----------------------------------------------------------------------------
15
16module System.IO.Strict (
17
18    -- * Strict Handle IO
19    hGetContents,              -- :: Handle -> IO [Char]
20
21    -- * Strict String IO wrappers
22    getContents,               -- :: IO String
23    readFile,                  -- :: FilePath -> IO String
24    interact                   -- :: (String -> String) -> IO ()
25
26  ) where
27
28import Prelude ( String, (>>=), seq, return, (.), (=<<), FilePath, length)
29import System.IO (IO)
30import qualified System.IO as IO
31
32-- -----------------------------------------------------------------------------
33-- Strict hGetContents
34
35-- | Computation 'hGetContents' @hdl@ returns the list of characters
36-- corresponding to the unread portion of the channel or file managed
37-- by @hdl@, which is immediate closed.
38--
39-- Items are read strictly from the input Handle.
40--
41-- This operation may fail with:
42--
43--  * 'isEOFError' if the end of file has been reached.
44
45hGetContents    :: IO.Handle -> IO.IO String
46hGetContents h  = IO.hGetContents h >>= \s -> length s `seq` return s
47
48-- -----------------------------------------------------------------------------
49-- Standard IO
50
51-- | The 'getContents' operation returns all user input as a single string,
52-- which is read stirctly (same as 'hGetContents' 'stdin').
53
54getContents     :: IO String
55getContents     =  hGetContents IO.stdin
56{-# INLINE getContents #-}
57
58-- | The 'interact' function takes a function of type @String->String@
59-- as its argument.  The entire input from the standard input device is
60-- passed to this function as its argument, and the resulting string is
61-- output on the standard output device.
62
63interact        ::  (String -> String) -> IO ()
64interact f      =   IO.putStr . f =<< getContents
65{-# INLINE interact #-}
66
67-- | The 'readFile' function reads a file and
68-- returns the contents of the file as a string.
69-- The file is read strictly, as with 'getContents'.
70
71readFile        :: FilePath -> IO String
72readFile name   =  IO.openFile name IO.ReadMode >>= hGetContents
73{-# INLINE readFile #-}
74