{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ImplicitParams           #-}
{- | This module provides a replacement for the normal (unicode unaware) IO functions of haskell.
     By using implicit parameters, it can be used almost as a drop-in replacement.
     For example, consider the following simple echo program:

     > main = do
     >   str <- getContents
     >   putStr str

     To make this program process UTF-8 data, change the program to:

     > {-# LANGUAGE ImplicitParams #-}
     >
     > import Prelude hiding (getContents,putStr)
     > import System.IO.Encoding
     > import Data.Encoding.UTF8
     >
     > main = do
     >   let ?enc = UTF8
     >   str <- getContents
     >   putStr str

     Or, if you want to use the standard system encoding:

     > {-# LANGUAGE ImplicitParams #-}
     >
     > import Prelude hiding (getContents,putStr)
     > import System.IO.Encoding
     >
     > main = do
     >   e <- getSystemEncoding
     >   let ?enc = e
     >   str <- getContents
     >   putStr str
 -}
module System.IO.Encoding
    (getSystemEncoding
    ,getContents
    ,putStr
    ,putStrLn
    ,hPutStr
    ,hPutStrLn
    ,hGetContents
    ,readFile
    ,writeFile
    ,appendFile
    ,getChar
    ,hGetChar
    ,getLine
    ,hGetLine
    ,putChar
    ,hPutChar
    ,interact
    ,print
    ,hPrint) where

import           Foreign.C.String

import           Control.Monad.Reader (runReaderT)
import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as LBS
import           Data.Encoding
import           Prelude              hiding (appendFile, getChar, getContents,
                                       getLine, interact, print, putChar,
                                       putStr, putStrLn, readFile, writeFile)
import           System.IO            (Handle, stdin, stdout)

-- | Like the normal 'System.IO.hGetContents', but decodes the input using an
--   encoding.
hGetContents :: (Encoding e,?enc :: e) => Handle -> IO String
hGetContents :: forall e. (Encoding e, ?enc::e) => Handle -> IO String
hGetContents Handle
h = do
	ByteString
str <- Handle -> IO ByteString
LBS.hGetContents Handle
h
	String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ e -> ByteString -> String
forall enc. Encoding enc => enc -> ByteString -> String
decodeLazyByteString e
?enc::e
?enc ByteString
str

getContents :: (Encoding e,?enc :: e) => IO String
getContents :: forall e. (Encoding e, ?enc::e) => IO String
getContents = do
    ByteString
str <- IO ByteString
LBS.getContents
    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ e -> ByteString -> String
forall enc. Encoding enc => enc -> ByteString -> String
decodeLazyByteString e
?enc::e
?enc ByteString
str

putStr :: (Encoding e,?enc :: e) => String -> IO ()
putStr :: forall e. (Encoding e, ?enc::e) => String -> IO ()
putStr = Handle -> String -> IO ()
forall e. (Encoding e, ?enc::e) => Handle -> String -> IO ()
hPutStr Handle
stdout

putStrLn :: (Encoding e,?enc :: e) => String -> IO ()
putStrLn :: forall e. (Encoding e, ?enc::e) => String -> IO ()
putStrLn = Handle -> String -> IO ()
forall e. (Encoding e, ?enc::e) => Handle -> String -> IO ()
hPutStrLn Handle
stdout

-- | Like the normal 'System.IO.hPutStr', but encodes the output using an
--   encoding.
hPutStr :: (Encoding e,?enc :: e) => Handle -> String -> IO ()
hPutStr :: forall e. (Encoding e, ?enc::e) => Handle -> String -> IO ()
hPutStr Handle
h String
str = Handle -> ByteString -> IO ()
LBS.hPut Handle
h (e -> String -> ByteString
forall enc. Encoding enc => enc -> String -> ByteString
encodeLazyByteString e
?enc::e
?enc String
str)

hPutStrLn :: (Encoding e,?enc :: e) => Handle -> String -> IO ()
hPutStrLn :: forall e. (Encoding e, ?enc::e) => Handle -> String -> IO ()
hPutStrLn Handle
h String
str = do
    Handle -> ByteString -> IO ()
LBS.hPut Handle
h (e -> String -> ByteString
forall enc. Encoding enc => enc -> String -> ByteString
encodeLazyByteString e
?enc::e
?enc String
str)
    Handle -> ByteString -> IO ()
LBS.hPut Handle
h (e -> String -> ByteString
forall enc. Encoding enc => enc -> String -> ByteString
encodeLazyByteString e
?enc::e
?enc String
"\n")

print :: (Encoding e,Show a,?enc :: e) => a -> IO ()
print :: forall e a. (Encoding e, Show a, ?enc::e) => a -> IO ()
print = Handle -> a -> IO ()
forall e a. (Encoding e, Show a, ?enc::e) => Handle -> a -> IO ()
hPrint Handle
stdout

hPrint :: (Encoding e,Show a,?enc :: e) => Handle -> a -> IO ()
hPrint :: forall e a. (Encoding e, Show a, ?enc::e) => Handle -> a -> IO ()
hPrint Handle
h a
x = Handle -> String -> IO ()
forall e. (Encoding e, ?enc::e) => Handle -> String -> IO ()
hPutStrLn Handle
h (a -> String
forall a. Show a => a -> String
show a
x)

readFile :: (Encoding e,?enc :: e) => FilePath -> IO String
readFile :: forall e. (Encoding e, ?enc::e) => String -> IO String
readFile String
fn = String -> IO ByteString
LBS.readFile String
fn IO ByteString -> (ByteString -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(String -> IO String)
-> (ByteString -> String) -> ByteString -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(e -> ByteString -> String
forall enc. Encoding enc => enc -> ByteString -> String
decodeLazyByteString e
?enc::e
?enc)

writeFile :: (Encoding e,?enc :: e) => FilePath -> String -> IO ()
writeFile :: forall e. (Encoding e, ?enc::e) => String -> String -> IO ()
writeFile String
fn String
str = String -> ByteString -> IO ()
LBS.writeFile String
fn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ e -> String -> ByteString
forall enc. Encoding enc => enc -> String -> ByteString
encodeLazyByteString e
?enc::e
?enc String
str

appendFile :: (Encoding e,?enc :: e) => FilePath -> String -> IO ()
appendFile :: forall e. (Encoding e, ?enc::e) => String -> String -> IO ()
appendFile String
fn String
str = String -> ByteString -> IO ()
LBS.appendFile String
fn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ e -> String -> ByteString
forall enc. Encoding enc => enc -> String -> ByteString
encodeLazyByteString e
?enc::e
?enc String
str

getChar :: (Encoding e,?enc :: e) => IO Char
getChar :: forall e. (Encoding e, ?enc::e) => IO Char
getChar = Handle -> IO Char
forall e. (Encoding e, ?enc::e) => Handle -> IO Char
hGetChar Handle
stdin

hGetChar :: (Encoding e,?enc :: e) => Handle -> IO Char
hGetChar :: forall e. (Encoding e, ?enc::e) => Handle -> IO Char
hGetChar Handle
h = ReaderT Handle IO Char -> Handle -> IO Char
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (e -> ReaderT Handle IO Char
forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m Char
forall (m :: * -> *). ByteSource m => e -> m Char
decodeChar e
?enc::e
?enc) Handle
h

getLine :: (Encoding e,?enc :: e) => IO String
getLine :: forall e. (Encoding e, ?enc::e) => IO String
getLine = Handle -> IO String
forall e. (Encoding e, ?enc::e) => Handle -> IO String
hGetLine Handle
stdin

hGetLine :: (Encoding e,?enc :: e) => Handle -> IO String
hGetLine :: forall e. (Encoding e, ?enc::e) => Handle -> IO String
hGetLine Handle
h = do
  ByteString
line <- Handle -> IO ByteString
BS.hGetLine Handle
h
  String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ e -> ByteString -> String
forall enc. Encoding enc => enc -> ByteString -> String
decodeStrictByteString e
?enc::e
?enc ByteString
line

putChar :: (Encoding e,?enc :: e) => Char -> IO ()
putChar :: forall e. (Encoding e, ?enc::e) => Char -> IO ()
putChar = Handle -> Char -> IO ()
forall e. (Encoding e, ?enc::e) => Handle -> Char -> IO ()
hPutChar Handle
stdout

hPutChar :: (Encoding e,?enc :: e) => Handle -> Char -> IO ()
hPutChar :: forall e. (Encoding e, ?enc::e) => Handle -> Char -> IO ()
hPutChar Handle
h Char
c = ReaderT Handle IO () -> Handle -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (e -> Char -> ReaderT Handle IO ()
forall enc (m :: * -> *).
(Encoding enc, ByteSink m) =>
enc -> Char -> m ()
forall (m :: * -> *). ByteSink m => e -> Char -> m ()
encodeChar e
?enc::e
?enc Char
c) Handle
h

interact :: (Encoding e,?enc :: e) => (String -> String) -> IO ()
interact :: forall e. (Encoding e, ?enc::e) => (String -> String) -> IO ()
interact String -> String
f = do
  String
line <- Handle -> IO String
forall e. (Encoding e, ?enc::e) => Handle -> IO String
hGetLine Handle
stdin
  Handle -> String -> IO ()
forall e. (Encoding e, ?enc::e) => Handle -> String -> IO ()
hPutStrLn Handle
stdout (String -> String
f String
line)

#ifndef mingw32_HOST_OS
foreign import ccall "system_encoding.h get_system_encoding"
	get_system_encoding :: IO CString
#endif

-- | On unix machines, returns the system's currently configured text encoding,
-- or Nothing if there was an error. On Windows, currently always returns Nothing.
getSystemEncoding :: IO (Maybe DynEncoding)
getSystemEncoding :: IO (Maybe DynEncoding)
getSystemEncoding = do
#ifndef mingw32_HOST_OS
  CString
enc <- IO CString
get_system_encoding
  String
str <- CString -> IO String
peekCString CString
enc
  Maybe DynEncoding -> IO (Maybe DynEncoding)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DynEncoding -> IO (Maybe DynEncoding))
-> Maybe DynEncoding -> IO (Maybe DynEncoding)
forall a b. (a -> b) -> a -> b
$ String -> Maybe DynEncoding
encodingFromStringExplicit String
str
#else
  return Nothing
#endif