    {-# LANGUAGE CPP              #-}
    {-# LANGUAGE TypeApplications #-}

    -- | = WARNING
    --
    -- This module is considered __internal__.
    --
    -- The Package Versioning Policy __does not apply__.
    --
    -- The contents of this module may change __in any way whatsoever__
    -- and __without any warning__ between minor versions of this package.
    --
    -- Authors importing this module are expected to track development
    -- closely.
    --
    -- = Description
    --
    -- Debugging utilities for 'HashMap's.

    module Data.HashMap.Internal.Debug
        ( valid
        , Validity(..)
        , Error(..)
        , SubHash
        , SubHashPath
        ) where

    import Data.Bits             (complement, countTrailingZeros, popCount, shiftL,
                                  unsafeShiftL, (.&.), (.|.))
    import Data.Hashable         (Hashable)
    import Data.HashMap.Internal (Bitmap, Hash, HashMap (..), Leaf (..),
                                  bitsPerSubkey, fullBitmap, hash,
                                  isLeafOrCollision, maxChildren, sparseIndex)
    import Data.Semigroup        (Sum (..))

    import qualified Data.HashMap.Internal.Array as A

    #if !MIN_VERSION_base(4,11,0)
    import Data.Semigroup (Semigroup (..))
    #endif

    data Validity k = Invalid (Error k) SubHashPath | Valid
      deriving (Validity k -> Validity k -> Bool
    (Validity k -> Validity k -> Bool)
    -> (Validity k -> Validity k -> Bool) -> Eq (Validity k)
    forall k. Eq k => Validity k -> Validity k -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall k. Eq k => Validity k -> Validity k -> Bool
    == :: Validity k -> Validity k -> Bool
    $c/= :: forall k. Eq k => Validity k -> Validity k -> Bool
    /= :: Validity k -> Validity k -> Bool
    Eq, Int -> Validity k -> ShowS
    [Validity k] -> ShowS
    Validity k -> String
    (Int -> Validity k -> ShowS)
    -> (Validity k -> String)
    -> ([Validity k] -> ShowS)
    -> Show (Validity k)
    forall k. Show k => Int -> Validity k -> ShowS
    forall k. Show k => [Validity k] -> ShowS
    forall k. Show k => Validity k -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall k. Show k => Int -> Validity k -> ShowS
    showsPrec :: Int -> Validity k -> ShowS
    $cshow :: forall k. Show k => Validity k -> String
    show :: Validity k -> String
    $cshowList :: forall k. Show k => [Validity k] -> ShowS
    showList :: [Validity k] -> ShowS
    Show)

    instance Semigroup (Validity k) where
      Validity k
    Valid <> :: Validity k -> Validity k -> Validity k
    <> Validity k
    y = Validity k
    y
      Validity k
    x     <> Validity k
    _ = Validity k
    x

    instance Monoid (Validity k) where
      mempty :: Validity k
    mempty = Validity k
    forall k. Validity k
    Valid
      mappend :: Validity k -> Validity k -> Validity k
    mappend = Validity k -> Validity k -> Validity k
    forall a. Semigroup a => a -> a -> a
    (<>)

    -- | An error corresponding to a broken invariant.
    --
    -- See 'HashMap' for the documentation of the invariants.
    data Error k
      = INV1_internal_Empty
      | INV2_Bitmap_unexpected_1_bits !Bitmap
      | INV3_bad_BitmapIndexed_size !Int
      | INV4_bitmap_array_size_mismatch !Bitmap !Int
      | INV5_BitmapIndexed_invalid_single_subtree
      | INV6_misplaced_hash !Hash
      | INV7_key_hash_mismatch k !Hash
      | INV8_bad_Full_size !Int
      | INV9_Collision_size !Int
      | INV10_Collision_duplicate_key k !Hash
      deriving (Error k -> Error k -> Bool
    (Error k -> Error k -> Bool)
    -> (Error k -> Error k -> Bool) -> Eq (Error k)
    forall k. Eq k => Error k -> Error k -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall k. Eq k => Error k -> Error k -> Bool
    == :: Error k -> Error k -> Bool
    $c/= :: forall k. Eq k => Error k -> Error k -> Bool
    /= :: Error k -> Error k -> Bool
    Eq, Int -> Error k -> ShowS
    [Error k] -> ShowS
    Error k -> String
    (Int -> Error k -> ShowS)
    -> (Error k -> String) -> ([Error k] -> ShowS) -> Show (Error k)
    forall k. Show k => Int -> Error k -> ShowS
    forall k. Show k => [Error k] -> ShowS
    forall k. Show k => Error k -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall k. Show k => Int -> Error k -> ShowS
    showsPrec :: Int -> Error k -> ShowS
    $cshow :: forall k. Show k => Error k -> String
    show :: Error k -> String
    $cshowList :: forall k. Show k => [Error k] -> ShowS
    showList :: [Error k] -> ShowS
    Show)

    -- TODO: Name this 'Index'?!
    -- (https://github.com/haskell-unordered-containers/unordered-containers/issues/425)
    -- | A part of a 'Hash' with 'bitsPerSubkey' bits.
    type SubHash = Word

    data SubHashPath = SubHashPath
      { SubHashPath -> Hash
    partialHash :: !Word
        -- ^ The bits we already know, starting from the lower bits.
        -- The unknown upper bits are @0@.
      , SubHashPath -> Int
    lengthInBits :: !Int
        -- ^ The number of bits known.
      } deriving (SubHashPath -> SubHashPath -> Bool
    (SubHashPath -> SubHashPath -> Bool)
    -> (SubHashPath -> SubHashPath -> Bool) -> Eq SubHashPath
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SubHashPath -> SubHashPath -> Bool
    == :: SubHashPath -> SubHashPath -> Bool
    $c/= :: SubHashPath -> SubHashPath -> Bool
    /= :: SubHashPath -> SubHashPath -> Bool
    Eq, Int -> SubHashPath -> ShowS
    [SubHashPath] -> ShowS
    SubHashPath -> String
    (Int -> SubHashPath -> ShowS)
    -> (SubHashPath -> String)
    -> ([SubHashPath] -> ShowS)
    -> Show SubHashPath
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SubHashPath -> ShowS
    showsPrec :: Int -> SubHashPath -> ShowS
    $cshow :: SubHashPath -> String
    show :: SubHashPath -> String
    $cshowList :: [SubHashPath] -> ShowS
    showList :: [SubHashPath] -> ShowS
    Show)

    initialSubHashPath :: SubHashPath
    initialSubHashPath :: SubHashPath
    initialSubHashPath = Hash -> Int -> SubHashPath
    SubHashPath Hash
    0 Int
    0

    addSubHash :: SubHashPath -> SubHash -> SubHashPath
    addSubHash :: SubHashPath -> Hash -> SubHashPath
    addSubHash (SubHashPath Hash
    ph Int
    l) Hash
    sh =
      Hash -> Int -> SubHashPath
    SubHashPath (Hash
    ph Hash -> Hash -> Hash
    forall a. Bits a => a -> a -> a
    .|. (Hash
    sh Hash -> Int -> Hash
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    l)) (Int
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    bitsPerSubkey)

    hashMatchesSubHashPath :: SubHashPath -> Hash -> Bool
    hashMatchesSubHashPath :: SubHashPath -> Hash -> Bool
    hashMatchesSubHashPath (SubHashPath Hash
    ph Int
    l) Hash
    h = Hash -> Int -> Hash
    forall {a}. (Bits a, Num a) => a -> Int -> a
    maskToLength Hash
    h Int
    l Hash -> Hash -> Bool
    forall a. Eq a => a -> a -> Bool
    == Hash
    ph
      where
        -- Note: This needs to use `shiftL` instead of `unsafeShiftL` because
        -- @l'@ may be greater than 32/64 at the deepest level.
        maskToLength :: a -> Int -> a
    maskToLength a
    h' Int
    l' = a
    h' a -> a -> a
    forall a. Bits a => a -> a -> a
    .&. a -> a
    forall a. Bits a => a -> a
    complement (a -> a
    forall a. Bits a => a -> a
    complement a
    0 a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    l')

    valid :: Hashable k => HashMap k v -> Validity k
    valid :: forall k v. Hashable k => HashMap k v -> Validity k
    valid HashMap k v
    Empty = Validity k
    forall k. Validity k
    Valid
    valid HashMap k v
    t     = SubHashPath -> HashMap k v -> Validity k
    forall {k} {v}.
    Hashable k =>
    SubHashPath -> HashMap k v -> Validity k
    validInternal SubHashPath
    initialSubHashPath HashMap k v
    t
      where
        validInternal :: SubHashPath -> HashMap k v -> Validity k
    validInternal SubHashPath
    p HashMap k v
    Empty                 = Error k -> SubHashPath -> Validity k
    forall k. Error k -> SubHashPath -> Validity k
    Invalid Error k
    forall k. Error k
    INV1_internal_Empty SubHashPath
    p
        validInternal SubHashPath
    p (Leaf Hash
    h Leaf k v
    l)            = SubHashPath -> Hash -> Validity k
    forall {k}. SubHashPath -> Hash -> Validity k
    validHash SubHashPath
    p Hash
    h Validity k -> Validity k -> Validity k
    forall a. Semigroup a => a -> a -> a
    <> SubHashPath -> Hash -> Leaf k v -> Validity k
    forall {k} {v}.
    Hashable k =>
    SubHashPath -> Hash -> Leaf k v -> Validity k
    validLeaf SubHashPath
    p Hash
    h Leaf k v
    l
        validInternal SubHashPath
    p (Collision Hash
    h Array (Leaf k v)
    ary)     = SubHashPath -> Hash -> Validity k
    forall {k}. SubHashPath -> Hash -> Validity k
    validHash SubHashPath
    p Hash
    h Validity k -> Validity k -> Validity k
    forall a. Semigroup a => a -> a -> a
    <> SubHashPath -> Hash -> Array (Leaf k v) -> Validity k
    forall {k} {v}.
    Hashable k =>
    SubHashPath -> Hash -> Array (Leaf k v) -> Validity k
    validCollision SubHashPath
    p Hash
    h Array (Leaf k v)
    ary
        validInternal SubHashPath
    p (BitmapIndexed Hash
    b Array (HashMap k v)
    ary) = SubHashPath -> Hash -> Array (HashMap k v) -> Validity k
    validBitmapIndexed SubHashPath
    p Hash
    b Array (HashMap k v)
    ary
        validInternal SubHashPath
    p (Full Array (HashMap k v)
    ary)            = SubHashPath -> Array (HashMap k v) -> Validity k
    validFull SubHashPath
    p Array (HashMap k v)
    ary

        validHash :: SubHashPath -> Hash -> Validity k
    validHash SubHashPath
    p Hash
    h | SubHashPath -> Hash -> Bool
    hashMatchesSubHashPath SubHashPath
    p Hash
    h = Validity k
    forall k. Validity k
    Valid
                      | Bool
    otherwise                  = Error k -> SubHashPath -> Validity k
    forall k. Error k -> SubHashPath -> Validity k
    Invalid (Hash -> Error k
    forall k. Hash -> Error k
    INV6_misplaced_hash Hash
    h) SubHashPath
    p

        validLeaf :: SubHashPath -> Hash -> Leaf k v -> Validity k
    validLeaf SubHashPath
    p Hash
    h (L k
    k v
    _) | k -> Hash
    forall a. Hashable a => a -> Hash
    hash k
    k Hash -> Hash -> Bool
    forall a. Eq a => a -> a -> Bool
    == Hash
    h = Validity k
    forall k. Validity k
    Valid
                              | Bool
    otherwise   = Error k -> SubHashPath -> Validity k
    forall k. Error k -> SubHashPath -> Validity k
    Invalid (k -> Hash -> Error k
    forall k. k -> Hash -> Error k
    INV7_key_hash_mismatch k
    k Hash
    h) SubHashPath
    p

        validCollision :: SubHashPath -> Hash -> Array (Leaf k v) -> Validity k
    validCollision SubHashPath
    p Hash
    h Array (Leaf k v)
    ary = Validity k
    forall k. Validity k
    validCollisionSize Validity k -> Validity k -> Validity k
    forall a. Semigroup a => a -> a -> a
    <> (Leaf k v -> Validity k) -> Array (Leaf k v) -> Validity k
    forall m a. Monoid m => (a -> m) -> Array a -> m
    A.foldMap (SubHashPath -> Hash -> Leaf k v -> Validity k
    forall {k} {v}.
    Hashable k =>
    SubHashPath -> Hash -> Leaf k v -> Validity k
    validLeaf SubHashPath
    p Hash
    h) Array (Leaf k v)
    ary Validity k -> Validity k -> Validity k
    forall a. Semigroup a => a -> a -> a
    <> Validity k
    distinctKeys
          where
            n :: Int
    n = Array (Leaf k v) -> Int
    forall a. Array a -> Int
    A.length Array (Leaf k v)
    ary
            validCollisionSize :: Validity k
    validCollisionSize | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    2     = Error k -> SubHashPath -> Validity k
    forall k. Error k -> SubHashPath -> Validity k
    Invalid (Int -> Error k
    forall k. Int -> Error k
    INV9_Collision_size Int
    n) SubHashPath
    p
                               | Bool
    otherwise = Validity k
    forall k. Validity k
    Valid
            distinctKeys :: Validity k
    distinctKeys = (Leaf k v -> Validity k) -> Array (Leaf k v) -> Validity k
    forall m a. Monoid m => (a -> m) -> Array a -> m
    A.foldMap (\(L k
    k v
    _) -> k -> Validity k
    appearsOnce k
    k) Array (Leaf k v)
    ary
            appearsOnce :: k -> Validity k
    appearsOnce k
    k | (Leaf k v -> Sum Int) -> Array (Leaf k v) -> Sum Int
    forall m a. Monoid m => (a -> m) -> Array a -> m
    A.foldMap (\(L k
    k' v
    _) -> if k
    k' k -> k -> Bool
    forall a. Eq a => a -> a -> Bool
    == k
    k then forall a. a -> Sum a
    Sum @Int Int
    1 else Int -> Sum Int
    forall a. a -> Sum a
    Sum Int
    0) Array (Leaf k v)
    ary Sum Int -> Sum Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Sum Int
    1 = Validity k
    forall k. Validity k
    Valid
                          | Bool
    otherwise = Error k -> SubHashPath -> Validity k
    forall k. Error k -> SubHashPath -> Validity k
    Invalid (k -> Hash -> Error k
    forall k. k -> Hash -> Error k
    INV10_Collision_duplicate_key k
    k Hash
    h) SubHashPath
    p

        validBitmapIndexed :: SubHashPath -> Hash -> Array (HashMap k v) -> Validity k
    validBitmapIndexed SubHashPath
    p Hash
    b Array (HashMap k v)
    ary = Validity k
    forall k. Validity k
    validBitmap Validity k -> Validity k -> Validity k
    forall a. Semigroup a => a -> a -> a
    <> Validity k
    forall k. Validity k
    validArraySize Validity k -> Validity k -> Validity k
    forall a. Semigroup a => a -> a -> a
    <> SubHashPath -> Hash -> Array (HashMap k v) -> Validity k
    validSubTrees SubHashPath
    p Hash
    b Array (HashMap k v)
    ary
          where
            validBitmap :: Validity k
    validBitmap | Hash
    b Hash -> Hash -> Hash
    forall a. Bits a => a -> a -> a
    .&. Hash -> Hash
    forall a. Bits a => a -> a
    complement Hash
    fullBitmap Hash -> Hash -> Bool
    forall a. Eq a => a -> a -> Bool
    == Hash
    0 = Validity k
    forall k. Validity k
    Valid
                        | Bool
    otherwise                        = Error k -> SubHashPath -> Validity k
    forall k. Error k -> SubHashPath -> Validity k
    Invalid (Hash -> Error k
    forall k. Hash -> Error k
    INV2_Bitmap_unexpected_1_bits Hash
    b) SubHashPath
    p
            n :: Int
    n = Array (HashMap k v) -> Int
    forall a. Array a -> Int
    A.length Array (HashMap k v)
    ary
            validArraySize :: Validity k
    validArraySize | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    1 Bool -> Bool -> Bool
    || Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    maxChildren = Error k -> SubHashPath -> Validity k
    forall k. Error k -> SubHashPath -> Validity k
    Invalid (Int -> Error k
    forall k. Int -> Error k
    INV3_bad_BitmapIndexed_size Int
    n) SubHashPath
    p
                           | Hash -> Int
    forall a. Bits a => a -> Int
    popCount Hash
    b Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    n           = Validity k
    forall k. Validity k
    Valid
                           | Bool
    otherwise                 = Error k -> SubHashPath -> Validity k
    forall k. Error k -> SubHashPath -> Validity k
    Invalid (Hash -> Int -> Error k
    forall k. Hash -> Int -> Error k
    INV4_bitmap_array_size_mismatch Hash
    b Int
    n) SubHashPath
    p

        validSubTrees :: SubHashPath -> Hash -> Array (HashMap k v) -> Validity k
    validSubTrees SubHashPath
    p Hash
    b Array (HashMap k v)
    ary
          | Array (HashMap k v) -> Int
    forall a. Array a -> Int
    A.length Array (HashMap k v)
    ary Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1
          , HashMap k v -> Bool
    forall k v. HashMap k v -> Bool
    isLeafOrCollision (Array (HashMap k v) -> Int -> HashMap k v
    forall a. Array a -> Int -> a
    A.index Array (HashMap k v)
    ary Int
    0)
          = Error k -> SubHashPath -> Validity k
    forall k. Error k -> SubHashPath -> Validity k
    Invalid Error k
    forall k. Error k
    INV5_BitmapIndexed_invalid_single_subtree SubHashPath
    p
          | Bool
    otherwise = Hash -> Validity k
    go Hash
    b
          where
            go :: Hash -> Validity k
    go Hash
    0  = Validity k
    forall k. Validity k
    Valid
            go Hash
    b' = SubHashPath -> HashMap k v -> Validity k
    validInternal (SubHashPath -> Hash -> SubHashPath
    addSubHash SubHashPath
    p (Int -> Hash
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    c)) (Array (HashMap k v) -> Int -> HashMap k v
    forall a. Array a -> Int -> a
    A.index Array (HashMap k v)
    ary Int
    i) Validity k -> Validity k -> Validity k
    forall a. Semigroup a => a -> a -> a
    <> Hash -> Validity k
    go Hash
    b''
              where
                c :: Int
    c = Hash -> Int
    forall b. FiniteBits b => b -> Int
    countTrailingZeros Hash
    b'
                m :: Hash
    m = Hash
    1 Hash -> Int -> Hash
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    c
                i :: Int
    i = Hash -> Hash -> Int
    sparseIndex Hash
    b Hash
    m
                b'' :: Hash
    b'' = Hash
    b' Hash -> Hash -> Hash
    forall a. Bits a => a -> a -> a
    .&. Hash -> Hash
    forall a. Bits a => a -> a
    complement Hash
    m

        validFull :: SubHashPath -> Array (HashMap k v) -> Validity k
    validFull SubHashPath
    p Array (HashMap k v)
    ary = Validity k
    forall k. Validity k
    validArraySize Validity k -> Validity k -> Validity k
    forall a. Semigroup a => a -> a -> a
    <> SubHashPath -> Hash -> Array (HashMap k v) -> Validity k
    validSubTrees SubHashPath
    p Hash
    fullBitmap Array (HashMap k v)
    ary
          where
            n :: Int
    n = Array (HashMap k v) -> Int
    forall a. Array a -> Int
    A.length Array (HashMap k v)
    ary
            validArraySize :: Validity k
    validArraySize | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    maxChildren = Validity k
    forall k. Validity k
    Valid
                           | Bool
    otherwise        = Error k -> SubHashPath -> Validity k
    forall k. Error k -> SubHashPath -> Validity k
    Invalid (Int -> Error k
    forall k. Int -> Error k
    INV8_bad_Full_size Int
    n) SubHashPath
    p