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 Char -> Char -> Bool forall a. Ord a => a -> a -> Bool < Char rch = Char -> CharMap -> m () forall (m :: * -> *). ByteSink m => Char -> CharMap -> m () mapEncode Char ch CharMap l | Bool otherwise = Char -> CharMap -> m () forall (m :: * -> *). ByteSink m => Char -> CharMap -> m () mapEncode Char ch CharMap r mapEncode Char ch CharMap DeadEnd = EncodingException -> m () forall a. EncodingException -> m a forall e (m :: * -> *) a. Throws e m => e -> m a throwException (Char -> EncodingException HasNoRepresentation Char ch) mapEncode Char ch (LeafRange1 Int bch Word8 st) = Word8 -> m () forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (Word8 -> m ()) -> Word8 -> m () forall a b. (a -> b) -> a -> b $ Word8 st Word8 -> Word8 -> Word8 forall a. Num a => a -> a -> a + (Int -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral ((Char -> Int ord Char ch) Int -> Int -> Int 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) Int -> Int -> Int forall a. Num a => a -> a -> a - Int bch (Int w1,Int w2) = Int v Int -> Int -> (Int, Int) forall a. Integral a => a -> a -> (a, a) `divMod` (Word8 -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 r2) in do Word8 -> m () forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (Int -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral Int w1 Word8 -> Word8 -> Word8 forall a. Num a => a -> a -> a + Word8 min1) Word8 -> m () forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (Int -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral Int w2 Word8 -> Word8 -> Word8 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) Int -> Int -> Int forall a. Num a => a -> a -> a - Int bch (Int v1,Int w3) = Int v Int -> Int -> (Int, Int) forall a. Integral a => a -> a -> (a, a) `divMod` (Word8 -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 r3) (Int w1,Int w2) = Int v1 Int -> Int -> (Int, Int) forall a. Integral a => a -> a -> (a, a) `divMod` (Word8 -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 r2) in do Word8 -> m () forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (Int -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral Int w1 Word8 -> Word8 -> Word8 forall a. Num a => a -> a -> a + Word8 min1) Word8 -> m () forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (Int -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral Int w2 Word8 -> Word8 -> Word8 forall a. Num a => a -> a -> a + Word8 min2) Word8 -> m () forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (Int -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral Int w3 Word8 -> Word8 -> Word8 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) Int -> Int -> Int forall a. Num a => a -> a -> a - Int bch (Int v1,Int w4) = Int v Int -> Int -> (Int, Int) forall a. Integral a => a -> a -> (a, a) `divMod` (Word8 -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 r4) (Int v2,Int w3) = Int v1 Int -> Int -> (Int, Int) forall a. Integral a => a -> a -> (a, a) `divMod` (Word8 -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 r3) (Int w1,Int w2) = Int v2 Int -> Int -> (Int, Int) forall a. Integral a => a -> a -> (a, a) `divMod` (Word8 -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 r2) in do Word8 -> m () forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (Int -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral Int w1 Word8 -> Word8 -> Word8 forall a. Num a => a -> a -> a + Word8 min1) Word8 -> m () forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (Int -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral Int w2 Word8 -> Word8 -> Word8 forall a. Num a => a -> a -> a + Word8 min2) Word8 -> m () forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (Int -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral Int w3 Word8 -> Word8 -> Word8 forall a. Num a => a -> a -> a + Word8 min3) Word8 -> m () forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 (Int -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral Int w4 Word8 -> Word8 -> Word8 forall a. Num a => a -> a -> a + Word8 min4) mapEncode Char ch (LeafMap1 StaticMap Char Word8 mp) = case Char -> StaticMap Char Word8 -> Maybe Word8 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 -> EncodingException -> m () forall a. EncodingException -> m a forall e (m :: * -> *) a. Throws e m => e -> m a throwException (Char -> EncodingException HasNoRepresentation Char ch) Just Word8 v -> Word8 -> m () forall (m :: * -> *). ByteSink m => Word8 -> m () pushWord8 Word8 v mapEncode Char ch (LeafMap2 StaticMap Char Word16 mp) = case Char -> StaticMap Char Word16 -> Maybe Word16 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 -> EncodingException -> m () forall a. EncodingException -> m a forall e (m :: * -> *) a. Throws e m => e -> m a throwException (Char -> EncodingException HasNoRepresentation Char ch) Just Word16 v -> Word16 -> m () forall (m :: * -> *). ByteSink m => Word16 -> m () pushWord16be Word16 v mapEncode Char ch (LeafMap4 StaticMap Char Word32 mp) = case Char -> StaticMap Char Word32 -> Maybe Word32 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 -> EncodingException -> m () forall a. EncodingException -> m a forall e (m :: * -> *) a. Throws e m => e -> m a throwException (Char -> EncodingException HasNoRepresentation Char ch) Just Word32 v -> Word32 -> m () 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 Char -> Char -> Bool 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) = Char -> StaticMap Char Word8 -> Bool 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) = Char -> StaticMap Char Word16 -> Bool 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) = Char -> StaticMap Char Word32 -> Bool 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