    {-# 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
      end <- m Bool
    check
      if end
        then return []
        else (do
               x <- act
               xs <- untilM check act
               return (x: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
      w <- m Word8
    forall (m :: * -> *). ByteSource m => m Word8
    fetchWord8
      let 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 res < 0
        then throwException $ IllegalCharacter w
        else return $ chr 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
      w1 <- m Word8
    forall (m :: * -> *). ByteSource m => m Word8
    fetchWord8
      w2 <- fetchWord8
      if inRange (bounds arr) (w1,w2)
        then (do
               let 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 res < 0
                 then throwException $ IllegalCharacter w1
                 else return $ chr res
             )
        else throwException $ IllegalCharacter w1