{-# LANGUAGE DeriveDataTypeable #-}
module Data.Encoding.ASCII where

import Control.Throws
import Data.Char
import Data.Encoding.Base
import Data.Encoding.ByteSource
import Data.Encoding.ByteSink
import Data.Encoding.Exception
import Data.Typeable

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

instance Encoding ASCII where
    decodeChar :: forall (m :: * -> *). ByteSource m => ASCII -> m Char
decodeChar ASCII
_ = do
      Word8
w <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Char -> m Char
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> m Char) -> Char -> m Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
    encodeChar :: forall (m :: * -> *). ByteSink m => ASCII -> Char -> m ()
encodeChar ASCII
enc Char
c
      | ASCII -> Char -> Bool
forall enc. Encoding enc => enc -> Char -> Bool
encodeable ASCII
enc Char
c = Word8 -> m ()
forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (Word8 -> m ()) -> (Char -> Word8) -> Char -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> m ()) -> Char -> m ()
forall a b. (a -> b) -> a -> b
$ Char
c
      | Bool
otherwise        = EncodingException -> m ()
forall a. EncodingException -> m a
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException (EncodingException -> m ())
-> (Char -> EncodingException) -> Char -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> EncodingException
HasNoRepresentation (Char -> m ()) -> Char -> m ()
forall a b. (a -> b) -> a -> b
$ Char
c
    encodeable :: ASCII -> Char -> Bool
encodeable ASCII
_ Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\128'