(original) (raw)

{-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, ExistentialQuantification #-} {-# OPTIONS_GHC -funbox-strict-fields #-}

module GHC.IO.Encoding.Types ( BufferCodec(..), TextEncoding(..), TextEncoder, TextDecoder, CodeBuffer, EncodeBuffer, DecodeBuffer, CodingProgress(..) ) where

import GHC.Base import GHC.Word import GHC.Show

import GHC.IO.Buffer

data BufferCodec from to state = BufferCodec { forall from to state. BufferCodec from to state -> CodeBuffer from to encode :: CodeBuffer from to,

forall from to state. BufferCodec from to state -> Buffer from -> Buffer to -> IO (Buffer from, Buffer to) recover :: Buffer from -> Buffer to -> IO (Buffer from, Buffer to),

forall from to state. BufferCodec from to state -> IO () close :: IO (),

forall from to state. BufferCodec from to state -> IO state getState :: IO state,

forall from to state. BufferCodec from to state -> state -> IO () setState :: state -> IO ()

}

type CodeBuffer from to = Buffer from -> Buffer to -> IO (CodingProgress, Buffer from, Buffer to) type DecodeBuffer = CodeBuffer Word8 Char type EncodeBuffer = CodeBuffer Char Word8

type TextDecoder state = BufferCodec Word8 CharBufElem state type TextEncoder state = BufferCodec CharBufElem Word8 state

data TextEncoding = forall dstate estate . TextEncoding { TextEncoding -> String textEncodingName :: String,

    ()

mkTextDecoder :: IO (TextDecoder dstate),

    ()

mkTextEncoder :: IO (TextEncoder estate)

}

instance Show TextEncoding where

show :: TextEncoding -> String show TextEncoding te = TextEncoding -> String textEncodingName TextEncoding te

data CodingProgress = InputUnderflow

                | [OutputUnderflow](GHC.IO.Encoding.Types.html#OutputUnderflow) 
                | [InvalidSequence](GHC.IO.Encoding.Types.html#InvalidSequence) 
                                  
                                  
                deriving ( CodingProgress -> CodingProgress -> Bool

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