{-# LANGUAGE DeriveDataTypeable #-}
{- | Implements the japanese character encoding ISO 2022-JP.
     See http://tools.ietf.org/html/rfc1468 for reference.
 -}
module Data.Encoding.ISO2022JP where

import Data.Typeable

import Data.Encoding.Base
import Data.Encoding.Exception
import Data.Encoding.ByteSource
import Data.Encoding.ISO2022
import Data.Encoding.ASCII
import Data.Encoding.JISX0201
import Data.Encoding.JISX0208

import Control.Throws

data ISO2022JP = ISO2022JP deriving (ISO2022JP -> ISO2022JP -> Bool
(ISO2022JP -> ISO2022JP -> Bool)
-> (ISO2022JP -> ISO2022JP -> Bool) -> Eq ISO2022JP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ISO2022JP -> ISO2022JP -> Bool
$c/= :: ISO2022JP -> ISO2022JP -> Bool
== :: ISO2022JP -> ISO2022JP -> Bool
$c== :: ISO2022JP -> ISO2022JP -> Bool
Eq,Int -> ISO2022JP -> ShowS
[ISO2022JP] -> ShowS
ISO2022JP -> String
(Int -> ISO2022JP -> ShowS)
-> (ISO2022JP -> String)
-> ([ISO2022JP] -> ShowS)
-> Show ISO2022JP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ISO2022JP] -> ShowS
$cshowList :: [ISO2022JP] -> ShowS
show :: ISO2022JP -> String
$cshow :: ISO2022JP -> String
showsPrec :: Int -> ISO2022JP -> ShowS
$cshowsPrec :: Int -> ISO2022JP -> ShowS
Show,Typeable)

instance Encoding ISO2022JP where
    encodeChar :: forall (m :: * -> *). ByteSink m => ISO2022JP -> Char -> m ()
encodeChar = ISO2022JP -> Char -> m ()
forall e (m :: * -> *).
(ISO2022 e, ByteSink m) =>
e -> Char -> m ()
encodeCharISO2022
    decodeChar :: forall (m :: * -> *). ByteSource m => ISO2022JP -> m Char
decodeChar = ISO2022JP -> m Char
forall e (m :: * -> *). (ISO2022 e, ByteSource m) => e -> m Char
decodeCharISO2022
    encode :: forall (m :: * -> *). ByteSink m => ISO2022JP -> String -> m ()
encode = ISO2022JP -> String -> m ()
forall e (m :: * -> *).
(ISO2022 e, ByteSink m) =>
e -> String -> m ()
encodeISO2022
    decode :: forall (m :: * -> *). ByteSource m => ISO2022JP -> m String
decode = ISO2022JP -> m String
forall e (m :: * -> *). (ISO2022 e, ByteSource m) => e -> m String
decodeISO2022
    encodeable :: ISO2022JP -> Char -> Bool
encodeable ISO2022JP
_ Char
c = ASCII -> Char -> Bool
forall enc. Encoding enc => enc -> Char -> Bool
encodeable ASCII
ASCII Char
c Bool -> Bool -> Bool
|| JISX0201 -> Char -> Bool
forall enc. Encoding enc => enc -> Char -> Bool
encodeable JISX0201
JISX0201 Char
c Bool -> Bool -> Bool
|| JISX0208 -> Char -> Bool
forall enc. Encoding enc => enc -> Char -> Bool
encodeable JISX0208
JISX0208 Char
c

instance ISO2022 ISO2022JP where
    readEscape :: forall (m :: * -> *).
ByteSource m =>
ISO2022JP -> m (Maybe DynEncoding)
readEscape ISO2022JP
_ = m (Maybe DynEncoding) -> m (Maybe DynEncoding)
forall (m :: * -> *) a. ByteSource m => m (Maybe a) -> m (Maybe a)
fetchAhead (m (Maybe DynEncoding) -> m (Maybe DynEncoding))
-> m (Maybe DynEncoding) -> m (Maybe DynEncoding)
forall a b. (a -> b) -> a -> b
$ do
      Word8
w <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
27
        then (do
               Word8
w2 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
               Word8
w3 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
               case Word8
w2 of
                 Word8
40 -> case Word8
w3 of
                        Word8
66 -> Maybe DynEncoding -> m (Maybe DynEncoding)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DynEncoding -> m (Maybe DynEncoding))
-> Maybe DynEncoding -> m (Maybe DynEncoding)
forall a b. (a -> b) -> a -> b
$ DynEncoding -> Maybe DynEncoding
forall a. a -> Maybe a
Just (DynEncoding -> Maybe DynEncoding)
-> DynEncoding -> Maybe DynEncoding
forall a b. (a -> b) -> a -> b
$ ASCII -> DynEncoding
forall enc.
(Encoding enc, Eq enc, Typeable enc, Show enc) =>
enc -> DynEncoding
DynEncoding ASCII
ASCII
                        Word8
74 -> Maybe DynEncoding -> m (Maybe DynEncoding)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DynEncoding -> m (Maybe DynEncoding))
-> Maybe DynEncoding -> m (Maybe DynEncoding)
forall a b. (a -> b) -> a -> b
$ DynEncoding -> Maybe DynEncoding
forall a. a -> Maybe a
Just (DynEncoding -> Maybe DynEncoding)
-> DynEncoding -> Maybe DynEncoding
forall a b. (a -> b) -> a -> b
$ JISX0201 -> DynEncoding
forall enc.
(Encoding enc, Eq enc, Typeable enc, Show enc) =>
enc -> DynEncoding
DynEncoding JISX0201
JISX0201
                        Word8
_ -> DecodingException -> m (Maybe DynEncoding)
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException (Word8 -> DecodingException
IllegalCharacter Word8
w3)
                 Word8
36 -> case Word8
w3 of
                        Word8
64 -> Maybe DynEncoding -> m (Maybe DynEncoding)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DynEncoding -> m (Maybe DynEncoding))
-> Maybe DynEncoding -> m (Maybe DynEncoding)
forall a b. (a -> b) -> a -> b
$ DynEncoding -> Maybe DynEncoding
forall a. a -> Maybe a
Just (DynEncoding -> Maybe DynEncoding)
-> DynEncoding -> Maybe DynEncoding
forall a b. (a -> b) -> a -> b
$ JISX0208 -> DynEncoding
forall enc.
(Encoding enc, Eq enc, Typeable enc, Show enc) =>
enc -> DynEncoding
DynEncoding JISX0208
JISX0208 -- XXX: this actually has to be the 1978 version of the standard... too bad I can't find it
                        Word8
66 -> Maybe DynEncoding -> m (Maybe DynEncoding)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DynEncoding -> m (Maybe DynEncoding))
-> Maybe DynEncoding -> m (Maybe DynEncoding)
forall a b. (a -> b) -> a -> b
$ DynEncoding -> Maybe DynEncoding
forall a. a -> Maybe a
Just (DynEncoding -> Maybe DynEncoding)
-> DynEncoding -> Maybe DynEncoding
forall a b. (a -> b) -> a -> b
$ JISX0208 -> DynEncoding
forall enc.
(Encoding enc, Eq enc, Typeable enc, Show enc) =>
enc -> DynEncoding
DynEncoding JISX0208
JISX0208
                        Word8
_ -> DecodingException -> m (Maybe DynEncoding)
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException (Word8 -> DecodingException
IllegalCharacter Word8
w3)
                 Word8
_ -> DecodingException -> m (Maybe DynEncoding)
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException (Word8 -> DecodingException
IllegalCharacter Word8
w2)
             )
        else Maybe DynEncoding -> m (Maybe DynEncoding)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DynEncoding
forall a. Maybe a
Nothing
    encodingForChar :: ISO2022JP -> Char -> Maybe (DynEncoding, [Word8])
encodingForChar ISO2022JP
_ Char
c
        | ASCII -> Char -> Bool
forall enc. Encoding enc => enc -> Char -> Bool
encodeable ASCII
ASCII Char
c = (DynEncoding, [Word8]) -> Maybe (DynEncoding, [Word8])
forall a. a -> Maybe a
Just (ASCII -> DynEncoding
forall enc.
(Encoding enc, Eq enc, Typeable enc, Show enc) =>
enc -> DynEncoding
DynEncoding ASCII
ASCII,[Word8
27,Word8
40,Word8
66])
        | JISX0201 -> Char -> Bool
forall enc. Encoding enc => enc -> Char -> Bool
encodeable JISX0201
JISX0201 Char
c = (DynEncoding, [Word8]) -> Maybe (DynEncoding, [Word8])
forall a. a -> Maybe a
Just (JISX0201 -> DynEncoding
forall enc.
(Encoding enc, Eq enc, Typeable enc, Show enc) =>
enc -> DynEncoding
DynEncoding JISX0201
JISX0201,[Word8
27,Word8
40,Word8
74])
        | JISX0208 -> Char -> Bool
forall enc. Encoding enc => enc -> Char -> Bool
encodeable JISX0208
JISX0208 Char
c = (DynEncoding, [Word8]) -> Maybe (DynEncoding, [Word8])
forall a. a -> Maybe a
Just (JISX0208 -> DynEncoding
forall enc.
(Encoding enc, Eq enc, Typeable enc, Show enc) =>
enc -> DynEncoding
DynEncoding JISX0208
JISX0208,[Word8
27,Word8
36,Word8
66])
        | Bool
otherwise  = Maybe (DynEncoding, [Word8])
forall a. Maybe a
Nothing