{-# 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
class Encoding enc where
decodeChar :: ByteSource m => enc -> m Char
encodeChar :: ByteSink m => enc -> Char -> m ()
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
decodeChar enc
e)
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 ()
encodeChar enc
e)
encodeable :: enc -> Char -> Bool
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 :: DynEncoding -> m Char
decodeChar (DynEncoding enc
e) = enc -> m Char
forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m Char
decodeChar enc
e
encodeChar :: DynEncoding -> Char -> m ()
encodeChar (DynEncoding enc
e) = enc -> Char -> m ()
forall enc (m :: * -> *).
(Encoding enc, ByteSink m) =>
enc -> Char -> m ()
encodeChar enc
e
decode :: DynEncoding -> m String
decode (DynEncoding enc
e) = enc -> m String
forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m String
decode enc
e
encode :: DynEncoding -> String -> m ()
encode (DynEncoding enc
e) = enc -> String -> m ()
forall enc (m :: * -> *).
(Encoding enc, 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 :: 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 (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 (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_ :: 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
encodeWithMap :: ByteSink m => Map Char Word8 -> Char -> m ()
encodeWithMap :: 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 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 :: 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 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 :: 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 :: 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 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 (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 :: 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 (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 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 (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 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