{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Trustworthy #-}

{-|
Description:    Character translation functions to and from the ISO-2022-JP encoding scheme.

Copyright:      (c) 2020 Sam May
License:        MPL-2.0
Maintainer:     ag.eitilt@gmail.com

Stability:      experimental
Portability:    portable
-}
module Web.Willow.Common.Encoding.Iso2022Jp
    ( Iso2022JpMode ( .. )
      -- * Decoder
    , decoder
    , Iso2022JpDecoderState ( .. )
    , defaultIso2022JpDecoderState
    , Iso2022TextBuilder
      -- * Encoder
    , encoder
    , Iso2022JpEncoderState ( .. )
    , defaultIso2022JpEncoderState
    , Iso2022BinaryBuilder
    ) where


import qualified Control.Applicative as A
import qualified Control.Monad as N

import qualified Data.ByteString as BS
import qualified Data.ByteString.Short as BS.SH
import qualified Data.Char as C
import qualified Data.Maybe as Y
import qualified Data.Vector as V

import Control.Applicative ( (<|>) )
import Data.Functor ( ($>) )
import Data.Vector ( (!?) )

import Web.Willow.Common.Encoding.Common
import Web.Willow.Common.Parser
import Web.Willow.Common.Parser.Switch

import Web.Willow.Common.Encoding.EucJp
    ( decodeIndex0208, encodeIndex0208 )


-- | 'Iso2022Jp' is a "sticky-shift" encoding, where the escape sequences
-- change the behaviour of every following character until the next escape; it
-- therefore needs to track which character mode it is currently in.
-- Additionally, escape sequences need to be separated by at least one real
-- character, and while that could be ensured with pure code, we may as well
-- add it to the state data being tracked anyway.
data Iso2022JpDecoderState = Iso2022JpDecoderState
    { Iso2022JpDecoderState -> Iso2022JpMode
decoderMode :: Iso2022JpMode
        -- ^ The set of character mappings currently "loaded" into the
        -- algorithm.
    , Iso2022JpDecoderState -> Bool
decoderErrorOnEscape :: Bool
        -- ^ Whether an output character is /required/ ('True') or if an escape
        -- sequence is allowed ('False').
    }
  deriving ( Iso2022JpDecoderState -> Iso2022JpDecoderState -> Bool
(Iso2022JpDecoderState -> Iso2022JpDecoderState -> Bool)
-> (Iso2022JpDecoderState -> Iso2022JpDecoderState -> Bool)
-> Eq Iso2022JpDecoderState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Iso2022JpDecoderState -> Iso2022JpDecoderState -> Bool
$c/= :: Iso2022JpDecoderState -> Iso2022JpDecoderState -> Bool
== :: Iso2022JpDecoderState -> Iso2022JpDecoderState -> Bool
$c== :: Iso2022JpDecoderState -> Iso2022JpDecoderState -> Bool
Eq, Int -> Iso2022JpDecoderState -> ShowS
[Iso2022JpDecoderState] -> ShowS
Iso2022JpDecoderState -> String
(Int -> Iso2022JpDecoderState -> ShowS)
-> (Iso2022JpDecoderState -> String)
-> ([Iso2022JpDecoderState] -> ShowS)
-> Show Iso2022JpDecoderState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Iso2022JpDecoderState] -> ShowS
$cshowList :: [Iso2022JpDecoderState] -> ShowS
show :: Iso2022JpDecoderState -> String
$cshow :: Iso2022JpDecoderState -> String
showsPrec :: Int -> Iso2022JpDecoderState -> ShowS
$cshowsPrec :: Int -> Iso2022JpDecoderState -> ShowS
Show, ReadPrec [Iso2022JpDecoderState]
ReadPrec Iso2022JpDecoderState
Int -> ReadS Iso2022JpDecoderState
ReadS [Iso2022JpDecoderState]
(Int -> ReadS Iso2022JpDecoderState)
-> ReadS [Iso2022JpDecoderState]
-> ReadPrec Iso2022JpDecoderState
-> ReadPrec [Iso2022JpDecoderState]
-> Read Iso2022JpDecoderState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Iso2022JpDecoderState]
$creadListPrec :: ReadPrec [Iso2022JpDecoderState]
readPrec :: ReadPrec Iso2022JpDecoderState
$creadPrec :: ReadPrec Iso2022JpDecoderState
readList :: ReadS [Iso2022JpDecoderState]
$creadList :: ReadS [Iso2022JpDecoderState]
readsPrec :: Int -> ReadS Iso2022JpDecoderState
$creadsPrec :: Int -> ReadS Iso2022JpDecoderState
Read )

-- | 'Iso2022Jp' is a "sticky-shift" encoding, where the escape sequences
-- change the behaviour of every following character until the next escape; it
-- therefore needs to track which character mode it is currently in.
newtype Iso2022JpEncoderState = Iso2022JpEncoderState
    { Iso2022JpEncoderState -> Iso2022JpMode
encoderMode :: Iso2022JpMode
        -- ^ The set of character mappings currently "loaded" into the
        -- algorithm.
    }
  deriving ( Iso2022JpEncoderState -> Iso2022JpEncoderState -> Bool
(Iso2022JpEncoderState -> Iso2022JpEncoderState -> Bool)
-> (Iso2022JpEncoderState -> Iso2022JpEncoderState -> Bool)
-> Eq Iso2022JpEncoderState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Iso2022JpEncoderState -> Iso2022JpEncoderState -> Bool
$c/= :: Iso2022JpEncoderState -> Iso2022JpEncoderState -> Bool
== :: Iso2022JpEncoderState -> Iso2022JpEncoderState -> Bool
$c== :: Iso2022JpEncoderState -> Iso2022JpEncoderState -> Bool
Eq, Int -> Iso2022JpEncoderState -> ShowS
[Iso2022JpEncoderState] -> ShowS
Iso2022JpEncoderState -> String
(Int -> Iso2022JpEncoderState -> ShowS)
-> (Iso2022JpEncoderState -> String)
-> ([Iso2022JpEncoderState] -> ShowS)
-> Show Iso2022JpEncoderState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Iso2022JpEncoderState] -> ShowS
$cshowList :: [Iso2022JpEncoderState] -> ShowS
show :: Iso2022JpEncoderState -> String
$cshow :: Iso2022JpEncoderState -> String
showsPrec :: Int -> Iso2022JpEncoderState -> ShowS
$cshowsPrec :: Int -> Iso2022JpEncoderState -> ShowS
Show, ReadPrec [Iso2022JpEncoderState]
ReadPrec Iso2022JpEncoderState
Int -> ReadS Iso2022JpEncoderState
ReadS [Iso2022JpEncoderState]
(Int -> ReadS Iso2022JpEncoderState)
-> ReadS [Iso2022JpEncoderState]
-> ReadPrec Iso2022JpEncoderState
-> ReadPrec [Iso2022JpEncoderState]
-> Read Iso2022JpEncoderState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Iso2022JpEncoderState]
$creadListPrec :: ReadPrec [Iso2022JpEncoderState]
readPrec :: ReadPrec Iso2022JpEncoderState
$creadPrec :: ReadPrec Iso2022JpEncoderState
readList :: ReadS [Iso2022JpEncoderState]
$creadList :: ReadS [Iso2022JpEncoderState]
readsPrec :: Int -> ReadS Iso2022JpEncoderState
$creadsPrec :: Int -> ReadS Iso2022JpEncoderState
Read )

-- | The various 'Char'-byte mappings which may be loaded by the 'Iso2022Jp'
-- algorithms.
data Iso2022JpMode
    = Ascii
        -- ^ The basic, seven-bit ASCII set.
    | Roman
        -- ^ As 'Ascii', but replacing backslash (@\'\\'@) with yen (@\'¥'@)
        -- and tilde (@'~'@) with overline (@\'‾'@).
    | Katakana
        -- ^ The standard block of halfwidth katakana located in Unicode
        -- between @\\xFF61@ and @\\xFF9F@.
        -- 
        -- Note that this has identical behaviour to 'Multibyte' when passed to
        -- 'encoder'; halfwidth katakana are instead encoded as fullwidth.
    | Multibyte
        -- ^ An encoding of the full jis0208 set into a seven-bit-compatible
        -- transmission scheme.
  deriving ( Iso2022JpMode -> Iso2022JpMode -> Bool
(Iso2022JpMode -> Iso2022JpMode -> Bool)
-> (Iso2022JpMode -> Iso2022JpMode -> Bool) -> Eq Iso2022JpMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Iso2022JpMode -> Iso2022JpMode -> Bool
$c/= :: Iso2022JpMode -> Iso2022JpMode -> Bool
== :: Iso2022JpMode -> Iso2022JpMode -> Bool
$c== :: Iso2022JpMode -> Iso2022JpMode -> Bool
Eq, Eq Iso2022JpMode
Eq Iso2022JpMode
-> (Iso2022JpMode -> Iso2022JpMode -> Ordering)
-> (Iso2022JpMode -> Iso2022JpMode -> Bool)
-> (Iso2022JpMode -> Iso2022JpMode -> Bool)
-> (Iso2022JpMode -> Iso2022JpMode -> Bool)
-> (Iso2022JpMode -> Iso2022JpMode -> Bool)
-> (Iso2022JpMode -> Iso2022JpMode -> Iso2022JpMode)
-> (Iso2022JpMode -> Iso2022JpMode -> Iso2022JpMode)
-> Ord Iso2022JpMode
Iso2022JpMode -> Iso2022JpMode -> Bool
Iso2022JpMode -> Iso2022JpMode -> Ordering
Iso2022JpMode -> Iso2022JpMode -> Iso2022JpMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Iso2022JpMode -> Iso2022JpMode -> Iso2022JpMode
$cmin :: Iso2022JpMode -> Iso2022JpMode -> Iso2022JpMode
max :: Iso2022JpMode -> Iso2022JpMode -> Iso2022JpMode
$cmax :: Iso2022JpMode -> Iso2022JpMode -> Iso2022JpMode
>= :: Iso2022JpMode -> Iso2022JpMode -> Bool
$c>= :: Iso2022JpMode -> Iso2022JpMode -> Bool
> :: Iso2022JpMode -> Iso2022JpMode -> Bool
$c> :: Iso2022JpMode -> Iso2022JpMode -> Bool
<= :: Iso2022JpMode -> Iso2022JpMode -> Bool
$c<= :: Iso2022JpMode -> Iso2022JpMode -> Bool
< :: Iso2022JpMode -> Iso2022JpMode -> Bool
$c< :: Iso2022JpMode -> Iso2022JpMode -> Bool
compare :: Iso2022JpMode -> Iso2022JpMode -> Ordering
$ccompare :: Iso2022JpMode -> Iso2022JpMode -> Ordering
$cp1Ord :: Eq Iso2022JpMode
Ord, Iso2022JpMode
Iso2022JpMode -> Iso2022JpMode -> Bounded Iso2022JpMode
forall a. a -> a -> Bounded a
maxBound :: Iso2022JpMode
$cmaxBound :: Iso2022JpMode
minBound :: Iso2022JpMode
$cminBound :: Iso2022JpMode
Bounded, Int -> Iso2022JpMode
Iso2022JpMode -> Int
Iso2022JpMode -> [Iso2022JpMode]
Iso2022JpMode -> Iso2022JpMode
Iso2022JpMode -> Iso2022JpMode -> [Iso2022JpMode]
Iso2022JpMode -> Iso2022JpMode -> Iso2022JpMode -> [Iso2022JpMode]
(Iso2022JpMode -> Iso2022JpMode)
-> (Iso2022JpMode -> Iso2022JpMode)
-> (Int -> Iso2022JpMode)
-> (Iso2022JpMode -> Int)
-> (Iso2022JpMode -> [Iso2022JpMode])
-> (Iso2022JpMode -> Iso2022JpMode -> [Iso2022JpMode])
-> (Iso2022JpMode -> Iso2022JpMode -> [Iso2022JpMode])
-> (Iso2022JpMode
    -> Iso2022JpMode -> Iso2022JpMode -> [Iso2022JpMode])
-> Enum Iso2022JpMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Iso2022JpMode -> Iso2022JpMode -> Iso2022JpMode -> [Iso2022JpMode]
$cenumFromThenTo :: Iso2022JpMode -> Iso2022JpMode -> Iso2022JpMode -> [Iso2022JpMode]
enumFromTo :: Iso2022JpMode -> Iso2022JpMode -> [Iso2022JpMode]
$cenumFromTo :: Iso2022JpMode -> Iso2022JpMode -> [Iso2022JpMode]
enumFromThen :: Iso2022JpMode -> Iso2022JpMode -> [Iso2022JpMode]
$cenumFromThen :: Iso2022JpMode -> Iso2022JpMode -> [Iso2022JpMode]
enumFrom :: Iso2022JpMode -> [Iso2022JpMode]
$cenumFrom :: Iso2022JpMode -> [Iso2022JpMode]
fromEnum :: Iso2022JpMode -> Int
$cfromEnum :: Iso2022JpMode -> Int
toEnum :: Int -> Iso2022JpMode
$ctoEnum :: Int -> Iso2022JpMode
pred :: Iso2022JpMode -> Iso2022JpMode
$cpred :: Iso2022JpMode -> Iso2022JpMode
succ :: Iso2022JpMode -> Iso2022JpMode
$csucc :: Iso2022JpMode -> Iso2022JpMode
Enum, Int -> Iso2022JpMode -> ShowS
[Iso2022JpMode] -> ShowS
Iso2022JpMode -> String
(Int -> Iso2022JpMode -> ShowS)
-> (Iso2022JpMode -> String)
-> ([Iso2022JpMode] -> ShowS)
-> Show Iso2022JpMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Iso2022JpMode] -> ShowS
$cshowList :: [Iso2022JpMode] -> ShowS
show :: Iso2022JpMode -> String
$cshow :: Iso2022JpMode -> String
showsPrec :: Int -> Iso2022JpMode -> ShowS
$cshowsPrec :: Int -> Iso2022JpMode -> ShowS
Show, ReadPrec [Iso2022JpMode]
ReadPrec Iso2022JpMode
Int -> ReadS Iso2022JpMode
ReadS [Iso2022JpMode]
(Int -> ReadS Iso2022JpMode)
-> ReadS [Iso2022JpMode]
-> ReadPrec Iso2022JpMode
-> ReadPrec [Iso2022JpMode]
-> Read Iso2022JpMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Iso2022JpMode]
$creadListPrec :: ReadPrec [Iso2022JpMode]
readPrec :: ReadPrec Iso2022JpMode
$creadPrec :: ReadPrec Iso2022JpMode
readList :: ReadS [Iso2022JpMode]
$creadList :: ReadS [Iso2022JpMode]
readsPrec :: Int -> ReadS Iso2022JpMode
$creadsPrec :: Int -> ReadS Iso2022JpMode
Read )

-- | The default initial state to kickstart the 'Iso2022Jp' decoder.
defaultIso2022JpDecoderState :: Iso2022JpDecoderState
defaultIso2022JpDecoderState :: Iso2022JpDecoderState
defaultIso2022JpDecoderState = Iso2022JpDecoderState :: Iso2022JpMode -> Bool -> Iso2022JpDecoderState
Iso2022JpDecoderState
    { decoderMode :: Iso2022JpMode
decoderMode = Iso2022JpMode
Ascii
    , decoderErrorOnEscape :: Bool
decoderErrorOnEscape = Bool
False
    }

-- | The default initial state to kickstart the 'Iso2022Jp' encoder.
defaultIso2022JpEncoderState :: Iso2022JpEncoderState
defaultIso2022JpEncoderState :: Iso2022JpEncoderState
defaultIso2022JpEncoderState = Iso2022JpEncoderState :: Iso2022JpMode -> Iso2022JpEncoderState
Iso2022JpEncoderState
    { encoderMode :: Iso2022JpMode
encoderMode = Iso2022JpMode
Ascii
    }


-- | Shorthand type for parser combinators written for the 'Iso2022Jp' decoding
-- algorithm.
type Iso2022TextBuilder = StateTextBuilder Iso2022JpDecoderState

-- | __Encoding:__
--      @[ISO-2022-JP decoder]
--      (https://encoding.spec.whatwg.org/#iso-2022-jp-decoder)@
-- 
-- Decodes a 'Char' from a binary stream encoded with the 'Iso2022Jp' encoding
-- scheme, or returns 'Left' if the stream starts with an invalid byte
-- sequence.
decoder :: Iso2022TextBuilder
decoder :: Iso2022TextBuilder
decoder = do
    Iso2022JpDecoderState
state <- StateDecoder Iso2022JpDecoderState Iso2022JpDecoderState
forall state. StateDecoder state state
getDecoderState
    DecoderError String
char <- case Iso2022JpDecoderState -> Iso2022JpMode
decoderMode Iso2022JpDecoderState
state of
        Iso2022JpMode
Ascii -> Iso2022TextBuilder
decoderAscii
        Iso2022JpMode
Roman -> Iso2022TextBuilder
decoderRoman
        Iso2022JpMode
Katakana -> Iso2022TextBuilder
decoderKatakana
        Iso2022JpMode
Multibyte -> Iso2022TextBuilder
decoderMultibyte
    Bool
-> StateT
     (Confidence, Iso2022JpDecoderState) (Parser ByteString) ()
-> StateT
     (Confidence, Iso2022JpDecoderState) (Parser ByteString) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
N.unless (DecoderError String
char DecoderError String -> DecoderError String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> DecoderError String
forall a b. b -> Either a b
Right String
"") StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString) ()
clearDecoderOutput
    DecoderError String -> Iso2022TextBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return DecoderError String
char

-- | __Encoding:__
--      @[ISO-2022-JP decoder]
--      (https://encoding.spec.whatwg.org/#iso-2022-jp-decoder)@
--      @ASCII@ case
-- 
-- Process the head of a binary stream according to the 'Ascii' character set.
decoderAscii :: Iso2022TextBuilder
decoderAscii :: Iso2022TextBuilder
decoderAscii = StateT
  (Confidence, Iso2022JpDecoderState) (Parser ByteString) Word8
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT
  (Confidence, Iso2022JpDecoderState) (Parser ByteString) Word8
-> (Word8 -> Iso2022TextBuilder) -> Iso2022TextBuilder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SwitchCase
   Word8
   (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
   (DecoderError String)]
-> Word8 -> Iso2022TextBuilder
forall (m :: * -> *) test out.
Alternative m =>
[SwitchCase test m out] -> test -> m out
switch
    [ (Word8 -> Bool)
-> (Word8 -> Iso2022TextBuilder)
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If (Word8 -> [Word8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8
0x0E, Word8
0x0F]) Word8 -> Iso2022TextBuilder
forall state. Word8 -> StateTextBuilder state
decoderFailure1
    , (Word8 -> Bool)
-> Iso2022TextBuilder
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
toByte Char
'\ESC') Iso2022TextBuilder
decoderEscape
    , (Word8 -> Bool)
-> (Word8 -> Iso2022TextBuilder)
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If Word8 -> Bool
isAsciiByte Word8 -> Iso2022TextBuilder
forall state. Word8 -> StateTextBuilder state
toUnicode1
    , (Word8 -> Iso2022TextBuilder)
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> m out) -> SwitchCase test m out
Else Word8 -> Iso2022TextBuilder
forall state. Word8 -> StateTextBuilder state
decoderFailure1
    ]

-- | __Encoding:__
--      @[ISO-2022-JP decoder]
--      (https://encoding.spec.whatwg.org/#iso-2022-jp-decoder)@
--      @Roman@ case
-- 
-- Process the head of a binary stream according to the 'Roman' character set.
decoderRoman :: Iso2022TextBuilder
decoderRoman :: Iso2022TextBuilder
decoderRoman = StateT
  (Confidence, Iso2022JpDecoderState) (Parser ByteString) Word8
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT
  (Confidence, Iso2022JpDecoderState) (Parser ByteString) Word8
-> (Word8 -> Iso2022TextBuilder) -> Iso2022TextBuilder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SwitchCase
   Word8
   (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
   (DecoderError String)]
-> Word8 -> Iso2022TextBuilder
forall (m :: * -> *) test out.
Alternative m =>
[SwitchCase test m out] -> test -> m out
switch
    [ (Word8 -> Bool)
-> (Word8 -> Iso2022TextBuilder)
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If (Word8 -> [Word8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8
0x0E, Word8
0x0F]) Word8 -> Iso2022TextBuilder
forall state. Word8 -> StateTextBuilder state
decoderFailure1
    , (Word8 -> Bool)
-> Iso2022TextBuilder
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
toByte Char
'\ESC') Iso2022TextBuilder
decoderEscape
    , (Word8 -> Bool)
-> Iso2022TextBuilder
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
toByte Char
'\\') (Iso2022TextBuilder
 -> SwitchCase
      Word8
      (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
      (DecoderError String))
-> Iso2022TextBuilder
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall a b. (a -> b) -> a -> b
$ [Word8] -> Char -> Iso2022TextBuilder
forall state. [Word8] -> Char -> StateTextBuilder state
emit [Char -> Word8
toByte Char
'\\'] Char
'\x00A5'
    , (Word8 -> Bool)
-> Iso2022TextBuilder
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
toByte Char
'~') (Iso2022TextBuilder
 -> SwitchCase
      Word8
      (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
      (DecoderError String))
-> Iso2022TextBuilder
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall a b. (a -> b) -> a -> b
$ [Word8] -> Char -> Iso2022TextBuilder
forall state. [Word8] -> Char -> StateTextBuilder state
emit [Char -> Word8
toByte Char
'~'] Char
'\x203E'
    , (Word8 -> Bool)
-> (Word8 -> Iso2022TextBuilder)
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If Word8 -> Bool
isAsciiByte Word8 -> Iso2022TextBuilder
forall state. Word8 -> StateTextBuilder state
toUnicode1
    , (Word8 -> Iso2022TextBuilder)
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> m out) -> SwitchCase test m out
Else Word8 -> Iso2022TextBuilder
forall state. Word8 -> StateTextBuilder state
decoderFailure1
    ]


-- | __Encoding:__
--      @[ISO-2022-JP decoder]
--      (https://encoding.spec.whatwg.org/#iso-2022-jp-decoder)@
--      @katakana@ case
-- 
-- Process the head of a binary stream according to the 'Katakana' character
-- set.
decoderKatakana :: Iso2022TextBuilder
decoderKatakana :: Iso2022TextBuilder
decoderKatakana = StateT
  (Confidence, Iso2022JpDecoderState) (Parser ByteString) Word8
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT
  (Confidence, Iso2022JpDecoderState) (Parser ByteString) Word8
-> (Word8 -> Iso2022TextBuilder) -> Iso2022TextBuilder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SwitchCase
   Word8
   (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
   (DecoderError String)]
-> Word8 -> Iso2022TextBuilder
forall (m :: * -> *) test out.
Alternative m =>
[SwitchCase test m out] -> test -> m out
switch
    [ (Word8 -> Bool)
-> Iso2022TextBuilder
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
toByte Char
'\ESC') Iso2022TextBuilder
decoderEscape
    , (Word8 -> Bool)
-> (Word8 -> Iso2022TextBuilder)
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If (Word8 -> Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> a -> Bool
range Word8
0x21 Word8
0x5F) ((Word8 -> Iso2022TextBuilder)
 -> SwitchCase
      Word8
      (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
      (DecoderError String))
-> (Word8 -> Iso2022TextBuilder)
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall a b. (a -> b) -> a -> b
$ \Word8
b -> [Word8] -> Char -> Iso2022TextBuilder
forall state. [Word8] -> Char -> StateTextBuilder state
emit [Word8
b] (Char -> Iso2022TextBuilder)
-> (Int -> Char) -> Int -> Iso2022TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Int -> Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xFF40) (Int -> Iso2022TextBuilder) -> Int -> Iso2022TextBuilder
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b
    , (Word8 -> Iso2022TextBuilder)
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> m out) -> SwitchCase test m out
Else Word8 -> Iso2022TextBuilder
forall state. Word8 -> StateTextBuilder state
decoderFailure1
    ]

-- | __Encoding:__
--      @[ISO-2022-JP decoder]
--      (https://encoding.spec.whatwg.org/#iso-2022-jp-decoder)@
--      @lead byte@ and @trail byte@ cases
-- 
-- Process the head of a binary stream according to the 'Multibyte' character
-- set.
decoderMultibyte :: Iso2022TextBuilder
decoderMultibyte :: Iso2022TextBuilder
decoderMultibyte = StateT
  (Confidence, Iso2022JpDecoderState) (Parser ByteString) Word8
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT
  (Confidence, Iso2022JpDecoderState) (Parser ByteString) Word8
-> (Word8 -> Iso2022TextBuilder) -> Iso2022TextBuilder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SwitchCase
   Word8
   (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
   (DecoderError String)]
-> Word8 -> Iso2022TextBuilder
forall (m :: * -> *) test out.
Alternative m =>
[SwitchCase test m out] -> test -> m out
switch
    [ (Word8 -> Bool)
-> Iso2022TextBuilder
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
toByte Char
'\ESC') Iso2022TextBuilder
decoderEscape
    , (Word8 -> Bool)
-> (Word8 -> Iso2022TextBuilder)
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If (Word8 -> Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> a -> Bool
range Word8
0x21 Word8
0x7E) ((Word8 -> Iso2022TextBuilder)
 -> SwitchCase
      Word8
      (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
      (DecoderError String))
-> (Word8 -> Iso2022TextBuilder)
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall a b. (a -> b) -> a -> b
$ \Word8
b -> Word8 -> Iso2022TextBuilder
forall state. Word8 -> StateTextBuilder state
decoderMultibyte' Word8
b Iso2022TextBuilder -> Iso2022TextBuilder -> Iso2022TextBuilder
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word8 -> Iso2022TextBuilder
forall state. Word8 -> StateTextBuilder state
decoderFailure1 Word8
b
    , (Word8 -> Iso2022TextBuilder)
-> SwitchCase
     Word8
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> m out) -> SwitchCase test m out
Else Word8 -> Iso2022TextBuilder
forall state. Word8 -> StateTextBuilder state
decoderFailure1
    ]
  where decoderMultibyte' :: Word8
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
decoderMultibyte' Word8
lead = StateT (Confidence, state) (Parser ByteString) Word8
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT (Confidence, state) (Parser ByteString) Word8
-> (Word8
    -> StateT
         (Confidence, state) (Parser ByteString) (DecoderError String))
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SwitchCase
   Word8
   (StateT (Confidence, state) (Parser ByteString))
   (DecoderError String)]
-> Word8
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
forall (m :: * -> *) test out.
Alternative m =>
[SwitchCase test m out] -> test -> m out
switch
            [ (Word8 -> Bool)
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
-> SwitchCase
     Word8
     (StateT (Confidence, state) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
toByte Char
'\ESC') (StateT
   (Confidence, state) (Parser ByteString) (DecoderError String)
 -> SwitchCase
      Word8
      (StateT (Confidence, state) (Parser ByteString))
      (DecoderError String))
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
-> SwitchCase
     Word8
     (StateT (Confidence, state) (Parser ByteString))
     (DecoderError String)
forall a b. (a -> b) -> a -> b
$ Word8 -> StateT (Confidence, state) (Parser ByteString) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push (Char -> Word8
toByte Char
'\ESC') StateT (Confidence, state) (Parser ByteString) ()
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word8
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
forall state. Word8 -> StateTextBuilder state
decoderFailure1 Word8
lead
            , (Word8 -> Bool)
-> (Word8
    -> StateT
         (Confidence, state) (Parser ByteString) (DecoderError String))
-> SwitchCase
     Word8
     (StateT (Confidence, state) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If (Word8 -> Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> a -> Bool
range Word8
0x21 Word8
0x7E) ((Word8
  -> StateT
       (Confidence, state) (Parser ByteString) (DecoderError String))
 -> SwitchCase
      Word8
      (StateT (Confidence, state) (Parser ByteString))
      (DecoderError String))
-> (Word8
    -> StateT
         (Confidence, state) (Parser ByteString) (DecoderError String))
-> SwitchCase
     Word8
     (StateT (Confidence, state) (Parser ByteString))
     (DecoderError String)
forall a b. (a -> b) -> a -> b
$ \Word8
second ->
                StateT
  (Confidence, state) (Parser ByteString) (DecoderError String)
-> (Char
    -> StateT
         (Confidence, state) (Parser ByteString) (DecoderError String))
-> Maybe Char
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Word8]
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
forall state. [Word8] -> StateTextBuilder state
decoderFailure [Word8
lead, Word8
second]) ([Word8]
-> Char
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
forall state. [Word8] -> Char -> StateTextBuilder state
emit [Word8
lead, Word8
second]) (Maybe Char
 -> StateT
      (Confidence, state) (Parser ByteString) (DecoderError String))
-> (Word -> Maybe Char)
-> Word
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Maybe Char
decodeIndex0208 (Word
 -> StateT
      (Confidence, state) (Parser ByteString) (DecoderError String))
-> Word
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
forall a b. (a -> b) -> a -> b
$
                (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
lead Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
0x21) Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
94 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
second Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
0x21
            , (Word8
 -> StateT
      (Confidence, state) (Parser ByteString) (DecoderError String))
-> SwitchCase
     Word8
     (StateT (Confidence, state) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> m out) -> SwitchCase test m out
Else ((Word8
  -> StateT
       (Confidence, state) (Parser ByteString) (DecoderError String))
 -> SwitchCase
      Word8
      (StateT (Confidence, state) (Parser ByteString))
      (DecoderError String))
-> (Word8
    -> StateT
         (Confidence, state) (Parser ByteString) (DecoderError String))
-> SwitchCase
     Word8
     (StateT (Confidence, state) (Parser ByteString))
     (DecoderError String)
forall a b. (a -> b) -> a -> b
$ Word8
-> Word8
-> StateT
     (Confidence, state) (Parser ByteString) (DecoderError String)
forall state. Word8 -> Word8 -> StateTextBuilder state
decoderFailure2 Word8
lead
            ]

-- | __Encoding:__
--      @[ISO-2022-JP decoder]
--      (https://encoding.spec.whatwg.org/#iso-2022-jp-decoder)@
--      @Escape start@ and @Escape@ cases
-- 
-- Process the head of a binary stream as an escape sequence transitioning from
-- one character set to another.
decoderEscape :: Iso2022TextBuilder
decoderEscape :: Iso2022TextBuilder
decoderEscape = do
    Bool
err <- Iso2022JpDecoderState -> Bool
decoderErrorOnEscape (Iso2022JpDecoderState -> Bool)
-> StateDecoder Iso2022JpDecoderState Iso2022JpDecoderState
-> StateT
     (Confidence, Iso2022JpDecoderState) (Parser ByteString) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateDecoder Iso2022JpDecoderState Iso2022JpDecoderState
forall state. StateDecoder state state
getDecoderState
    Word
-> StateT
     (Confidence, Iso2022JpDecoderState) (Parser ByteString) ByteString
forall (m :: * -> *) stream token.
MonadParser m stream token =>
Word -> m stream
nextChunk Word
2 StateT
  (Confidence, Iso2022JpDecoderState) (Parser ByteString) ByteString
-> (ByteString -> Iso2022TextBuilder) -> Iso2022TextBuilder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SwitchCase
   ByteString
   (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
   (DecoderError String)]
-> ByteString -> Iso2022TextBuilder
forall (m :: * -> *) test out.
Alternative m =>
[SwitchCase test m out] -> test -> m out
switch
        [ (ByteString -> Bool)
-> (ByteString -> Iso2022TextBuilder)
-> SwitchCase
     ByteString
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"$@") ((ByteString -> Iso2022TextBuilder)
 -> SwitchCase
      ByteString
      (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
      (DecoderError String))
-> (ByteString -> Iso2022TextBuilder)
-> SwitchCase
     ByteString
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall a b. (a -> b) -> a -> b
$ Bool -> Iso2022JpMode -> ByteString -> Iso2022TextBuilder
switchMode Bool
err Iso2022JpMode
Multibyte
        , (ByteString -> Bool)
-> (ByteString -> Iso2022TextBuilder)
-> SwitchCase
     ByteString
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"$B") ((ByteString -> Iso2022TextBuilder)
 -> SwitchCase
      ByteString
      (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
      (DecoderError String))
-> (ByteString -> Iso2022TextBuilder)
-> SwitchCase
     ByteString
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall a b. (a -> b) -> a -> b
$ Bool -> Iso2022JpMode -> ByteString -> Iso2022TextBuilder
switchMode Bool
err Iso2022JpMode
Multibyte
        , (ByteString -> Bool)
-> (ByteString -> Iso2022TextBuilder)
-> SwitchCase
     ByteString
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"(B") ((ByteString -> Iso2022TextBuilder)
 -> SwitchCase
      ByteString
      (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
      (DecoderError String))
-> (ByteString -> Iso2022TextBuilder)
-> SwitchCase
     ByteString
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall a b. (a -> b) -> a -> b
$ Bool -> Iso2022JpMode -> ByteString -> Iso2022TextBuilder
switchMode Bool
err Iso2022JpMode
Ascii
        , (ByteString -> Bool)
-> (ByteString -> Iso2022TextBuilder)
-> SwitchCase
     ByteString
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"(J") ((ByteString -> Iso2022TextBuilder)
 -> SwitchCase
      ByteString
      (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
      (DecoderError String))
-> (ByteString -> Iso2022TextBuilder)
-> SwitchCase
     ByteString
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall a b. (a -> b) -> a -> b
$ Bool -> Iso2022JpMode -> ByteString -> Iso2022TextBuilder
switchMode Bool
err Iso2022JpMode
Roman
        , (ByteString -> Bool)
-> (ByteString -> Iso2022TextBuilder)
-> SwitchCase
     ByteString
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"(I") ((ByteString -> Iso2022TextBuilder)
 -> SwitchCase
      ByteString
      (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
      (DecoderError String))
-> (ByteString -> Iso2022TextBuilder)
-> SwitchCase
     ByteString
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall a b. (a -> b) -> a -> b
$ Bool -> Iso2022JpMode -> ByteString -> Iso2022TextBuilder
switchMode Bool
err Iso2022JpMode
Katakana
        , (ByteString -> Iso2022TextBuilder)
-> SwitchCase
     ByteString
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall test (m :: * -> *) out.
(test -> m out) -> SwitchCase test m out
Else ((ByteString -> Iso2022TextBuilder)
 -> SwitchCase
      ByteString
      (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
      (DecoderError String))
-> (ByteString -> Iso2022TextBuilder)
-> SwitchCase
     ByteString
     (StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString))
     (DecoderError String)
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> do
            ByteString
-> StateT
     (Confidence, Iso2022JpDecoderState) (Parser ByteString) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
stream -> m ()
pushChunk ByteString
bs
            StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString) ()
clearDecoderOutput
            Word8 -> Iso2022TextBuilder
forall state. Word8 -> StateTextBuilder state
decoderFailure1 (Word8 -> Iso2022TextBuilder) -> Word8 -> Iso2022TextBuilder
forall a b. (a -> b) -> a -> b
$ Char -> Word8
toByte Char
'\ESC'
        ]
  where switchMode :: Bool -> Iso2022JpMode -> ByteString -> Iso2022TextBuilder
switchMode Bool
err Iso2022JpMode
mode ByteString
bs = do
            (Iso2022JpDecoderState -> Iso2022JpDecoderState)
-> StateT
     (Confidence, Iso2022JpDecoderState) (Parser ByteString) ()
forall state. (state -> state) -> StateDecoder state ()
modifyDecoderState ((Iso2022JpDecoderState -> Iso2022JpDecoderState)
 -> StateT
      (Confidence, Iso2022JpDecoderState) (Parser ByteString) ())
-> (Iso2022JpDecoderState -> Iso2022JpDecoderState)
-> StateT
     (Confidence, Iso2022JpDecoderState) (Parser ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Iso2022JpDecoderState
state -> Iso2022JpDecoderState
state
                { decoderMode :: Iso2022JpMode
decoderMode = Iso2022JpMode
mode
                , decoderErrorOnEscape :: Bool
decoderErrorOnEscape = Bool
True
                }
            if Bool
err
                then [Word8] -> Iso2022TextBuilder
forall state. [Word8] -> StateTextBuilder state
decoderFailure ([Word8] -> Iso2022TextBuilder) -> [Word8] -> Iso2022TextBuilder
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
bs
                else DecoderError String -> Iso2022TextBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return (DecoderError String -> Iso2022TextBuilder)
-> DecoderError String -> Iso2022TextBuilder
forall a b. (a -> b) -> a -> b
$ String -> DecoderError String
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Mark that some character or error output has occurred, and so allow an
-- escape sequence without complaint.
clearDecoderOutput :: StateDecoder Iso2022JpDecoderState ()
clearDecoderOutput :: StateT (Confidence, Iso2022JpDecoderState) (Parser ByteString) ()
clearDecoderOutput = (Iso2022JpDecoderState -> Iso2022JpDecoderState)
-> StateT
     (Confidence, Iso2022JpDecoderState) (Parser ByteString) ()
forall state. (state -> state) -> StateDecoder state ()
modifyDecoderState ((Iso2022JpDecoderState -> Iso2022JpDecoderState)
 -> StateT
      (Confidence, Iso2022JpDecoderState) (Parser ByteString) ())
-> (Iso2022JpDecoderState -> Iso2022JpDecoderState)
-> StateT
     (Confidence, Iso2022JpDecoderState) (Parser ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Iso2022JpDecoderState
s -> Iso2022JpDecoderState
s
    { decoderErrorOnEscape :: Bool
decoderErrorOnEscape = Bool
False
    }


-- | Shorthand type for parser combinators written for the 'Iso2022Jp' encoding
-- algorithm.
type Iso2022BinaryBuilder = StateBinaryBuilder Iso2022JpEncoderState

-- | __Encoding:__
--      @[ISO-2022-JP encoder]
--      (https://encoding.spec.whatwg.org/#iso-2022-jp-encoder)@
-- 
-- Encode the first 'Char' in a string according to the 'Iso2022Jp' encoding
-- scheme, or return that same character if that scheme doesn't define a binary
-- representation for it.
encoder :: Iso2022BinaryBuilder
encoder :: Iso2022BinaryBuilder
encoder = do
    Iso2022JpEncoderState
state <- StateEncoder Iso2022JpEncoderState Iso2022JpEncoderState
forall state. StateEncoder state state
getEncoderState
    Maybe (EncoderError ShortByteString)
bs' <- Iso2022BinaryBuilder
-> StateT
     Iso2022JpEncoderState
     (Parser Text)
     (Maybe (EncoderError ShortByteString))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
A.optional (Iso2022BinaryBuilder
 -> StateT
      Iso2022JpEncoderState
      (Parser Text)
      (Maybe (EncoderError ShortByteString)))
-> Iso2022BinaryBuilder
-> StateT
     Iso2022JpEncoderState
     (Parser Text)
     (Maybe (EncoderError ShortByteString))
forall a b. (a -> b) -> a -> b
$ case Iso2022JpEncoderState -> Iso2022JpMode
encoderMode Iso2022JpEncoderState
state of
        Iso2022JpMode
Ascii -> Iso2022BinaryBuilder
encoderAscii
        Iso2022JpMode
Roman -> Iso2022BinaryBuilder
encoderRoman
        Iso2022JpMode
Katakana -> Bool -> Iso2022BinaryBuilder
encoderMultibyte Bool
True
        Iso2022JpMode
Multibyte -> Bool -> Iso2022BinaryBuilder
encoderMultibyte Bool
True
    case Maybe (EncoderError ShortByteString)
bs' of
        Maybe (EncoderError ShortByteString)
Nothing | Iso2022JpEncoderState -> Iso2022JpMode
encoderMode Iso2022JpEncoderState
state Iso2022JpMode -> Iso2022JpMode -> Bool
forall a. Eq a => a -> a -> Bool
== Iso2022JpMode
Ascii -> Iso2022BinaryBuilder
forall (f :: * -> *) a. Alternative f => f a
A.empty
        Maybe (EncoderError ShortByteString)
Nothing -> Iso2022JpMode -> Iso2022BinaryBuilder
setEncoderMode Iso2022JpMode
Ascii
        Just EncoderError ShortByteString
bs -> EncoderError ShortByteString -> Iso2022BinaryBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return EncoderError ShortByteString
bs

-- | __Encoding:__
--      @[ISO-2022-JP encoder]
--      (https://encoding.spec.whatwg.org/#iso-2022-jp-encoder)@
--      steps 3-4, 7-12
-- 
-- Process the head of a 'Data.Text.Lazy.Text' string starting in the 'Ascii'
-- character set, insert the appropriate escape sequence if a mode transition
-- is required, or return 'Left' if all else fails.
encoderAscii :: Iso2022BinaryBuilder
encoderAscii :: Iso2022BinaryBuilder
encoderAscii = StateT Iso2022JpEncoderState (Parser Text) Char
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT Iso2022JpEncoderState (Parser Text) Char
-> (Char -> Iso2022BinaryBuilder) -> Iso2022BinaryBuilder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> [SwitchCase
   Char
   (StateT Iso2022JpEncoderState (Parser Text))
   (EncoderError ShortByteString)]
-> Char -> Iso2022BinaryBuilder
forall (m :: * -> *) test out.
Alternative m =>
[SwitchCase test m out] -> test -> m out
switch
    [ (Char -> Bool)
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\SO', Char
'\SI', Char
'\ESC']) (Iso2022BinaryBuilder
 -> SwitchCase
      Char
      (StateT Iso2022JpEncoderState (Parser Text))
      (EncoderError ShortByteString))
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall a b. (a -> b) -> a -> b
$ Char -> Iso2022BinaryBuilder
forall state out. Char -> StateEncoder state (EncoderError out)
encoderFailure Char
'\xFFFD'
    , (Char -> Bool)
-> (Char -> Iso2022BinaryBuilder)
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If Char -> Bool
C.isAscii Char -> Iso2022BinaryBuilder
forall state. Char -> StateBinaryBuilder state
fromAscii
    , (Char -> Bool)
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\x00A5', Char
'\x203E']) (Iso2022BinaryBuilder
 -> SwitchCase
      Char
      (StateT Iso2022JpEncoderState (Parser Text))
      (EncoderError ShortByteString))
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall a b. (a -> b) -> a -> b
$ Char -> StateT Iso2022JpEncoderState (Parser Text) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push Char
c StateT Iso2022JpEncoderState (Parser Text) ()
-> Iso2022BinaryBuilder -> Iso2022BinaryBuilder
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Iso2022JpMode -> Iso2022BinaryBuilder
setEncoderMode Iso2022JpMode
Roman
    ] Char
c Iso2022BinaryBuilder
-> Iso2022BinaryBuilder -> Iso2022BinaryBuilder
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Iso2022BinaryBuilder
encoderFallback Char
c

-- | __Encoding:__
--      @[ISO-2022-JP encoder]
--      (https://encoding.spec.whatwg.org/#iso-2022-jp-encoder)@
--      steps 5-6, 8-12
-- 
-- Process the head of a 'Data.Text.Lazy.Text' string starting in the 'Roman'
-- character set, insert the appropriate escape sequence if a mode transition
-- is required, or return 'Left' if all else fails.
encoderRoman :: Iso2022BinaryBuilder
encoderRoman :: Iso2022BinaryBuilder
encoderRoman = StateT Iso2022JpEncoderState (Parser Text) Char
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT Iso2022JpEncoderState (Parser Text) Char
-> (Char -> Iso2022BinaryBuilder) -> Iso2022BinaryBuilder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> [SwitchCase
   Char
   (StateT Iso2022JpEncoderState (Parser Text))
   (EncoderError ShortByteString)]
-> Char -> Iso2022BinaryBuilder
forall (m :: * -> *) test out.
Alternative m =>
[SwitchCase test m out] -> test -> m out
switch
    [ (Char -> Bool)
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\SO', Char
'\SI', Char
'\ESC']) (Iso2022BinaryBuilder
 -> SwitchCase
      Char
      (StateT Iso2022JpEncoderState (Parser Text))
      (EncoderError ShortByteString))
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall a b. (a -> b) -> a -> b
$ Char -> Iso2022BinaryBuilder
forall state out. Char -> StateEncoder state (EncoderError out)
encoderFailure Char
'\xFFFD'
    , (Char -> Bool)
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\\', Char
'~']) (Iso2022BinaryBuilder
 -> SwitchCase
      Char
      (StateT Iso2022JpEncoderState (Parser Text))
      (EncoderError ShortByteString))
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall a b. (a -> b) -> a -> b
$ Char -> StateT Iso2022JpEncoderState (Parser Text) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push Char
c StateT Iso2022JpEncoderState (Parser Text) ()
-> Iso2022BinaryBuilder -> Iso2022BinaryBuilder
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Iso2022JpMode -> Iso2022BinaryBuilder
setEncoderMode Iso2022JpMode
Ascii
    , (Char -> Bool)
-> (Char -> Iso2022BinaryBuilder)
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If Char -> Bool
C.isAscii Char -> Iso2022BinaryBuilder
forall state. Char -> StateBinaryBuilder state
fromAscii
    , (Char -> Bool)
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x00A5') (Iso2022BinaryBuilder
 -> SwitchCase
      Char
      (StateT Iso2022JpEncoderState (Parser Text))
      (EncoderError ShortByteString))
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall a b. (a -> b) -> a -> b
$ EncoderError ShortByteString -> Iso2022BinaryBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return (ShortByteString -> EncoderError ShortByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShortByteString
"\\")
    , (Char -> Bool)
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x203E') (Iso2022BinaryBuilder
 -> SwitchCase
      Char
      (StateT Iso2022JpEncoderState (Parser Text))
      (EncoderError ShortByteString))
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall a b. (a -> b) -> a -> b
$ EncoderError ShortByteString -> Iso2022BinaryBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return (ShortByteString -> EncoderError ShortByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShortByteString
"~")
    ] Char
c Iso2022BinaryBuilder
-> Iso2022BinaryBuilder -> Iso2022BinaryBuilder
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Iso2022BinaryBuilder
encoderFallback Char
c

-- | __Encoding:__
--      @[ISO-2022-JP encoder]
--      (https://encoding.spec.whatwg.org/#iso-2022-jp-encoder)@
--      steps 8-12
-- 
-- Attempt to parse the character in (specifically) the 'Multibyte' mode, and
-- return 'Left' if that fails.
encoderFallback :: Char -> Iso2022BinaryBuilder
encoderFallback :: Char -> Iso2022BinaryBuilder
encoderFallback Char
c = Iso2022BinaryBuilder
-> StateT
     Iso2022JpEncoderState
     (Parser Text)
     (Maybe (EncoderError ShortByteString))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
A.optional Iso2022BinaryBuilder
encoderFallback' StateT
  Iso2022JpEncoderState
  (Parser Text)
  (Maybe (EncoderError ShortByteString))
-> (Maybe (EncoderError ShortByteString) -> Iso2022BinaryBuilder)
-> Iso2022BinaryBuilder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Iso2022BinaryBuilder
-> (EncoderError ShortByteString -> Iso2022BinaryBuilder)
-> Maybe (EncoderError ShortByteString)
-> Iso2022BinaryBuilder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Char -> Iso2022BinaryBuilder
forall state out. Char -> StateEncoder state (EncoderError out)
encoderFailure Char
c) EncoderError ShortByteString -> Iso2022BinaryBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return
  where encoderFallback' :: Iso2022BinaryBuilder
encoderFallback' = do
            Char -> StateT Iso2022JpEncoderState (Parser Text) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push Char
c
            EncoderError ShortByteString
escape <- Iso2022JpMode -> Iso2022BinaryBuilder
setEncoderMode Iso2022JpMode
Multibyte
            EncoderError ShortByteString
_ <- Iso2022BinaryBuilder -> Iso2022BinaryBuilder
forall (m :: * -> *) stream token out.
MonadParser m stream token =>
m out -> m out
lookAhead (Iso2022BinaryBuilder -> Iso2022BinaryBuilder)
-> Iso2022BinaryBuilder -> Iso2022BinaryBuilder
forall a b. (a -> b) -> a -> b
$ Bool -> Iso2022BinaryBuilder
encoderMultibyte Bool
False
            EncoderError ShortByteString -> Iso2022BinaryBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return EncoderError ShortByteString
escape

-- | __Encoding:__
--      @[ISO-2022-JP encoder]
--      (https://encoding.spec.whatwg.org/#iso-2022-jp-encoder)@
--      steps 6-15
-- 
-- Process the head of a 'Data.Text.Lazy.Text' string starting in the
-- 'Multibyte' character set, insert the appropriate escape sequence if a mode
-- transition is required, or return 'Left' if all else fails.
encoderMultibyte
    :: Bool
        -- ^ Whether the encoder is allowed to switch to another mode, or
        -- whether it's being used as a fallback and so must remain in
        -- 'Multibyte'.
    -> Iso2022BinaryBuilder
encoderMultibyte :: Bool -> Iso2022BinaryBuilder
encoderMultibyte Bool
allowRecovery = StateT Iso2022JpEncoderState (Parser Text) Char
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT Iso2022JpEncoderState (Parser Text) Char
-> (Char -> Iso2022BinaryBuilder) -> Iso2022BinaryBuilder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> [SwitchCase
   Char
   (StateT Iso2022JpEncoderState (Parser Text))
   (EncoderError ShortByteString)]
-> Char -> Iso2022BinaryBuilder
forall (m :: * -> *) test out.
Alternative m =>
[SwitchCase test m out] -> test -> m out
switch
    [ (Char -> Bool)
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ Char -> Bool
C.isAscii (Iso2022BinaryBuilder
 -> SwitchCase
      Char
      (StateT Iso2022JpEncoderState (Parser Text))
      (EncoderError ShortByteString))
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall a b. (a -> b) -> a -> b
$ Char -> StateT Iso2022JpEncoderState (Parser Text) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push Char
c StateT Iso2022JpEncoderState (Parser Text) ()
-> Iso2022BinaryBuilder -> Iso2022BinaryBuilder
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Iso2022JpMode -> Iso2022BinaryBuilder
setEncoderMode' Iso2022JpMode
Ascii
    , (Char -> Bool)
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\x00A5', Char
'\x203E']) (Iso2022BinaryBuilder
 -> SwitchCase
      Char
      (StateT Iso2022JpEncoderState (Parser Text))
      (EncoderError ShortByteString))
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall a b. (a -> b) -> a -> b
$ Char -> StateT Iso2022JpEncoderState (Parser Text) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push Char
c StateT Iso2022JpEncoderState (Parser Text) ()
-> Iso2022BinaryBuilder -> Iso2022BinaryBuilder
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Iso2022JpMode -> Iso2022BinaryBuilder
setEncoderMode' Iso2022JpMode
Roman
    , (Char -> Bool)
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall test (m :: * -> *) out.
(test -> Bool) -> m out -> SwitchCase test m out
If_ (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x2212') (Iso2022BinaryBuilder
 -> SwitchCase
      Char
      (StateT Iso2022JpEncoderState (Parser Text))
      (EncoderError ShortByteString))
-> Iso2022BinaryBuilder
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Word -> Iso2022BinaryBuilder
forall a. Integral a => Char -> Maybe a -> Iso2022BinaryBuilder
indexBytes Char
c (Char -> Maybe Word
encodeIndex0208 Char
'\xFF0D')
    , (Char -> Bool)
-> (Char -> Iso2022BinaryBuilder)
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If (Char -> Char -> Char -> Bool
forall a. Ord a => a -> a -> a -> Bool
range Char
'\xFF61' Char
'\xFF9F') ((Char -> Iso2022BinaryBuilder)
 -> SwitchCase
      Char
      (StateT Iso2022JpEncoderState (Parser Text))
      (EncoderError ShortByteString))
-> (Char -> Iso2022BinaryBuilder)
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Word -> Iso2022BinaryBuilder
forall a. Integral a => Char -> Maybe a -> Iso2022BinaryBuilder
indexBytes Char
c (Maybe Word -> Iso2022BinaryBuilder)
-> (Char -> Maybe Word) -> Char -> Iso2022BinaryBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Word
encodeIndex0208 (Char -> Maybe Word) -> (Char -> Char) -> Char -> Maybe Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
remapKatakana
    , (Char -> Iso2022BinaryBuilder)
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall test (m :: * -> *) out.
(test -> m out) -> SwitchCase test m out
Else ((Char -> Iso2022BinaryBuilder)
 -> SwitchCase
      Char
      (StateT Iso2022JpEncoderState (Parser Text))
      (EncoderError ShortByteString))
-> (Char -> Iso2022BinaryBuilder)
-> SwitchCase
     Char
     (StateT Iso2022JpEncoderState (Parser Text))
     (EncoderError ShortByteString)
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Word -> Iso2022BinaryBuilder
forall a. Integral a => Char -> Maybe a -> Iso2022BinaryBuilder
indexBytes Char
c (Maybe Word -> Iso2022BinaryBuilder)
-> (Char -> Maybe Word) -> Char -> Iso2022BinaryBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Word
encodeIndex0208
    ] Char
c
  where setEncoderMode' :: Iso2022JpMode -> Iso2022BinaryBuilder
setEncoderMode' Iso2022JpMode
s
            | Bool
allowRecovery = Iso2022JpMode -> Iso2022BinaryBuilder
setEncoderMode Iso2022JpMode
s
            | Bool
otherwise = Iso2022BinaryBuilder
forall (f :: * -> *) a. Alternative f => f a
A.empty
        indexBytes :: Char -> Maybe a -> Iso2022BinaryBuilder
indexBytes Char
c Maybe a
Nothing = do
            Iso2022JpEncoderState
state <- StateEncoder Iso2022JpEncoderState Iso2022JpEncoderState
forall state. StateEncoder state state
getEncoderState
            if Iso2022JpEncoderState -> Iso2022JpMode
encoderMode Iso2022JpEncoderState
state Iso2022JpMode -> [Iso2022JpMode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Iso2022JpMode
Katakana, Iso2022JpMode
Multibyte]
                then Char -> StateT Iso2022JpEncoderState (Parser Text) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push Char
c StateT Iso2022JpEncoderState (Parser Text) ()
-> Iso2022BinaryBuilder -> Iso2022BinaryBuilder
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Iso2022JpMode -> Iso2022BinaryBuilder
setEncoderMode' Iso2022JpMode
Ascii
                else Char -> Iso2022BinaryBuilder
forall state out. Char -> StateEncoder state (EncoderError out)
encoderFailure Char
c
        indexBytes Char
_ (Just a
code) = EncoderError ShortByteString -> Iso2022BinaryBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return (EncoderError ShortByteString -> Iso2022BinaryBuilder)
-> (ShortByteString -> EncoderError ShortByteString)
-> ShortByteString
-> Iso2022BinaryBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> EncoderError ShortByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShortByteString -> Iso2022BinaryBuilder)
-> ShortByteString -> Iso2022BinaryBuilder
forall a b. (a -> b) -> a -> b
$
            [Word8] -> ShortByteString
BS.SH.pack [a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
lead Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
0x21, a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
trail Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
0x21]
          where (a
lead, a
trail) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
code a
94


-- | Transition the encoder from one character set to another, emitting the
-- appropriate binary escape sequence.
setEncoderMode :: Iso2022JpMode -> Iso2022BinaryBuilder
setEncoderMode :: Iso2022JpMode -> Iso2022BinaryBuilder
setEncoderMode Iso2022JpMode
mode = (Iso2022JpEncoderState -> Iso2022JpEncoderState)
-> StateT Iso2022JpEncoderState (Parser Text) ()
forall state. (state -> state) -> StateEncoder state ()
modifyEncoderState Iso2022JpEncoderState -> Iso2022JpEncoderState
setEncoderMode' StateT Iso2022JpEncoderState (Parser Text) ()
-> EncoderError ShortByteString -> Iso2022BinaryBuilder
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ShortByteString -> EncoderError ShortByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShortByteString
esc
  where esc :: ShortByteString
esc = case Iso2022JpMode
mode of
            Iso2022JpMode
Ascii -> ShortByteString
"\ESC(B"
            Iso2022JpMode
Roman -> ShortByteString
"\ESC(J"
            Iso2022JpMode
Katakana -> ShortByteString
"\ESC$B"
            Iso2022JpMode
Multibyte -> ShortByteString
"\ESC$B"
        setEncoderMode' :: Iso2022JpEncoderState -> Iso2022JpEncoderState
setEncoderMode' Iso2022JpEncoderState
state = Iso2022JpEncoderState
state
            { encoderMode :: Iso2022JpMode
encoderMode = Iso2022JpMode
mode
            }


-- | __Encoding:__
--      @[ISO-2022-JP encoder]
--      (https://encoding.spec.whatwg.org/#iso-2022-jp-encoder)@
--      step 9
-- 
-- Expand halfwidth katakana into their (more appropriate) fullwidth forms.
remapKatakana :: Char -> Char
remapKatakana :: Char -> Char
remapKatakana Char
c = Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
Y.fromMaybe Char
'\xFFFD' (Maybe Char -> Char) -> Maybe Char -> Char
forall a b. (a -> b) -> a -> b
$ Vector Char
indexKatakana Vector Char -> Int -> Maybe Char
forall a. Vector a -> Int -> Maybe a
!? (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0xFF61)

-- | The mapping between halfwidth and fullwidth katakana, in an easily-indexed
-- structure.
indexKatakana :: V.Vector Char
indexKatakana :: Vector Char
indexKatakana = String -> Vector Char
forall a. [a] -> Vector a
V.fromList (String -> Vector Char)
-> ([(Word, Char)] -> String) -> [(Word, Char)] -> Vector Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word, Char) -> Char) -> [(Word, Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Word, Char) -> Char
forall a b. (a, b) -> b
snd ([(Word, Char)] -> Vector Char) -> [(Word, Char)] -> Vector Char
forall a b. (a -> b) -> a -> b
$ String -> [(Word, Char)]
loadIndex String
"iso-2022-jp-katakana"