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