module Data.Encoding.ISO2022 where

import Data.Encoding.Base
import Data.Encoding.ByteSource
import Data.Encoding.ByteSink
import Data.Encoding.Exception
import Data.Encoding.ASCII

import Data.Word
import Control.Throws

class ISO2022 e where
    readEscape :: ByteSource m => e -> m (Maybe DynEncoding)
    encodingForChar :: e -> Char -> Maybe (DynEncoding,[Word8])

encodeCharISO2022 :: (ISO2022 e,ByteSink m) => e -> Char -> m ()
encodeCharISO2022 :: forall e (m :: * -> *).
(ISO2022 e, ByteSink m) =>
e -> Char -> m ()
encodeCharISO2022 e
e Char
c = case e -> Char -> Maybe (DynEncoding, [Word8])
forall e. ISO2022 e => e -> Char -> Maybe (DynEncoding, [Word8])
encodingForChar e
e Char
c of
                          Maybe (DynEncoding, [Word8])
Nothing -> EncodingException -> m ()
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException (Char -> EncodingException
HasNoRepresentation Char
c)
                          Just (DynEncoding
enc,[Word8]
esc) -> do
                                            (Word8 -> m ()) -> [Word8] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> m ()
forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 [Word8]
esc
                                            DynEncoding -> Char -> m ()
forall enc (m :: * -> *).
(Encoding enc, ByteSink m) =>
enc -> Char -> m ()
encodeChar DynEncoding
enc Char
c

decodeCharISO2022 :: (ISO2022 e,ByteSource m) => e -> m Char
decodeCharISO2022 :: forall e (m :: * -> *). (ISO2022 e, ByteSource m) => e -> m Char
decodeCharISO2022 e
e = do
  Maybe DynEncoding
enc <- e -> m (Maybe DynEncoding)
forall e (m :: * -> *).
(ISO2022 e, ByteSource m) =>
e -> m (Maybe DynEncoding)
readEscape e
e
  case Maybe DynEncoding
enc of
    Maybe DynEncoding
Nothing -> ASCII -> m Char
forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m Char
decodeChar ASCII
ASCII
    Just DynEncoding
renc -> DynEncoding -> m Char
forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m Char
decodeChar DynEncoding
renc

encodeISO2022 :: (ISO2022 e,ByteSink m) => e -> String -> m ()
encodeISO2022 :: forall e (m :: * -> *).
(ISO2022 e, ByteSink m) =>
e -> String -> m ()
encodeISO2022 e
e = DynEncoding -> String -> m ()
forall {m :: * -> *}. ByteSink m => DynEncoding -> String -> m ()
encode' (ASCII -> DynEncoding
forall enc.
(Encoding enc, Eq enc, Typeable enc, Show enc) =>
enc -> DynEncoding
DynEncoding ASCII
ASCII)
    where
      encode' :: DynEncoding -> String -> m ()
encode' DynEncoding
_ [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      encode' DynEncoding
enc (Char
c:String
cs) = case e -> Char -> Maybe (DynEncoding, [Word8])
forall e. ISO2022 e => e -> Char -> Maybe (DynEncoding, [Word8])
encodingForChar e
e Char
c of
                             Maybe (DynEncoding, [Word8])
Nothing -> EncodingException -> m ()
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException (Char -> EncodingException
HasNoRepresentation Char
c)
                             Just (DynEncoding
nenc,[Word8]
esc)
                                  | DynEncoding
encDynEncoding -> DynEncoding -> Bool
forall a. Eq a => a -> a -> Bool
==DynEncoding
nenc -> do
                                                 DynEncoding -> Char -> m ()
forall enc (m :: * -> *).
(Encoding enc, ByteSink m) =>
enc -> Char -> m ()
encodeChar DynEncoding
enc Char
c
                                                 DynEncoding -> String -> m ()
encode' DynEncoding
enc String
cs
                                  | Bool
otherwise -> do
                                                 (Word8 -> m ()) -> [Word8] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> m ()
forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 [Word8]
esc
                                                 DynEncoding -> Char -> m ()
forall enc (m :: * -> *).
(Encoding enc, ByteSink m) =>
enc -> Char -> m ()
encodeChar DynEncoding
nenc Char
c
                                                 DynEncoding -> String -> m ()
encode' DynEncoding
nenc String
cs

decodeISO2022 :: (ISO2022 e,ByteSource m) => e -> m String
decodeISO2022 :: forall e (m :: * -> *). (ISO2022 e, ByteSource m) => e -> m String
decodeISO2022 e
e = DynEncoding -> m String
forall {m :: * -> *}. ByteSource m => DynEncoding -> m String
decode' (ASCII -> DynEncoding
forall enc.
(Encoding enc, Eq enc, Typeable enc, Show enc) =>
enc -> DynEncoding
DynEncoding ASCII
ASCII)
    where
      decode' :: DynEncoding -> m String
decode' DynEncoding
enc = do
        Bool
empty <- m Bool
forall (m :: * -> *). ByteSource m => m Bool
sourceEmpty
        if Bool
empty
          then String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return []
          else (do
                 Maybe DynEncoding
nenc <- e -> m (Maybe DynEncoding)
forall e (m :: * -> *).
(ISO2022 e, ByteSource m) =>
e -> m (Maybe DynEncoding)
readEscape e
e
                 case Maybe DynEncoding
nenc of
                   Just DynEncoding
renc -> DynEncoding -> m String
decode' DynEncoding
renc
                   Maybe DynEncoding
Nothing -> do
                             Char
c <- DynEncoding -> m Char
forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m Char
decodeChar DynEncoding
enc
                             String
cs <- DynEncoding -> m String
decode' DynEncoding
enc
                             String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)
               )