{-# LANGUAGE CPP #-}
#include "containers.h"
moduleData.Map.Internal.DebugwhereimportData.Map.Internal (Map (..),size ,delta )importControl.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 ::(Showk ,Showa )=>Map k a ->StringshowTree :: 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
TrueBool
FalseMap k a
m whereshowElem :: a -> a -> String
showElem a
k a
x =a -> String
forall a. Show a => a -> String
showa
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
showa
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 ->StringshowTreeWith :: 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 ->ShowSshowsTree :: 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 =caseMap k a
t ofMap 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
showStringString
"|\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
showStringString
"\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
showStringString
"\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 ->ShowSshowsTreeHang :: 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 =caseMap k a
t ofMap 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
showStringString
"|\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
showStringString
"\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
showStringString
"\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->StringshowWide :: 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
showStringString
"|\n"|Bool
otherwise=String -> String
forall a. a -> a
idshowsBars ::[String]->ShowSshowsBars :: [String] -> String -> String
showsBars [String]
bars =case[String]
bars of[]->String -> String
forall a. a -> a
idString
_:[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
showStringString
node node ::Stringnode :: 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")]) == Falsevalid ::Ordk =>Map k a ->Boolvalid :: 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 ::Orda =>Map a b ->Boolordered :: 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
constBool
True)(Bool -> a -> Bool
forall a b. a -> b -> a
constBool
True)Map a b
t wherebounded :: (t -> Bool) -> (t -> Bool) -> Map t a -> Bool
bounded t -> Bool
lo t -> Bool
hi Map t a
t' =caseMap t a
t' ofMap t a
Tip ->Bool
TrueBin 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 ->Boolbalanced :: forall k a. Map k a -> Bool
balanced Map k a
t =caseMap k a
t ofMap k a
Tip ->Bool
TrueBin 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
1Bool -> 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
delta 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 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
delta 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
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 ->Boolvalidsize :: forall k a. Map k a -> Bool
validsize Map a b
t =caseMap a b -> Maybe Size
forall {k} {a}. Map k a -> Maybe Size
slowSize Map a b
t ofMaybe Size
Nothing->Bool
FalseJustSize
_->Bool
TruewhereslowSize :: Map k a -> Maybe Size
slowSize Map k a
Tip =Size -> Maybe Size
forall a. a -> Maybe a
JustSize
0slowSize (Bin Size
sz k
_a
_Map k a
l Map k a
r )=doSize
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
returnSize
sz