-- |
-- module: Data.Text.IO.Locale
-- copyright: © kudah 2013
-- license: BSD3
--
-- maintainer: kudahkukarek@gmail.com
-- stability: experimental
-- portability: GHC-only
--
-- This module offers much faster locale-aware I/O than "Data.Text.IO" due to
-- the usage of 'hPutBuf' to write the resulting 'Data.ByteString.ByteString'
-- all at once, while "Data.Text.IO" writes characters one at a time, taking the
-- 'Handle' lock each time. Since functions in this module take the lock just
-- once, they can safely be used from multiple threads without fear of messed up
-- output.
--
-- Functions in this module require at least twice as much memory as the
-- 'Data.Text.Text' they operate on to output it. For strings more than a half
-- of available RAM in size, this may result in memory exhaustion.
--
-- This module is intended to be imported @qualified@.
{-# LANGUAGE CPP #-}
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif
module Data.Text.IO.Locale
    (putStr
    ,putStrLn
    ,hPutStr
    ,hPutStrLn
    ,writeFile
    ,appendFile
    ) where
import Prelude hiding (putStr, putStrLn, writeFile, appendFile)

import Data.Text.Encoding.Locale

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8 (hPutStrLn, putStrLn)
import qualified Data.Text as T

import System.IO hiding (hPutStr, hPutStrLn, putStr, putStrLn, writeFile, appendFile)

-- | Like 'Data.Text.IO.putStr', but writes the 'Text' all at once.
{-# INLINE putStr #-}
putStr :: T.Text -> IO ()
putStr t = B.putStr =<< encodeLocale t

-- | Like 'Data.Text.IO.putStrLn', but writes the 'Text' all at once.
{-# INLINE putStrLn #-}
putStrLn :: T.Text -> IO ()
putStrLn t = B8.putStrLn =<< encodeLocale t

-- | Like 'Data.Text.IO.hPutStr', but writes the 'Text' all at once.
{-# INLINE hPutStr #-}
hPutStr :: Handle -> T.Text -> IO ()
hPutStr h t = B.hPut h =<< encodeFromHandle h t

-- | Like 'Data.Text.IO.hPutStrLn', but writes the 'Text' all at once.
{-# INLINE hPutStrLn #-}
hPutStrLn :: Handle -> T.Text -> IO ()
hPutStrLn h t = B8.hPutStrLn h =<< encodeFromHandle h t

-- | Like 'Data.Text.IO.writeFile', but writes the 'Text' all at once.
{-# INLINE writeFile #-}
writeFile :: FilePath -> T.Text -> IO ()
writeFile f t = B.writeFile f =<< encodeLocale t

-- | Like 'Data.Text.IO.appendFile', but writes the 'Text' all at once.
{-# INLINE appendFile #-}
appendFile :: FilePath -> T.Text -> IO ()
appendFile f t = B.appendFile f =<< encodeLocale t