{-# LANGUAGE CPP, OverloadedStrings #-}

module Data.Text.Utf8 where

import           Prelude               hiding (putStr, putStrLn)

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative   (Applicative(..), (<$>))
#endif

import qualified Data.ByteString.Char8 as BIO 
import qualified Data.Text             as Text
import           Data.Text.Encoding    (decodeUtf8, encodeUtf8)
import           System.IO (Handle)

readFile :: FilePath -> IO Text.Text
readFile :: FilePath -> IO Text
readFile FilePath
f = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO ByteString
BIO.readFile FilePath
f)

getContents :: IO Text.Text 
getContents :: IO Text
getContents = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
BIO.getContents

putStr :: Text.Text -> IO ()
putStr :: Text -> IO ()
putStr = ByteString -> IO ()
BIO.putStr (ByteString -> IO ()) -> (Text -> ByteString) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

putStrLn :: Text.Text -> IO ()
putStrLn :: Text -> IO ()
putStrLn = ByteString -> IO ()
BIO.putStrLn (ByteString -> IO ()) -> (Text -> ByteString) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

writeFile :: FilePath -> Text.Text -> IO ()
writeFile :: FilePath -> Text -> IO ()
writeFile FilePath
f Text
x = FilePath -> ByteString -> IO ()
BIO.writeFile FilePath
f (Text -> ByteString
encodeUtf8 Text
x) 

hPut :: Handle -> Text.Text -> IO ()
hPut :: Handle -> Text -> IO ()
hPut Handle
h Text
x = Handle -> ByteString -> IO ()
BIO.hPut Handle
h (Text -> ByteString
encodeUtf8 Text
x) 

hPutStrLn :: Handle -> Text.Text -> IO ()
hPutStrLn :: Handle -> Text -> IO ()
hPutStrLn Handle
h Text
x = Handle -> ByteString -> IO ()
BIO.hPutStrLn Handle
h (Text -> ByteString
encodeUtf8 Text
x)

putStrS :: String -> IO ()
putStrS :: FilePath -> IO ()
putStrS = Text -> IO ()
putStr (Text -> IO ()) -> (FilePath -> Text) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack

putStrLnS :: String -> IO ()
putStrLnS :: FilePath -> IO ()
putStrLnS = Text -> IO ()
putStrLn (Text -> IO ()) -> (FilePath -> Text) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack

print :: Show a => a -> IO ()
print :: a -> IO ()
print = ByteString -> IO ()
BIO.putStrLn (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (a -> Text) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack (FilePath -> Text) -> (a -> FilePath) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FilePath
forall a. Show a => a -> FilePath
show