module Data.CharMap where import Data.Map.Static import Data.Encoding.ByteSink import Data.Encoding.Exception import Control.Throws import Data.Word import Data.Char import Prelude hiding (lookup) data CharMap = Node !Char !CharMap !CharMap | DeadEnd | LeafRange1 !Int !Word8 | LeafRange2 !Int !Word8 !Word8 !Word8 | LeafRange3 !Int !Word8 !Word8 !Word8 !Word8 !Word8 | LeafRange4 !Int !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 | LeafMap1 (StaticMap Char Word8) | LeafMap2 (StaticMap Char Word16) | LeafMap4 (StaticMap Char Word32) mapEncode :: ByteSink m => Char -> CharMap -> m () mapEncode :: forall (m :: * -> *). ByteSink m => Char -> CharMap -> m () mapEncode Char ch (Node Char rch CharMap l CharMap r) | Char ch forall a. Ord a => a -> a -> Bool < Char rch = forall (m :: * -> *). ByteSink m => Char -> CharMap -> m () mapEncode Char ch CharMap l | Bool otherwise = forall (m :: * -> *). ByteSink m => Char -> CharMap -> m () mapEncode Char ch CharMap r mapEncode Char ch CharMap DeadEnd = forall e (m :: * -> *) a. Throws e m => e -> m a throwException (Char -> EncodingException HasNoRepresentation Char ch) mapEncode Char ch (LeafRange1 Int bch Word8 st) = forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 forall a b. (a -> b) -> a -> b $ Word8 st forall a. Num a => a -> a -> a + (forall a b. (Integral a, Num b) => a -> b fromIntegral ((Char -> Int ord Char ch) forall a. Num a => a -> a -> a - Int bch)) mapEncode Char ch (LeafRange2 Int bch Word8 min1 Word8 min2 Word8 r2) = let v :: Int v = (Char -> Int ord Char ch) forall a. Num a => a -> a -> a - Int bch (Int w1,Int w2) = Int v forall a. Integral a => a -> a -> (a, a) `divMod` (forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 r2) in do forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (forall a b. (Integral a, Num b) => a -> b fromIntegral Int w1 forall a. Num a => a -> a -> a + Word8 min1) forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (forall a b. (Integral a, Num b) => a -> b fromIntegral Int w2 forall a. Num a => a -> a -> a + Word8 min2) mapEncode Char ch (LeafRange3 Int bch Word8 min1 Word8 min2 Word8 r2 Word8 min3 Word8 r3) = let v :: Int v = (Char -> Int ord Char ch) forall a. Num a => a -> a -> a - Int bch (Int v1,Int w3) = Int v forall a. Integral a => a -> a -> (a, a) `divMod` (forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 r3) (Int w1,Int w2) = Int v1 forall a. Integral a => a -> a -> (a, a) `divMod` (forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 r2) in do forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (forall a b. (Integral a, Num b) => a -> b fromIntegral Int w1 forall a. Num a => a -> a -> a + Word8 min1) forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (forall a b. (Integral a, Num b) => a -> b fromIntegral Int w2 forall a. Num a => a -> a -> a + Word8 min2) forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (forall a b. (Integral a, Num b) => a -> b fromIntegral Int w3 forall a. Num a => a -> a -> a + Word8 min3) mapEncode Char ch (LeafRange4 Int bch Word8 min1 Word8 min2 Word8 r2 Word8 min3 Word8 r3 Word8 min4 Word8 r4) = let v :: Int v = (Char -> Int ord Char ch) forall a. Num a => a -> a -> a - Int bch (Int v1,Int w4) = Int v forall a. Integral a => a -> a -> (a, a) `divMod` (forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 r4) (Int v2,Int w3) = Int v1 forall a. Integral a => a -> a -> (a, a) `divMod` (forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 r3) (Int w1,Int w2) = Int v2 forall a. Integral a => a -> a -> (a, a) `divMod` (forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 r2) in do forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (forall a b. (Integral a, Num b) => a -> b fromIntegral Int w1 forall a. Num a => a -> a -> a + Word8 min1) forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (forall a b. (Integral a, Num b) => a -> b fromIntegral Int w2 forall a. Num a => a -> a -> a + Word8 min2) forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (forall a b. (Integral a, Num b) => a -> b fromIntegral Int w3 forall a. Num a => a -> a -> a + Word8 min3) forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (forall a b. (Integral a, Num b) => a -> b fromIntegral Int w4 forall a. Num a => a -> a -> a + Word8 min4) mapEncode Char ch (LeafMap1 StaticMap Char Word8 mp) = case forall i e. (StaticElement i, StaticElement e, Ord i) => i -> StaticMap i e -> Maybe e lookup Char ch StaticMap Char Word8 mp of Maybe Word8 Nothing -> forall e (m :: * -> *) a. Throws e m => e -> m a throwException (Char -> EncodingException HasNoRepresentation Char ch) Just Word8 v -> forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 Word8 v mapEncode Char ch (LeafMap2 StaticMap Char Word16 mp) = case forall i e. (StaticElement i, StaticElement e, Ord i) => i -> StaticMap i e -> Maybe e lookup Char ch StaticMap Char Word16 mp of Maybe Word16 Nothing -> forall e (m :: * -> *) a. Throws e m => e -> m a throwException (Char -> EncodingException HasNoRepresentation Char ch) Just Word16 v -> forall (m :: * -> *). ByteSink m => Word16 -> m () pushWord16be Word16 v mapEncode Char ch (LeafMap4 StaticMap Char Word32 mp) = case forall i e. (StaticElement i, StaticElement e, Ord i) => i -> StaticMap i e -> Maybe e lookup Char ch StaticMap Char Word32 mp of Maybe Word32 Nothing -> forall e (m :: * -> *) a. Throws e m => e -> m a throwException (Char -> EncodingException HasNoRepresentation Char ch) Just Word32 v -> forall (m :: * -> *). ByteSink m => Word32 -> m () pushWord32be Word32 v mapMember :: Char -> CharMap -> Bool mapMember :: Char -> CharMap -> Bool mapMember Char c (Node Char rc CharMap l CharMap r) | Char c forall a. Ord a => a -> a -> Bool < Char rc = Char -> CharMap -> Bool mapMember Char c CharMap l | Bool otherwise = Char -> CharMap -> Bool mapMember Char c CharMap r mapMember Char c CharMap DeadEnd = Bool False mapMember Char c (LeafMap1 StaticMap Char Word8 mp) = forall i e. (StaticElement i, StaticElement e, Ord i) => i -> StaticMap i e -> Bool member Char c StaticMap Char Word8 mp mapMember Char c (LeafMap2 StaticMap Char Word16 mp) = forall i e. (StaticElement i, StaticElement e, Ord i) => i -> StaticMap i e -> Bool member Char c StaticMap Char Word16 mp mapMember Char c (LeafMap4 StaticMap Char Word32 mp) = forall i e. (StaticElement i, StaticElement e, Ord i) => i -> StaticMap i e -> Bool member Char c StaticMap Char Word32 mp mapMember Char c CharMap _ = Bool True