{-|
    Safe functions for datatype introspection.
 -}

module Data.Patricia.Word.Lazy.Debug
  ( -- * Show
    showsTree

    -- * Validate
  , Validity (..)
  , Reason (..)
  , validate
  ) where

import           Data.Patricia.Word.Debug
import           Data.Patricia.Word.Lazy.Internal
import           Numeric.Long
import           Radix.Word.Debug



-- | \(\mathcal{O}(n)\).
--   Shows the internal structure of the tree.
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"



-- | \(\mathcal{O}(n)\).
--   Checks whether the tree is well-formed.
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