{-# 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 :: forall k a. (Show k, Show a) => Map k a -> String
showTree Map k a
m
  = forall k a. (k -> a -> String) -> Bool -> Bool -> Map k a -> String
showTreeWith 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  = forall a. Show a => a -> String
show a
k forall a. [a] -> [a] -> [a]
++ String
":=" forall a. [a] -> [a] -> [a]
++ 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 :: 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      = (forall k a.
(k -> a -> String) -> Bool -> [String] -> Map k a -> ShowS
showsTreeHang k -> a -> String
showelem Bool
wide [] Map k a
t) String
""
  | Bool
otherwise = (forall k a.
(k -> a -> String)
-> Bool -> [String] -> [String] -> Map k a -> ShowS
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 -> ShowS
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] -> ShowS
showsBars [String]
lbars forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"|\n"
      Bin Size
_ k
kx a
x Map k a
Tip Map k a
Tip
          -> [String] -> ShowS
showsBars [String]
lbars forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (k -> a -> String
showelem k
kx a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\n"
      Bin Size
_ k
kx a
x Map k a
l Map k a
r
          -> forall k a.
(k -> a -> String)
-> Bool -> [String] -> [String] -> Map k a -> ShowS
showsTree k -> a -> String
showelem Bool
wide ([String] -> [String]
withBar [String]
rbars) ([String] -> [String]
withEmpty [String]
rbars) Map k a
r forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [String] -> ShowS
showWide Bool
wide [String]
rbars forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [String] -> ShowS
showsBars [String]
lbars forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (k -> a -> String
showelem k
kx a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [String] -> ShowS
showWide Bool
wide [String]
lbars forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             forall k a.
(k -> a -> String)
-> Bool -> [String] -> [String] -> Map k a -> ShowS
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 -> ShowS
showsTreeHang k -> a -> String
showelem Bool
wide [String]
bars Map k a
t
  = case Map k a
t of
      Map k a
Tip -> [String] -> ShowS
showsBars [String]
bars forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"|\n"
      Bin Size
_ k
kx a
x Map k a
Tip Map k a
Tip
          -> [String] -> ShowS
showsBars [String]
bars forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (k -> a -> String
showelem k
kx a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\n"
      Bin Size
_ k
kx a
x Map k a
l Map k a
r
          -> [String] -> ShowS
showsBars [String]
bars forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (k -> a -> String
showelem k
kx a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [String] -> ShowS
showWide Bool
wide [String]
bars forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             forall k a.
(k -> a -> String) -> Bool -> [String] -> Map k a -> ShowS
showsTreeHang k -> a -> String
showelem Bool
wide ([String] -> [String]
withBar [String]
bars) Map k a
l forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [String] -> ShowS
showWide Bool
wide [String]
bars forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             forall k a.
(k -> a -> String) -> Bool -> [String] -> Map k a -> ShowS
showsTreeHang k -> a -> String
showelem Bool
wide ([String] -> [String]
withEmpty [String]
bars) Map k a
r

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

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

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

withBar, withEmpty :: [String] -> [String]
withBar :: [String] -> [String]
withBar [String]
bars   = String
"|  "forall a. a -> [a] -> [a]
:[String]
bars
withEmpty :: [String] -> [String]
withEmpty [String]
bars = 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
  = forall k a. Map k a -> Bool
balanced Map k a
t Bool -> Bool -> Bool
&& forall k a. Ord k => Map k a -> Bool
ordered Map k a
t Bool -> Bool -> 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
  = forall {t} {a}.
Ord t =>
(t -> Bool) -> (t -> Bool) -> Map t a -> Bool
bounded (forall a b. a -> b -> a
const Bool
True) (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 (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 (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  -> (forall k a. Map k a -> Size
size Map k a
l forall a. Num a => a -> a -> a
+ forall k a. Map k a -> Size
size Map k a
r forall a. Ord a => a -> a -> Bool
<= Size
1 Bool -> Bool -> Bool
|| (forall k a. Map k a -> Size
size Map k a
l forall a. Ord a => a -> a -> Bool
<= Size
deltaforall a. Num a => a -> a -> a
*forall k a. Map k a -> Size
size Map k a
r Bool -> Bool -> Bool
&& forall k a. Map k a -> Size
size Map k a
r forall a. Ord a => a -> a -> Bool
<= Size
deltaforall a. Num a => a -> a -> a
*forall k a. Map k a -> Size
size Map k a
l)) Bool -> Bool -> Bool
&&
                        forall k a. Map k a -> Bool
balanced Map k a
l Bool -> Bool -> 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 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 = 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
            forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Size
sz forall a. Eq a => a -> a -> Bool
== Size
ls forall a. Num a => a -> a -> a
+ Size
rs forall a. Num a => a -> a -> a
+ Size
1)
            forall (m :: * -> *) a. Monad m => a -> m a
return Size
sz