module Data.RadixNTree.Word8.Strict.Debug
  ( showsTree0
  , showsTree1

  , Validity (..)
  , Reason (..)
  , validate0
  , validate1
  ) where

import           Data.ByteArray.NonEmpty
import           Data.RadixNTree.Word8.Debug
import           Data.RadixNTree.Word8.Key
import           Data.RadixNTree.Word8.Strict
import           Numeric.Long
import           Radix.Word8.Debug

import           Data.List.NonEmpty (NonEmpty (..))
import           Data.Primitive.ByteArray



showsTree0 :: (a -> ShowS) -> RadixTree a -> ShowS
showsTree0 :: forall a. (a -> ShowS) -> RadixTree a -> ShowS
showsTree0 a -> ShowS
f (RadixTree Maybe a
mx Radix1Tree a
t) =
  String -> ShowS
showString String
"RadixTree" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case Maybe a
mx of
                             Just a
x  -> String -> ShowS
showString String
" => " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
x
                             Maybe a
Nothing -> ShowS
forall a. a -> a
id

                         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 -> (a -> ShowS) -> Radix1Tree a -> ShowS
forall a. Int -> (a -> ShowS) -> Radix1Tree a -> ShowS
showsTree_ Int
2 a -> ShowS
f Radix1Tree a
t

showsTree1 :: (a -> ShowS) -> Radix1Tree a -> ShowS
showsTree1 :: forall a. (a -> ShowS) -> Radix1Tree a -> ShowS
showsTree1 a -> ShowS
f = Int -> (a -> ShowS) -> Radix1Tree a -> ShowS
forall a. Int -> (a -> ShowS) -> Radix1Tree a -> ShowS
showsTree_ Int
0 a -> ShowS
f

showsTree_ :: Int -> (a -> ShowS) -> Radix1Tree a -> ShowS
showsTree_ :: forall a. Int -> (a -> ShowS) -> Radix1Tree a -> ShowS
showsTree_ Int
n0 a -> ShowS
f = Int -> Radix1Tree a -> ShowS
go Int
n0
  where
    go :: Int -> Radix1Tree a -> ShowS
go Int
i Radix1Tree a
t =
      String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' ') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        case Radix1Tree a
t of
          Bin Prefix
p Radix1Tree a
l Radix1Tree a
r   ->
            String -> ShowS
showString String
"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 -> Radix1Tree a -> ShowS
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Radix1Tree 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 -> Radix1Tree a -> ShowS
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Radix1Tree a
r

          Tip ByteArray
arr Maybe a
mx Radix1Tree a
dx ->
            String -> ShowS
showString String
"Tip " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. if ByteArray -> Int
sizeofByteArray ByteArray
arr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
                                  then ShowS
forall a. a -> a
id
                                  else let Prefix
w0 :| [Prefix]
ws = ByteArray -> NonEmpty Prefix
toNonEmpty ByteArray
arr
                                       in Prefix -> ShowS
forall a. (FiniteBits a, Integral a, Num a) => a -> ShowS
showLongBin Prefix
w0
                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" (" 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
w0 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'
                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Prefix -> ShowS -> ShowS) -> ShowS -> [Prefix] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Prefix
x ShowS
s -> Char -> ShowS
showChar Char
' ' 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
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) ShowS
forall a. a -> a
id [Prefix]
ws

                                 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case Maybe a
mx of
                                     Just a
x  -> String -> ShowS
showString String
" => " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
x
                                     Maybe a
Nothing -> ShowS
forall a. a -> a
id

                                 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 -> Radix1Tree a -> ShowS
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Radix1Tree a
dx

          Radix1Tree a
Nil           -> String -> ShowS
showString String
"Nil"



validate0 :: RadixTree a -> Validity
validate0 :: forall a. RadixTree a -> Validity
validate0 (RadixTree Maybe a
_ Radix1Tree a
t) = Radix1Tree a -> Validity
forall a. Radix1Tree a -> Validity
validate1 Radix1Tree a
t

validate1 :: Radix1Tree a -> Validity
validate1 :: forall a. Radix1Tree a -> Validity
validate1 = Tsil ByteArray -> Radix1Tree a -> Validity
forall {a}. Tsil ByteArray -> Radix1Tree a -> Validity
go Tsil ByteArray
forall a. Tsil a
Lin
  where
    go :: Tsil ByteArray -> Radix1Tree a -> Validity
go Tsil ByteArray
b Radix1Tree a
t =
      case Radix1Tree a
t of
        Bin Prefix
p Radix1Tree a
l Radix1Tree a
r
          | Prefix
p Prefix -> Prefix -> Bool
forall a. Eq a => a -> a -> Bool
== Prefix
0                 -> Build -> Reason -> Validity
Invalid (Tsil ByteArray -> Build
Build Tsil ByteArray
b) Reason
ZeroPrefix
          | Bool
otherwise              ->
              case S -> Tsil ByteArray -> Prefix -> Radix1Tree a -> Validity
goBin S
L Tsil ByteArray
b Prefix
p Radix1Tree a
l of
                Validity
Valid -> S -> Tsil ByteArray -> Prefix -> Radix1Tree a -> Validity
goBin S
R Tsil ByteArray
b Prefix
p Radix1Tree a
r
                Validity
err   -> Validity
err

        Tip ByteArray
arr Maybe a
mx Radix1Tree a
dx
          | ByteArray -> Int
sizeofByteArray ByteArray
arr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0       -> Build -> Reason -> Validity
Invalid (Tsil ByteArray -> Build
Build Tsil ByteArray
b) Reason
EmptyByteArray
          | Maybe a
Nothing <- Maybe a
mx, Tip ByteArray
_ Maybe a
_ Radix1Tree a
_ <- Radix1Tree a
dx -> Build -> Reason -> Validity
Invalid (Tsil ByteArray -> Build
Build Tsil ByteArray
b) Reason
UncompressedTip
          | Maybe a
Nothing <- Maybe a
mx, Radix1Tree a
Nil       <- Radix1Tree a
dx -> Build -> Reason -> Validity
Invalid (Tsil ByteArray -> Build
Build Tsil ByteArray
b) Reason
UncompressedTip
          | Bool
otherwise                      -> Tsil ByteArray -> Radix1Tree a -> Validity
go (Tsil ByteArray -> ByteArray -> Tsil ByteArray
forall a. Tsil a -> a -> Tsil a
Snoc Tsil ByteArray
b ByteArray
arr) Radix1Tree a
dx

        Radix1Tree a
Nil -> Validity
Valid

    goBin :: S -> Tsil ByteArray -> Prefix -> Radix1Tree a -> Validity
goBin S
s Tsil ByteArray
b Prefix
q Radix1Tree a
x =
      case Radix1Tree a
x of
        Bin Prefix
p Radix1Tree a
l Radix1Tree a
r
          | Prefix
p Prefix -> Prefix -> Bool
forall a. Eq a => a -> a -> Bool
== Prefix
0                 -> Build -> Reason -> Validity
Invalid (Tsil ByteArray -> Build
Build Tsil ByteArray
b) 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 -> Build -> Reason -> Validity
Invalid (Tsil ByteArray -> Build
Build Tsil ByteArray
b) (Reason -> Validity) -> Reason -> Validity
forall a b. (a -> b) -> a -> b
$ Prefix -> Prefix -> Reason
PrefixBelow Prefix
q Prefix
p
          | Bool
otherwise              ->
              case S -> Tsil ByteArray -> Prefix -> Radix1Tree a -> Validity
goBin S
L Tsil ByteArray
b Prefix
p Radix1Tree a
l of
                Validity
Valid -> S -> Tsil ByteArray -> Prefix -> Radix1Tree a -> Validity
goBin S
R Tsil ByteArray
b Prefix
p Radix1Tree a
r
                Validity
err   -> Validity
err

        Tip ByteArray
arr Maybe a
mx Radix1Tree a
dx
          | ByteArray -> Int
sizeofByteArray ByteArray
arr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0                    -> Build -> Reason -> Validity
Invalid (Tsil ByteArray -> Build
Build Tsil ByteArray
b) Reason
EmptyByteArray
          | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Prefix -> S -> Prefix -> Bool
validBelow Prefix
q S
s (ByteArray -> Int -> Prefix
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr Int
0) ->
              Build -> Reason -> Validity
Invalid (Tsil ByteArray -> Build
Build Tsil ByteArray
b) (Reason -> Validity) -> Reason -> Validity
forall a b. (a -> b) -> a -> b
$ Prefix -> Prefix -> Reason
KeyBelow Prefix
q (ByteArray -> Int -> Prefix
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr Int
0)

          | Maybe a
Nothing <- Maybe a
mx, Tip ByteArray
_ Maybe a
_ Radix1Tree a
_ <- Radix1Tree a
dx     -> Build -> Reason -> Validity
Invalid (Tsil ByteArray -> Build
Build Tsil ByteArray
b) Reason
UncompressedTip
          | Maybe a
Nothing <- Maybe a
mx, Radix1Tree a
Nil       <- Radix1Tree a
dx     -> Build -> Reason -> Validity
Invalid (Tsil ByteArray -> Build
Build Tsil ByteArray
b) Reason
UncompressedTip
          | Bool
otherwise                          -> Tsil ByteArray -> Radix1Tree a -> Validity
go (Tsil ByteArray -> ByteArray -> Tsil ByteArray
forall a. Tsil a -> a -> Tsil a
Snoc Tsil ByteArray
b ByteArray
arr) Radix1Tree a
dx

        Radix1Tree a
Nil -> Build -> Reason -> Validity
Invalid (Tsil ByteArray -> Build
Build Tsil ByteArray
b) (Reason -> Validity) -> Reason -> Validity
forall a b. (a -> b) -> a -> b
$ Prefix -> Reason
MalformedBin Prefix
q