module Data.Patricia.Word.Lazy.Debug
(
showsTree
, Validity (..)
, Reason (..)
, validate
) where
import Data.Patricia.Word.Debug
import Data.Patricia.Word.Lazy.Internal
import Numeric.Long
import Radix.Word.Debug
showsTree :: (a -> ShowS) -> Patricia a -> ShowS
showsTree :: forall a. (a -> ShowS) -> Patricia a -> ShowS
showsTree a -> ShowS
f = Int -> Patricia a -> ShowS
go Int
0
where
go :: Int -> Patricia a -> ShowS
go Int
i Patricia a
t =
[Char] -> ShowS
forall a. Monoid a => a -> a -> a
mappend (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
i Char
' ') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
case Patricia a
t of
Bin Prefix
p Patricia a
l Patricia a
r ->
[Char] -> ShowS
showString [Char]
"Bin " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prefix -> ShowS
forall a. (FiniteBits a, Integral a, Num a) => a -> ShowS
showPrefix Prefix
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n'
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Patricia a -> ShowS
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Patricia a
l ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n'
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Patricia a -> ShowS
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Patricia a
r
Tip Prefix
k a
a ->
[Char] -> ShowS
showString [Char]
"Tip " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prefix -> ShowS
forall a. (FiniteBits a, Integral a, Num a) => a -> ShowS
showLongHex Prefix
k ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" => " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
a
Patricia a
Nil -> [Char] -> ShowS
showString [Char]
"Nil"
validate :: Patricia a -> Validity
validate :: forall a. Patricia a -> Validity
validate Patricia a
t =
case Patricia a
t of
Bin Prefix
p Patricia a
l Patricia a
r
| Prefix
p Prefix -> Prefix -> Bool
forall a. Eq a => a -> a -> Bool
== Prefix
0 -> Reason -> Validity
Invalid Reason
ZeroPrefix
| Bool
otherwise ->
case S -> Prefix -> Patricia a -> Validity
forall {a}. S -> Prefix -> Patricia a -> Validity
go S
L Prefix
p Patricia a
l of
Validity
Valid -> S -> Prefix -> Patricia a -> Validity
forall {a}. S -> Prefix -> Patricia a -> Validity
go S
R Prefix
p Patricia a
r
Validity
err -> Validity
err
Tip Prefix
_ a
_ -> Validity
Valid
Patricia a
Nil -> Validity
Valid
where
go :: S -> Prefix -> Patricia a -> Validity
go S
s Prefix
q Patricia a
x =
case Patricia a
x of
Bin Prefix
p Patricia a
l Patricia a
r
| Prefix
p Prefix -> Prefix -> Bool
forall a. Eq a => a -> a -> Bool
== Prefix
0 -> Reason -> Validity
Invalid Reason
ZeroPrefix
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Prefix -> S -> Prefix -> Bool
validBelow Prefix
q S
s Prefix
p -> Reason -> Validity
Invalid (Reason -> Validity) -> Reason -> Validity
forall a b. (a -> b) -> a -> b
$ Prefix -> Prefix -> Reason
PrefixBelow Prefix
q Prefix
p
| Bool
otherwise ->
case S -> Prefix -> Patricia a -> Validity
go S
L Prefix
p Patricia a
l of
Validity
Valid -> S -> Prefix -> Patricia a -> Validity
go S
R Prefix
p Patricia a
r
Validity
err -> Validity
err
Tip Prefix
k a
_
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Prefix -> S -> Prefix -> Bool
validBelow Prefix
q S
s Prefix
k -> Reason -> Validity
Invalid (Reason -> Validity) -> Reason -> Validity
forall a b. (a -> b) -> a -> b
$ Prefix -> Prefix -> Reason
KeyBelow Prefix
q Prefix
k
| Bool
otherwise -> Validity
Valid
Patricia a
Nil -> Reason -> Validity
Invalid (Reason -> Validity) -> Reason -> Validity
forall a b. (a -> b) -> a -> b
$ Prefix -> Reason
MalformedBin Prefix
q