{- | This module provides a wrapper for I/O encoding for the "old" and "new" ways.
The "old" way uses iconv+utf8-string.
The "new" way uses the base library's built-in encoding functionality.
For the "new" way, we require ghc>=7.4.1 due to GHC bug #5436.

This module exports opaque Encoder/Decoder datatypes, along with several helper
functions that wrap the old/new ways.
-}
module System.Console.Haskeline.Backend.Posix.Encoder (
        ExternalHandle(eH),
        externalHandle,
        withCodingMode,
        openInCodingMode,
        ) where

import Control.Monad.Catch (MonadMask, bracket)
import System.IO
import System.Console.Haskeline.Monads

import GHC.IO.Encoding (initLocaleEncoding)
import System.Console.Haskeline.Recover


-- | An 'ExternalHandle' is a handle which may or may not be in the correct
-- mode for Unicode input/output.  When the POSIX backend opens a file
-- (or /dev/tty) it sets it permanently to the correct mode.
-- However, when it uses an existing handle like stdin, it only temporarily
-- sets it to the correct mode (e.g., for the duration of getInputLine);
-- otherwise, we might interfere with the rest of the Haskell program.
--
-- The correct mode is the locale encoding, set to transliterate errors (rather
-- than crashing, as is the base library's default).  See Recover.hs.
data ExternalHandle = ExternalHandle
                        { ExternalHandle -> ExternalMode
externalMode :: ExternalMode
                        , ExternalHandle -> Handle
eH :: Handle
                        }

data ExternalMode = CodingMode | OtherMode

externalHandle :: Handle -> ExternalHandle
externalHandle :: Handle -> ExternalHandle
externalHandle = ExternalMode -> Handle -> ExternalHandle
ExternalHandle ExternalMode
OtherMode

-- | Use to ensure that an external handle is in the correct mode
-- for the duration of the given action.
withCodingMode :: (MonadIO m, MonadMask m) => ExternalHandle -> m a -> m a
withCodingMode :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
ExternalHandle -> m a -> m a
withCodingMode ExternalHandle {externalMode :: ExternalHandle -> ExternalMode
externalMode=ExternalMode
CodingMode} m a
act = m a
act
withCodingMode (ExternalHandle ExternalMode
OtherMode Handle
h) m a
act = do
    m (Maybe TextEncoding)
-> (Maybe TextEncoding -> m ())
-> (Maybe TextEncoding -> m a)
-> m a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (IO (Maybe TextEncoding) -> m (Maybe TextEncoding)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TextEncoding) -> m (Maybe TextEncoding))
-> IO (Maybe TextEncoding) -> m (Maybe TextEncoding)
forall a b. (a -> b) -> a -> b
$ Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
h)
            (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (Maybe TextEncoding -> IO ()) -> Maybe TextEncoding -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Maybe TextEncoding -> IO ()
hSetBinOrEncoding Handle
h)
            ((Maybe TextEncoding -> m a) -> m a)
-> (Maybe TextEncoding -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ m a -> Maybe TextEncoding -> m a
forall a b. a -> b -> a
const (m a -> Maybe TextEncoding -> m a)
-> m a -> Maybe TextEncoding -> m a
forall a b. (a -> b) -> a -> b
$ do
                IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
haskelineEncoding
                m a
act

hSetBinOrEncoding :: Handle -> Maybe TextEncoding -> IO ()
hSetBinOrEncoding :: Handle -> Maybe TextEncoding -> IO ()
hSetBinOrEncoding Handle
h Maybe TextEncoding
Nothing = Handle -> Bool -> IO ()
hSetBinaryMode Handle
h Bool
True
hSetBinOrEncoding Handle
h (Just TextEncoding
enc) = Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
enc

haskelineEncoding :: TextEncoding
haskelineEncoding :: TextEncoding
haskelineEncoding = TextEncoding -> TextEncoding
transliterateFailure TextEncoding
initLocaleEncoding

-- Open a file and permanently set it to the correct mode.
openInCodingMode :: FilePath -> IOMode -> IO ExternalHandle
openInCodingMode :: FilePath -> IOMode -> IO ExternalHandle
openInCodingMode FilePath
path IOMode
iomode = do
    Handle
h <- FilePath -> IOMode -> IO Handle
openFile FilePath
path IOMode
iomode
    Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
haskelineEncoding
    ExternalHandle -> IO ExternalHandle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExternalHandle -> IO ExternalHandle)
-> ExternalHandle -> IO ExternalHandle
forall a b. (a -> b) -> a -> b
$ ExternalMode -> Handle -> ExternalHandle
ExternalHandle ExternalMode
CodingMode Handle
h