    module Network.HPACK.Huffman.Tree (
        -- * Huffman decoding
        HTree (..),
        eosInfo,
        toHTree,
        showTree,
        printTree,
        flatten,
    ) where

    import Control.Arrow (second)

    import Imports
    import Network.HPACK.Huffman.Bit
    import Network.HPACK.Huffman.Params

    ----------------------------------------------------------------

    type EOSInfo = Maybe Int

    -- | Type for Huffman decoding.
    data HTree
        = Tip
            EOSInfo -- EOS info from 1
            {-# UNPACK #-} Int -- Decoded value. Essentially Word8
        | Bin
            EOSInfo -- EOS info from 1
            {-# UNPACK #-} Int -- Sequence no from 0
            HTree -- Left
            HTree -- Right
        deriving (Int -> HTree -> ShowS
    [HTree] -> ShowS
    HTree -> String
    (Int -> HTree -> ShowS)
    -> (HTree -> String) -> ([HTree] -> ShowS) -> Show HTree
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> HTree -> ShowS
    showsPrec :: Int -> HTree -> ShowS
    $cshow :: HTree -> String
    show :: HTree -> String
    $cshowList :: [HTree] -> ShowS
    showList :: [HTree] -> ShowS
    Show)

    eosInfo :: HTree -> EOSInfo
    eosInfo :: HTree -> EOSInfo
    eosInfo (Tip EOSInfo
    mx Int
    _) = EOSInfo
    mx
    eosInfo (Bin EOSInfo
    mx Int
    _ HTree
    _ HTree
    _) = EOSInfo
    mx

    ----------------------------------------------------------------

    showTree :: HTree -> String
    showTree :: HTree -> String
    showTree = String -> HTree -> String
    showTree' String
    ""

    showTree' :: String -> HTree -> String
    showTree' :: String -> HTree -> String
    showTree' String
    _ (Tip EOSInfo
    _ Int
    i) = Int -> String
    forall a. Show a => a -> String
    show Int
    i String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
    showTree' String
    pref (Bin EOSInfo
    _ Int
    n HTree
    l HTree
    r) =
        String
    "No "
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    n
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    pref
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "+ "
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String -> HTree -> String
    showTree' String
    pref' HTree
    l
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    pref
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "+ "
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String -> HTree -> String
    showTree' String
    pref' HTree
    r
      where
        pref' :: String
    pref' = String
    "  " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    pref

    printTree :: HTree -> IO ()
    printTree :: HTree -> IO ()
    printTree = String -> IO ()
    putStr (String -> IO ()) -> (HTree -> String) -> HTree -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HTree -> String
    showTree

    ----------------------------------------------------------------

    -- | Creating 'HTree'.
    toHTree :: [Bits] -> HTree
    toHTree :: [Bits] -> HTree
    toHTree [Bits]
    bs = Int -> Bits -> HTree -> HTree
    mark Int
    1 Bits
    eos (HTree -> HTree) -> HTree -> HTree
    forall a b. (a -> b) -> a -> b
    $ (Int, HTree) -> HTree
    forall a b. (a, b) -> b
    snd ((Int, HTree) -> HTree) -> (Int, HTree) -> HTree
    forall a b. (a -> b) -> a -> b
    $ Int -> [(Int, Bits)] -> (Int, HTree)
    build Int
    0 ([(Int, Bits)] -> (Int, HTree)) -> [(Int, Bits)] -> (Int, HTree)
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [Bits] -> [(Int, Bits)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0 .. Int
    idxEos] [Bits]
    bs
      where
        eos :: Bits
    eos = [Bits]
    bs [Bits] -> Int -> Bits
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    idxEos

    build :: Int -> [(Int, Bits)] -> (Int, HTree)
    build :: Int -> [(Int, Bits)] -> (Int, HTree)
    build Int
    cnt0 [(Int
    v, [])] = (Int
    cnt0, EOSInfo -> Int -> HTree
    Tip EOSInfo
    forall a. Maybe a
    Nothing Int
    v)
    build Int
    cnt0 [(Int, Bits)]
    xs =
        let (Int
    cnt1, HTree
    l) = Int -> [(Int, Bits)] -> (Int, HTree)
    build (Int
    cnt0 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) [(Int, Bits)]
    fs
            (Int
    cnt2, HTree
    r) = Int -> [(Int, Bits)] -> (Int, HTree)
    build Int
    cnt1 [(Int, Bits)]
    ts
         in (Int
    cnt2, EOSInfo -> Int -> HTree -> HTree -> HTree
    Bin EOSInfo
    forall a. Maybe a
    Nothing Int
    cnt0 HTree
    l HTree
    r)
      where
        ([(Int, Bits)]
    fs', [(Int, Bits)]
    ts') = ((Int, Bits) -> Bool)
    -> [(Int, Bits)] -> ([(Int, Bits)], [(Int, Bits)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (Bits -> Bool
    isHeadF (Bits -> Bool) -> ((Int, Bits) -> Bits) -> (Int, Bits) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Bits) -> Bits
    forall a b. (a, b) -> b
    snd) [(Int, Bits)]
    xs
        fs :: [(Int, Bits)]
    fs = ((Int, Bits) -> (Int, Bits)) -> [(Int, Bits)] -> [(Int, Bits)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Bits -> Bits) -> (Int, Bits) -> (Int, Bits)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (Int -> Bits -> Bits
    forall a. Int -> [a] -> [a]
    drop Int
    1)) [(Int, Bits)]
    fs'
        ts :: [(Int, Bits)]
    ts = ((Int, Bits) -> (Int, Bits)) -> [(Int, Bits)] -> [(Int, Bits)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Bits -> Bits) -> (Int, Bits) -> (Int, Bits)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (Int -> Bits -> Bits
    forall a. Int -> [a] -> [a]
    drop Int
    1)) [(Int, Bits)]
    ts'

    isHeadF :: Bits -> Bool
    isHeadF :: Bits -> Bool
    isHeadF [] = String -> Bool
    forall a. HasCallStack => String -> a
    error String
    "isHeadF"
    isHeadF (B
    b : Bits
    _) = B
    b B -> B -> Bool
    forall a. Eq a => a -> a -> Bool
    == B
    F

    -- | Marking the EOS path
    mark :: Int -> Bits -> HTree -> HTree
    mark :: Int -> Bits -> HTree -> HTree
    mark Int
    i [] (Tip EOSInfo
    Nothing Int
    v) = EOSInfo -> Int -> HTree
    Tip (Int -> EOSInfo
    forall a. a -> Maybe a
    Just Int
    i) Int
    v
    mark Int
    i (B
    F : Bits
    bs) (Bin EOSInfo
    Nothing Int
    n HTree
    l HTree
    r) = EOSInfo -> Int -> HTree -> HTree -> HTree
    Bin (Int -> EOSInfo
    forall a. a -> Maybe a
    Just Int
    i) Int
    n (Int -> Bits -> HTree -> HTree
    mark (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Bits
    bs HTree
    l) HTree
    r
    mark Int
    i (B
    T : Bits
    bs) (Bin EOSInfo
    Nothing Int
    n HTree
    l HTree
    r) = EOSInfo -> Int -> HTree -> HTree -> HTree
    Bin (Int -> EOSInfo
    forall a. a -> Maybe a
    Just Int
    i) Int
    n HTree
    l (Int -> Bits -> HTree -> HTree
    mark (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Bits
    bs HTree
    r)
    mark Int
    _ Bits
    _ HTree
    _ = String -> HTree
    forall a. HasCallStack => String -> a
    error String
    "mark"

    ----------------------------------------------------------------

    flatten :: HTree -> [HTree]
    flatten :: HTree -> [HTree]
    flatten (Tip EOSInfo
    _ Int
    _) = []
    flatten t :: HTree
    t@(Bin EOSInfo
    _ Int
    _ HTree
    l HTree
    r) = HTree
    t HTree -> [HTree] -> [HTree]
    forall a. a -> [a] -> [a]
    : (HTree -> [HTree]
    flatten HTree
    l [HTree] -> [HTree] -> [HTree]
    forall a. [a] -> [a] -> [a]
    ++ HTree -> [HTree]
    flatten HTree
    r)