    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