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

module Data.Map.Internal.Debug where

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

-- | /O(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 :: Map k a -> String
showTree m :: 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 k :: a
k x :: a
x  = a -> String
forall a. Show a => a -> String
show a
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x


{- | /O(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 :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String
showTreeWith showelem :: k -> a -> String
showelem hang :: Bool
hang wide :: Bool
wide t :: 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) ""
  | 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) ""

showsTree :: (k -> a -> String) -> Bool -> [String] -> [String] -> Map k a -> ShowS
showsTree :: (k -> a -> String)
-> Bool -> [String] -> [String] -> Map k a -> String -> String
showsTree showelem :: k -> a -> String
showelem wide :: Bool
wide lbars :: [String]
lbars rbars :: [String]
rbars t :: Map k a
t
  = case Map k a
t of
      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 "|\n"
      Bin _ kx :: k
kx x :: a
x Tip 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 "\n"
      Bin _ kx :: k
kx x :: a
x l :: Map k a
l r :: 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 "\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 :: (k -> a -> String)
-> Bool -> [String] -> Map k a -> String -> String
showsTreeHang showelem :: k -> a -> String
showelem wide :: Bool
wide bars :: [String]
bars t :: Map k a
t
  = case Map k a
t of
      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 "|\n"
      Bin _ kx :: k
kx x :: a
x Tip 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 "\n"
      Bin _ kx :: k
kx x :: a
x l :: Map k a
l r :: 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 "\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 wide :: Bool
wide bars :: [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 "|\n"
  | Bool
otherwise = String -> String
forall a. a -> a
id

showsBars :: [String] -> ShowS
showsBars :: [String] -> String -> String
showsBars bars :: [String]
bars
  = case [String]
bars of
      [] -> String -> String
forall a. a -> a
id
      _  -> String -> String -> String
showString ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]
forall a. [a] -> [a]
tail [String]
bars))) (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           = "+--"

withBar, withEmpty :: [String] -> [String]
withBar :: [String] -> [String]
withBar bars :: [String]
bars   = "|  "String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
bars
withEmpty :: [String] -> [String]
withEmpty bars :: [String]
bars = "   "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 :: Map k a -> Bool
valid t :: 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 a b. Ord a => Map a b -> 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 :: Map a b -> Bool
ordered t :: Map a b
t
  = (a -> Bool) -> (a -> Bool) -> Map a b -> Bool
forall a a. Ord a => (a -> Bool) -> (a -> Bool) -> Map a 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 :: (a -> Bool) -> (a -> Bool) -> Map a a -> Bool
bounded lo :: a -> Bool
lo hi :: a -> Bool
hi t' :: Map a a
t'
      = case Map a a
t' of
          Tip              -> Bool
True
          Bin _ kx :: a
kx _ l :: Map a a
l r :: Map a a
r  -> (a -> Bool
lo a
kx) Bool -> Bool -> Bool
&& (a -> Bool
hi a
kx) Bool -> Bool -> Bool
&& (a -> Bool) -> (a -> Bool) -> Map a a -> Bool
bounded a -> Bool
lo (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
kx) Map a a
l Bool -> Bool -> Bool
&& (a -> Bool) -> (a -> Bool) -> Map a a -> Bool
bounded (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
kx) a -> Bool
hi Map a a
r

-- | Test if a map obeys the balance invariants.
balanced :: Map k a -> Bool
balanced :: Map k a -> Bool
balanced t :: Map k a
t
  = case Map k a
t of
      Tip            -> Bool
True
      Bin _ _ _ l :: Map k a
l r :: Map k a
r  -> (Map k a -> Int
forall k a. Map k a -> Int
size Map k a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map k a -> Int
forall k a. Map k a -> Int
size Map k a
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 Bool -> Bool -> Bool
|| (Map k a -> Int
forall k a. Map k a -> Int
size Map k a
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Map k a -> Int
forall k a. Map k a -> Int
size Map k a
r Bool -> Bool -> Bool
&& Map k a -> Int
forall k a. Map k a -> Int
size Map k a
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Map k a -> Int
forall k a. Map k a -> Int
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 :: Map a b -> Bool
validsize t :: Map a b
t = case Map a b -> Maybe Int
forall k a. Map k a -> Maybe Int
slowSize Map a b
t of
      Nothing -> Bool
False
      Just _ -> Bool
True
  where
    slowSize :: Map k a -> Maybe Int
slowSize Tip = Int -> Maybe Int
forall a. a -> Maybe a
Just 0
    slowSize (Bin sz :: Int
sz _ _ l :: Map k a
l r :: Map k a
r) = do
            Int
ls <- Map k a -> Maybe Int
slowSize Map k a
l
            Int
rs <- Map k a -> Maybe Int
slowSize Map k a
r
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
            Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
sz