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