-----------------------------------------------------------------------------
-- |
-- Module      :  System.UTF8IO
-- Copyright   :  (c) Péter Diviánszky 2008
-- License     :  BSD3-style (see LICENSE)
-- 
-- Maintainer:    divip@aszt.inf.elte.hu
-- Stability   :  alpha
-- Portability :  portable
--
-- "System.UTF8IO" defines the same entities as "System.IO" but with UTF8 text I/O operations.
--
-- "System.UTF8IO" re-exports "System.IO.UTF8" (utf8-string package) and "System.IO" but hides the duplicate definitions (in favor of "System.IO.UTF8").

module System.UTF8IO
    ( module System.IO
    , module System.IO.UTF8
    -- * Functions not defined in "System.IO.UTF8"
    , putChar
    , getChar
    , hPutChar
    , hGetChar
    , hLookAhead
    , hPrint
    , interact
    ) where

import Codec.Binary.UTF8.String (decodeString)

import Data.Bits ((.&.))

import System.IO.UTF8

import System.IO hiding 
    ( print
    , putStr
    , putStrLn
    , getLine
    , readLn
    , readFile
    , writeFile
    , appendFile
    , getContents
    , putChar
    , getChar
    , hGetLine
    , hGetContents
    , hPutStr
    , hPutStrLn
    , hPutChar
    , hGetChar
    , hLookAhead
    , hPrint
    , openBinaryFile
    , withBinaryFile
    , interact
    )

import qualified System.IO

import Prelude hiding
    ( print
    , putStr
    , putStrLn
    , getLine
    , readLn
    , readFile
    , writeFile
    , appendFile
    , getContents
    , putChar
    , getChar
    , interact
    )

-- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the file or channel managed by @hdl@. 
-- Characters may be buffered if buffering is enabled for @hdl@. 
--
-- Note: The implementation of 'hPutChar' is not as efficient as it could be.

hPutChar    :: Handle -> Char -> IO ()
hPutChar h c = hPutStr h [c]

-- | Computation 'hGetChar' @hdl@ reads a character from the file or channel 
-- managed by 'hdl', blocking until a character is available.
--
-- Note: The implementation of 'hGetChar' is not as efficient as it could be.

hGetChar    :: Handle -> IO Char
hGetChar h  = do     
    c <- System.IO.hGetChar h
    s <- getBytes [c] (estimated_size c)
    return $ head $ decodeString $ reverse s   -- may have faster implementation
 where
    estimated_size c
      | c < toEnum 0xc0  = 0
      | c < toEnum 0xe0  = 1
      | c < toEnum 0xf0  = 2
      | c < toEnum 0xf8  = 3
      | c < toEnum 0xfc  = 4
      | c < toEnum 0xfe  = 5
      | otherwise        = 0

    getBytes :: String -> Int -> IO String
    getBytes acc 0 = return acc
    getBytes acc n = do
        eof <- hIsEOF h
        if eof 
            then return acc
            else do
                c <- System.IO.hLookAhead h
                if fromEnum c .&. 0xc0 == 0x80
                    then do
                        System.IO.hGetChar h
                        getBytes (c: acc) (n-1)
                    else return acc

-- | Computation 'hLookAhead' @hdl@ returns the next character from the handle 
-- without removing it from the input buffer, blocking until a character is available.
--
-- Note: 'hLookAhead' is not implemented; it halts with a run-time error.

hLookAhead  :: Handle -> IO Char
hLookAhead  = error "System.UTF8IO.hLookAhead: Not implemented"

-- | Write a character to the standard output device
-- (same as 'hPutChar' 'stdout').
--
-- Note: The implementation of 'putChar' is not as efficient as it could be.

putChar     :: Char -> IO ()
putChar c   =  hPutChar stdout c

-- | Read a character from the standard input device
-- (same as 'hGetChar' 'stdin').
--
-- Note: The implementation of 'getChar' is not as efficient as it could be.

getChar     :: IO Char
getChar     =  hGetChar stdin

-- | Computation 'hPrint' @hdl t@ writes the UTF8 string representation of @t@
-- to the file or channel managed by @hdl@ and appends a newline
-- (same as 'hPutStrLn' @hdl .@ 'show' @t@).
--
-- Note: 'hPrint' has the same behaviour as @System.IO.hPrint@ because 'show' always produces an ASCII string.

hPrint		:: Show a => Handle -> a -> IO ()
hPrint hdl 	=  hPutStrLn hdl . show

-- | UTF8 variant of interact.

interact  :: (String -> String) -> IO ()
interact f = getContents >>= putStr . f