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
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
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
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