-- |
-- Module      : Data.Text.IO.Utf8
-- License     : BSD-style
-- Portability : GHC
--
-- Efficient UTF-8 support for text I\/O.
-- Unlike @Data.Text.IO@, these functions do not depend on the locale
-- and do not do line ending conversion.
module Data.Text.IO.Utf8
    (
    -- * File-at-a-time operations
      readFile
    , writeFile
    , appendFile
    -- * Operations on handles
    , hGetContents
    , hGetLine
    , hPutStr
    , hPutStrLn
    -- * Special cases for standard input and output
    , interact
    , getContents
    , getLine
    , putStr
    , putStrLn
    ) where

import Prelude hiding (readFile, writeFile, appendFile, interact, getContents, getLine, putStr, putStrLn)
import Control.Exception (evaluate)
import Control.Monad ((<=<))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import GHC.IO.Handle (Handle)
import qualified Data.ByteString.Char8 as B.Char8

decodeUtf8IO :: ByteString -> IO Text
decodeUtf8IO :: ByteString -> IO Text
decodeUtf8IO = Text -> IO Text
forall a. a -> IO a
evaluate (Text -> IO Text) -> (ByteString -> Text) -> ByteString -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8

-- | The 'readFile' function reads a file and returns the contents of
-- the file as a string.  The entire file is read strictly, as with
-- 'getContents'.
readFile :: FilePath -> IO Text
readFile :: FilePath -> IO Text
readFile = ByteString -> IO Text
decodeUtf8IO (ByteString -> IO Text)
-> (FilePath -> IO ByteString) -> FilePath -> IO Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FilePath -> IO ByteString
B.readFile

-- | Write a string to a file.  The file is truncated to zero length
-- before writing begins.
writeFile :: FilePath -> Text -> IO ()
writeFile :: FilePath -> Text -> IO ()
writeFile FilePath
fp = FilePath -> ByteString -> IO ()
B.writeFile FilePath
fp (ByteString -> IO ()) -> (Text -> ByteString) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- | Write a string to the end of a file.
appendFile :: FilePath -> Text -> IO ()
appendFile :: FilePath -> Text -> IO ()
appendFile FilePath
fp = FilePath -> ByteString -> IO ()
B.appendFile FilePath
fp (ByteString -> IO ()) -> (Text -> ByteString) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- | Read the remaining contents of a 'Handle' as a string.
hGetContents :: Handle -> IO Text
hGetContents :: Handle -> IO Text
hGetContents = ByteString -> IO Text
decodeUtf8IO (ByteString -> IO Text)
-> (Handle -> IO ByteString) -> Handle -> IO Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Handle -> IO ByteString
B.hGetContents

-- | Read a single line from a handle.
hGetLine :: Handle -> IO Text
hGetLine :: Handle -> IO Text
hGetLine = ByteString -> IO Text
decodeUtf8IO (ByteString -> IO Text)
-> (Handle -> IO ByteString) -> Handle -> IO Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Handle -> IO ByteString
B.hGetLine

-- | Write a string to a handle.
hPutStr :: Handle -> Text -> IO ()
hPutStr :: Handle -> Text -> IO ()
hPutStr Handle
h = Handle -> ByteString -> IO ()
B.hPutStr Handle
h (ByteString -> IO ()) -> (Text -> ByteString) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- | Write a string to a handle, followed by a newline.
hPutStrLn :: Handle -> Text -> IO ()
hPutStrLn :: Handle -> Text -> IO ()
hPutStrLn Handle
h Text
t = Handle -> Text -> IO ()
hPutStr Handle
h Text
t IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> ByteString -> IO ()
B.hPutStr Handle
h (Char -> ByteString
B.Char8.singleton Char
'\n')

-- | The 'interact' function takes a function of type @Text -> Text@
-- as its argument. The entire input from the standard input device is
-- passed to this function as its argument, and the resulting string
-- is output on the standard output device.
interact :: (Text -> Text) -> IO ()
interact :: (Text -> Text) -> IO ()
interact Text -> Text
f = Text -> IO ()
putStr (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
f (Text -> IO ()) -> IO Text -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Text
getContents

-- | Read all user input on 'stdin' as a single string.
getContents :: IO Text
getContents :: IO Text
getContents = ByteString -> IO Text
decodeUtf8IO (ByteString -> IO Text) -> IO ByteString -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ByteString
B.getContents

-- | Read a single line of user input from 'stdin'.
getLine :: IO Text
getLine :: IO Text
getLine = ByteString -> IO Text
decodeUtf8IO (ByteString -> IO Text) -> IO ByteString -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ByteString
B.getLine

-- | Write a string to 'stdout'.
putStr :: Text -> IO ()
putStr :: Text -> IO ()
putStr = ByteString -> IO ()
B.putStr (ByteString -> IO ()) -> (Text -> ByteString) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- | Write a string to 'stdout', followed by a newline.
putStrLn :: Text -> IO ()
putStrLn :: Text -> IO ()
putStrLn Text
t = ByteString -> IO ()
B.putStr (Text -> ByteString
encodeUtf8 Text
t) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> IO ()
B.putStr (Char -> ByteString
B.Char8.singleton Char
'\n')