    {-# LANGUAGE CPP #-}
    #include "containers.h"

    module Data.Map.Internal.Debug where

    import Data.Map.Internal (Map (..), size, delta)
    import Control.Monad (guard)

    -- | \(O(n \log n)\). Show the tree that implements the map. The tree is shown
    -- in a compressed, hanging format. See 'showTreeWith'.
    showTree :: (Show k,Show a) => Map k a -> String
    showTree :: forall k a. (Show k, Show a) => Map k a -> String
    showTree Map k a
    m
      = (k -> a -> String) -> Bool -> Bool -> Map k a -> String
    forall k a. (k -> a -> String) -> Bool -> Bool -> Map k a -> String
    showTreeWith k -> a -> String
    forall {a} {a}. (Show a, Show a) => a -> a -> String
    showElem Bool
    True Bool
    False Map k a
    m
      where
        showElem :: a -> a -> String
    showElem a
    k a
    x  = a -> String
    forall a. Show a => a -> String
    show a
    k String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    x

    {- | \(O(n \log n)\). The expression (@'showTreeWith' showelem hang wide map@) shows
     the tree that implements the map. Elements are shown using the @showElem@ function. If @hang@ is
     'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If
     @wide@ is 'True', an extra wide version is shown.

    >  Map> let t = fromDistinctAscList [(x,()) | x <- [1..5]]
    >  Map> putStrLn $ showTreeWith (\k x -> show (k,x)) True False t
    >  (4,())
    >  +--(2,())
    >  |  +--(1,())
    >  |  +--(3,())
    >  +--(5,())
    >
    >  Map> putStrLn $ showTreeWith (\k x -> show (k,x)) True True t
    >  (4,())
    >  |
    >  +--(2,())
    >  |  |
    >  |  +--(1,())
    >  |  |
    >  |  +--(3,())
    >  |
    >  +--(5,())
    >
    >  Map> putStrLn $ showTreeWith (\k x -> show (k,x)) False True t
    >  +--(5,())
    >  |
    >  (4,())
    >  |
    >  |  +--(3,())
    >  |  |
    >  +--(2,())
    >     |
    >     +--(1,())

    -}
    showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String
    showTreeWith :: forall k a. (k -> a -> String) -> Bool -> Bool -> Map k a -> String
    showTreeWith k -> a -> String
    showelem Bool
    hang Bool
    wide Map k a
    t
      | Bool
    hang      = ((k -> a -> String)
    -> Bool -> [String] -> Map k a -> String -> String
    forall k a.
    (k -> a -> String)
    -> Bool -> [String] -> Map k a -> String -> String
    showsTreeHang k -> a -> String
    showelem Bool
    wide [] Map k a
    t) String
    ""
      | Bool
    otherwise = ((k -> a -> String)
    -> Bool -> [String] -> [String] -> Map k a -> String -> String
    forall k a.
    (k -> a -> String)
    -> Bool -> [String] -> [String] -> Map k a -> String -> String
    showsTree k -> a -> String
    showelem Bool
    wide [] [] Map k a
    t) String
    ""

    showsTree :: (k -> a -> String) -> Bool -> [String] -> [String] -> Map k a -> ShowS
    showsTree :: forall k a.
    (k -> a -> String)
    -> Bool -> [String] -> [String] -> Map k a -> String -> String
    showsTree k -> a -> String
    showelem Bool
    wide [String]
    lbars [String]
    rbars Map k a
    t
      = case Map k a
    t of
          Map k a
    Tip -> [String] -> String -> String
    showsBars [String]
    lbars (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "|\n"
          Bin Size
    _ k
    kx a
    x Map k a
    Tip Map k a
    Tip
              -> [String] -> String -> String
    showsBars [String]
    lbars (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString (k -> a -> String
    showelem k
    kx a
    x) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "\n"
          Bin Size
    _ k
    kx a
    x Map k a
    l Map k a
    r
              -> (k -> a -> String)
    -> Bool -> [String] -> [String] -> Map k a -> String -> String
    forall k a.
    (k -> a -> String)
    -> Bool -> [String] -> [String] -> Map k a -> String -> String
    showsTree k -> a -> String
    showelem Bool
    wide ([String] -> [String]
    withBar [String]
    rbars) ([String] -> [String]
    withEmpty [String]
    rbars) Map k a
    r (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                 Bool -> [String] -> String -> String
    showWide Bool
    wide [String]
    rbars (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                 [String] -> String -> String
    showsBars [String]
    lbars (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString (k -> a -> String
    showelem k
    kx a
    x) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                 Bool -> [String] -> String -> String
    showWide Bool
    wide [String]
    lbars (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                 (k -> a -> String)
    -> Bool -> [String] -> [String] -> Map k a -> String -> String
    forall k a.
    (k -> a -> String)
    -> Bool -> [String] -> [String] -> Map k a -> String -> String
    showsTree k -> a -> String
    showelem Bool
    wide ([String] -> [String]
    withEmpty [String]
    lbars) ([String] -> [String]
    withBar [String]
    lbars) Map k a
    l

    showsTreeHang :: (k -> a -> String) -> Bool -> [String] -> Map k a -> ShowS
    showsTreeHang :: forall k a.
    (k -> a -> String)
    -> Bool -> [String] -> Map k a -> String -> String
    showsTreeHang k -> a -> String
    showelem Bool
    wide [String]
    bars Map k a
    t
      = case Map k a
    t of
          Map k a
    Tip -> [String] -> String -> String
    showsBars [String]
    bars (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "|\n"
          Bin Size
    _ k
    kx a
    x Map k a
    Tip Map k a
    Tip
              -> [String] -> String -> String
    showsBars [String]
    bars (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString (k -> a -> String
    showelem k
    kx a
    x) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "\n"
          Bin Size
    _ k
    kx a
    x Map k a
    l Map k a
    r
              -> [String] -> String -> String
    showsBars [String]
    bars (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString (k -> a -> String
    showelem k
    kx a
    x) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                 Bool -> [String] -> String -> String
    showWide Bool
    wide [String]
    bars (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                 (k -> a -> String)
    -> Bool -> [String] -> Map k a -> String -> String
    forall k a.
    (k -> a -> String)
    -> Bool -> [String] -> Map k a -> String -> String
    showsTreeHang k -> a -> String
    showelem Bool
    wide ([String] -> [String]
    withBar [String]
    bars) Map k a
    l (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                 Bool -> [String] -> String -> String
    showWide Bool
    wide [String]
    bars (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                 (k -> a -> String)
    -> Bool -> [String] -> Map k a -> String -> String
    forall k a.
    (k -> a -> String)
    -> Bool -> [String] -> Map k a -> String -> String
    showsTreeHang k -> a -> String
    showelem Bool
    wide ([String] -> [String]
    withEmpty [String]
    bars) Map k a
    r

    showWide :: Bool -> [String] -> String -> String
    showWide :: Bool -> [String] -> String -> String
    showWide Bool
    wide [String]
    bars
      | Bool
    wide      = String -> String -> String
    showString ([String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    bars)) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "|\n"
      | Bool
    otherwise = String -> String
    forall a. a -> a
    id

    showsBars :: [String] -> ShowS
    showsBars :: [String] -> String -> String
    showsBars [String]
    bars
      = case [String]
    bars of
          [] -> String -> String
    forall a. a -> a
    id
          String
    _ : [String]
    tl -> String -> String -> String
    showString ([String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    tl)) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    node

    node :: String
    node :: String
    node           = String
    "+--"

    withBar, withEmpty :: [String] -> [String]
    withBar :: [String] -> [String]
    withBar [String]
    bars   = String
    "|  "String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    bars
    withEmpty :: [String] -> [String]
    withEmpty [String]
    bars = String
    "   "String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    bars

    {--------------------------------------------------------------------
      Assertions
    --------------------------------------------------------------------}
    -- | \(O(n)\). Test if the internal map structure is valid.
    --
    -- > valid (fromAscList [(3,"b"), (5,"a")]) == True
    -- > valid (fromAscList [(5,"a"), (3,"b")]) == False

    valid :: Ord k => Map k a -> Bool
    valid :: forall k a. Ord k => Map k a -> Bool
    valid Map k a
    t
      = Map k a -> Bool
    forall k a. Map k a -> Bool
    balanced Map k a
    t Bool -> Bool -> Bool
    && Map k a -> Bool
    forall k a. Ord k => Map k a -> Bool
    ordered Map k a
    t Bool -> Bool -> Bool
    && Map k a -> Bool
    forall k a. Map k a -> Bool
    validsize Map k a
    t

    -- | Test if the keys are ordered correctly.
    ordered :: Ord a => Map a b -> Bool
    ordered :: forall k a. Ord k => Map k a -> Bool
    ordered Map a b
    t
      = (a -> Bool) -> (a -> Bool) -> Map a b -> Bool
    forall {t} {a}.
    Ord t =>
    (t -> Bool) -> (t -> Bool) -> Map t a -> Bool
    bounded (Bool -> a -> Bool
    forall a b. a -> b -> a
    const Bool
    True) (Bool -> a -> Bool
    forall a b. a -> b -> a
    const Bool
    True) Map a b
    t
      where
        bounded :: (t -> Bool) -> (t -> Bool) -> Map t a -> Bool
    bounded t -> Bool
    lo t -> Bool
    hi Map t a
    t'
          = case Map t a
    t' of
              Map t a
    Tip              -> Bool
    True
              Bin Size
    _ t
    kx a
    _ Map t a
    l Map t a
    r  -> (t -> Bool
    lo t
    kx) Bool -> Bool -> Bool
    && (t -> Bool
    hi t
    kx) Bool -> Bool -> Bool
    && (t -> Bool) -> (t -> Bool) -> Map t a -> Bool
    bounded t -> Bool
    lo (t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    <t
    kx) Map t a
    l Bool -> Bool -> Bool
    && (t -> Bool) -> (t -> Bool) -> Map t a -> Bool
    bounded (t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    >t
    kx) t -> Bool
    hi Map t a
    r

    -- | Test if a map obeys the balance invariants.
    balanced :: Map k a -> Bool
    balanced :: forall k a. Map k a -> Bool
    balanced Map k a
    t
      = case Map k a
    t of
          Map k a
    Tip            -> Bool
    True
          Bin Size
    _ k
    _ a
    _ Map k a
    l Map k a
    r  -> (Map k a -> Size
    forall k a. Map k a -> Size
    size Map k a
    l Size -> Size -> Size
    forall a. Num a => a -> a -> a
    + Map k a -> Size
    forall k a. Map k a -> Size
    size Map k a
    r Size -> Size -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Size
    1 Bool -> Bool -> Bool
    || (Map k a -> Size
    forall k a. Map k a -> Size
    size Map k a
    l Size -> Size -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Size
    deltaSize -> Size -> Size
    forall a. Num a => a -> a -> a
    *Map k a -> Size
    forall k a. Map k a -> Size
    size Map k a
    r Bool -> Bool -> Bool
    && Map k a -> Size
    forall k a. Map k a -> Size
    size Map k a
    r Size -> Size -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Size
    deltaSize -> Size -> Size
    forall a. Num a => a -> a -> a
    *Map k a -> Size
    forall k a. Map k a -> Size
    size Map k a
    l)) Bool -> Bool -> Bool
    &&
                            Map k a -> Bool
    forall k a. Map k a -> Bool
    balanced Map k a
    l Bool -> Bool -> Bool
    && Map k a -> Bool
    forall k a. Map k a -> Bool
    balanced Map k a
    r

    -- | Test if each node of a map reports its size correctly.
    validsize :: Map a b -> Bool
    validsize :: forall k a. Map k a -> Bool
    validsize Map a b
    t = case Map a b -> Maybe Size
    forall {k} {a}. Map k a -> Maybe Size
    slowSize Map a b
    t of
          Maybe Size
    Nothing -> Bool
    False
          Just Size
    _ -> Bool
    True
      where
        slowSize :: Map k a -> Maybe Size
    slowSize Map k a
    Tip = Size -> Maybe Size
    forall a. a -> Maybe a
    Just Size
    0
        slowSize (Bin Size
    sz k
    _ a
    _ Map k a
    l Map k a
    r) = do
                Size
    ls <- Map k a -> Maybe Size
    slowSize Map k a
    l
                Size
    rs <- Map k a -> Maybe Size
    slowSize Map k a
    r
                Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Size
    sz Size -> Size -> Bool
    forall a. Eq a => a -> a -> Bool
    == Size
    ls Size -> Size -> Size
    forall a. Num a => a -> a -> a
    + Size
    rs Size -> Size -> Size
    forall a. Num a => a -> a -> a
    + Size
    1)
                Size -> Maybe Size
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Size
    sz