encoding/System/IO/Encoding.hs

{-# LANGUAGE ImplicitParams,ForeignFunctionInterface #-}
{- | 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 Data.Encoding
import System.IO (Handle,stdout,stdin)
import Prelude hiding (print,getContents,readFile,writeFile,appendFile,interact,putStr,putStrLn,getChar,getLine,putChar)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString as BS
import Control.Monad.Reader (runReaderT)

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

-- | Like the normal 'System.IO.getContents', but decodes the input using an
--   encoding.
getContents :: (Encoding e,?enc :: e) => IO String
getContents = do
    str <- LBS.getContents
    return $ decodeLazyByteString ?enc str

-- | Like the normal 'System.IO.putStr', but decodes the input using an
--   encoding.
putStr :: (Encoding e,?enc :: e) => String -> IO ()
putStr = hPutStr stdout

-- | Like the normal 'System.IO.putStrLn', but decodes the input using an
--   encoding.
putStrLn :: (Encoding e,?enc :: e) => String -> IO ()
putStrLn = hPutStrLn stdout

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

-- | Like the normal 'System.IO.hPutStrLn', but decodes the input using an
--   encoding.
hPutStrLn :: (Encoding e,?enc :: e) => Handle -> String -> IO ()
hPutStrLn h str = do
    LBS.hPut h (encodeLazyByteString ?enc str)
    LBS.hPut h (encodeLazyByteString ?enc "\n")

-- | Like the normal 'System.IO.print', but decodes the input using an
--   encoding.
print :: (Encoding e,Show a,?enc :: e) => a -> IO ()
print = hPrint stdout

-- | Like the normal 'System.IO.hPrint', but decodes the input using an
--   encoding.
hPrint :: (Encoding e,Show a,?enc :: e) => Handle -> a -> IO ()
hPrint h x = hPutStrLn h (show x)

-- | Like the normal 'System.IO.readFile', but decodes the input using an
--   encoding.
readFile :: (Encoding e,?enc :: e) => FilePath -> IO String
readFile fn = LBS.readFile fn >>= return.(decodeLazyByteString ?enc)

-- | Like the normal 'System.IO.writeFile', but decodes the input using an
--   encoding.
writeFile :: (Encoding e,?enc :: e) => FilePath -> String -> IO ()
writeFile fn str = LBS.writeFile fn $ encodeLazyByteString ?enc str

-- | Like the normal 'System.IO.appendFile', but decodes the input using an
--   encoding.
appendFile :: (Encoding e,?enc :: e) => FilePath -> String -> IO ()
appendFile fn str = LBS.appendFile fn $ encodeLazyByteString ?enc str

-- | Like the normal 'System.IO.getChar', but decodes the input using an
--   encoding.
getChar :: (Encoding e,?enc :: e) => IO Char
getChar = hGetChar stdin

-- | Like the normal 'System.IO.hGetChar', but decodes the input using an
--   encoding.
hGetChar :: (Encoding e,?enc :: e) => Handle -> IO Char
hGetChar h = runReaderT (decodeChar ?enc) h

-- | Like the normal 'System.IO.getLine', but decodes the input using an
--   encoding.
getLine :: (Encoding e,?enc :: e) => IO String
getLine = hGetLine stdin

-- | Like the normal 'System.IO.hGetLine', but decodes the input using an
--   encoding.
hGetLine :: (Encoding e,?enc :: e) => Handle -> IO String
hGetLine h = do
  line <- BS.hGetLine h
  return $ decodeStrictByteString ?enc line

-- | Like the normal 'System.IO.putChar', but decodes the input using an
--   encoding.
putChar :: (Encoding e,?enc :: e) => Char -> IO ()
putChar = hPutChar stdout

-- | Like the normal 'System.IO.hPutChar', but decodes the input using an
--   encoding.
hPutChar :: (Encoding e,?enc :: e) => Handle -> Char -> IO ()
hPutChar h c = runReaderT (encodeChar ?enc c) h

-- | Like the normal 'System.IO.interact', but decodes the input using an
--   encoding.
interact :: (Encoding e,?enc :: e) => (String -> String) -> IO ()
interact f = do
  line <- hGetLine stdin
  hPutStrLn stdout (f line)

#ifdef SYSTEM_ENCODING
foreign import ccall "system_encoding.h get_system_encoding"
    get_system_encoding :: IO CString
#endif

-- | Returns the encoding used on the current system. Currently only supported
-- on Linux-alikes.
getSystemEncoding :: IO DynEncoding
getSystemEncoding = do
#ifdef SYSTEM_ENCODING
    enc <- get_system_encoding
    str <- peekCString enc
    return $ encodingFromString str
#else
    error "getSystemEncoding is not supported on this platform"
#endif