{-# LANGUAGE ExistentialQuantification #-}
module Data.Encoding.Base where

import Data.Encoding.Exception
import Data.Encoding.ByteSource
import Data.Encoding.ByteSink

import Control.Throws
import Data.Array.Unboxed as Array
import Data.Map as Map hiding ((!))
import Data.Word
import Data.Char
import Data.Typeable

{- | The base class for all encodings. At least decodeChar, encodeChar and encodeable must be implemented.
 -}
class Encoding enc where
    -- | Read a single character of a ByteSource
    decodeChar :: ByteSource m => enc -> m Char
    -- | Encode a single character and write it to a ByteSink
    encodeChar :: ByteSink m => enc -> Char -> m ()
    -- | Read characters from a ByteSource until it is empty
    decode :: ByteSource m => enc -> m String
    decode enc
e = m Bool -> m Char -> m String
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
untilM m Bool
forall (m :: * -> *). ByteSource m => m Bool
sourceEmpty (enc -> m Char
forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m Char
forall (m :: * -> *). ByteSource m => enc -> m Char
decodeChar enc
e)
    -- | Encode a String and write it to a ByteSink
    encode :: ByteSink m => enc -> String -> m ()
    encode enc
e = (Char -> m ()) -> String -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (enc -> Char -> m ()
forall enc (m :: * -> *).
(Encoding enc, ByteSink m) =>
enc -> Char -> m ()
forall (m :: * -> *). ByteSink m => enc -> Char -> m ()
encodeChar enc
e)
    -- | Tests whether a given character is representable in the Encoding.
    --   If this yields True, encodeChar must not fail.
    --   If it yields False, encodeChar _must_ throw an exception.
    encodeable :: enc -> Char -> Bool

{- | Wraps all possible encoding types into one data type.
     Used when a function needs to return an encoding.
 -}
data DynEncoding = forall enc. (Encoding enc,Eq enc,Typeable enc,Show enc) => DynEncoding enc

instance Show DynEncoding where
    show :: DynEncoding -> String
show (DynEncoding enc
enc) = enc -> String
forall a. Show a => a -> String
show enc
enc

instance Encoding DynEncoding where
    decodeChar :: forall (m :: * -> *). ByteSource m => DynEncoding -> m Char
decodeChar (DynEncoding enc
e) = enc -> m Char
forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m Char
forall (m :: * -> *). ByteSource m => enc -> m Char
decodeChar enc
e
    encodeChar :: forall (m :: * -> *). ByteSink m => DynEncoding -> Char -> m ()
encodeChar (DynEncoding enc
e) = enc -> Char -> m ()
forall enc (m :: * -> *).
(Encoding enc, ByteSink m) =>
enc -> Char -> m ()
forall (m :: * -> *). ByteSink m => enc -> Char -> m ()
encodeChar enc
e
    decode :: forall (m :: * -> *). ByteSource m => DynEncoding -> m String
decode (DynEncoding enc
e) = enc -> m String
forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m String
forall (m :: * -> *). ByteSource m => enc -> m String
decode enc
e
    encode :: forall (m :: * -> *). ByteSink m => DynEncoding -> String -> m ()
encode (DynEncoding enc
e) = enc -> String -> m ()
forall enc (m :: * -> *).
(Encoding enc, ByteSink m) =>
enc -> String -> m ()
forall (m :: * -> *). ByteSink m => enc -> String -> m ()
encode enc
e
    encodeable :: DynEncoding -> Char -> Bool
encodeable (DynEncoding enc
e) = enc -> Char -> Bool
forall enc. Encoding enc => enc -> Char -> Bool
encodeable enc
e

instance Eq DynEncoding where
    (DynEncoding enc
e1) == :: DynEncoding -> DynEncoding -> Bool
== (DynEncoding enc
e2) = case enc -> Maybe enc
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast enc
e2 of
                                             Maybe enc
Nothing -> Bool
False
                                             Just enc
e2' -> enc
e1enc -> enc -> Bool
forall a. Eq a => a -> a -> Bool
==enc
e2'

untilM :: Monad m => m Bool -> m a -> m [a]
untilM :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
untilM m Bool
check m a
act = do
  Bool
end <- m Bool
check
  if Bool
end
    then [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else (do
           a
x <- m a
act
           [a]
xs <- m Bool -> m a -> m [a]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
untilM m Bool
check m a
act
           [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
         )

untilM_ :: Monad m => m Bool -> m a -> m ()
untilM_ :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m ()
untilM_ m Bool
check m a
act = m Bool -> m a -> m [a]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
untilM m Bool
check m a
act m [a] -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

encodeWithMap :: ByteSink m => Map Char Word8 -> Char -> m ()
encodeWithMap :: forall (m :: * -> *). ByteSink m => Map Char Word8 -> Char -> m ()
encodeWithMap Map Char Word8
mp Char
c = case Char -> Map Char Word8 -> Maybe Word8
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
c Map Char Word8
mp of
                       Maybe Word8
Nothing -> EncodingException -> m ()
forall a. EncodingException -> m a
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException (EncodingException -> m ()) -> EncodingException -> m ()
forall a b. (a -> b) -> a -> b
$ Char -> EncodingException
HasNoRepresentation Char
c
                       Just Word8
v -> Word8 -> m ()
forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 Word8
v

encodeWithMap2 :: ByteSink m => Map Char (Word8,Word8) -> Char -> m ()
encodeWithMap2 :: forall (m :: * -> *).
ByteSink m =>
Map Char (Word8, Word8) -> Char -> m ()
encodeWithMap2 Map Char (Word8, Word8)
mp Char
c = case Char -> Map Char (Word8, Word8) -> Maybe (Word8, Word8)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
c Map Char (Word8, Word8)
mp of
                        Maybe (Word8, Word8)
Nothing -> EncodingException -> m ()
forall a. EncodingException -> m a
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException (EncodingException -> m ()) -> EncodingException -> m ()
forall a b. (a -> b) -> a -> b
$ Char -> EncodingException
HasNoRepresentation Char
c
                        Just (Word8
w1,Word8
w2) -> do
                          Word8 -> m ()
forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 Word8
w1
                          Word8 -> m ()
forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 Word8
w2

encodeableWithMap :: Map Char a -> Char -> Bool
encodeableWithMap :: forall a. Map Char a -> Char -> Bool
encodeableWithMap = (Char -> Map Char a -> Bool) -> Map Char a -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> Map Char a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member

decodeWithArray :: ByteSource m => UArray Word8 Int -> m Char
decodeWithArray :: forall (m :: * -> *). ByteSource m => UArray Word8 Int -> m Char
decodeWithArray UArray Word8 Int
arr = do
  Word8
w <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
  let res :: Int
res = UArray Word8 Int
arrUArray Word8 Int -> Word8 -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Word8
w
  if Int
res Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
    then DecodingException -> m Char
forall a. DecodingException -> m a
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException (DecodingException -> m Char) -> DecodingException -> m Char
forall a b. (a -> b) -> a -> b
$ Word8 -> DecodingException
IllegalCharacter Word8
w
    else 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
res

decodeWithArray2 :: ByteSource m => UArray (Word8,Word8) Int -> m Char
decodeWithArray2 :: forall (m :: * -> *).
ByteSource m =>
UArray (Word8, Word8) Int -> m Char
decodeWithArray2 UArray (Word8, Word8) Int
arr = do
  Word8
w1 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
  Word8
w2 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
  if ((Word8, Word8), (Word8, Word8)) -> (Word8, Word8) -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (UArray (Word8, Word8) Int -> ((Word8, Word8), (Word8, Word8))
forall i. Ix i => UArray i Int -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray (Word8, Word8) Int
arr) (Word8
w1,Word8
w2)
    then (do
           let res :: Int
res = UArray (Word8, Word8) Int
arrUArray (Word8, Word8) Int -> (Word8, Word8) -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Word8
w1,Word8
w2)
           if Int
res Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
             then DecodingException -> m Char
forall a. DecodingException -> m a
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException (DecodingException -> m Char) -> DecodingException -> m Char
forall a b. (a -> b) -> a -> b
$ Word8 -> DecodingException
IllegalCharacter Word8
w1
             else 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
res
         )
    else DecodingException -> m Char
forall a. DecodingException -> m a
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException (DecodingException -> m Char) -> DecodingException -> m Char
forall a b. (a -> b) -> a -> b
$ Word8 -> DecodingException
IllegalCharacter Word8
w1