{- |
This module contains some debug utilities. It should only be used for debugging/testing purposes.
-}

module Data.RRBVector.Internal.Debug
    ( showTree
    , fromListUnbalanced
    ) where

import Control.Monad.ST (runST)
import Data.Foldable (toList)
import Data.List (intercalate)
import Data.Primitive (primArrayToList)

import Data.RRBVector.Internal
import qualified Data.RRBVector.Internal.Buffer as Buffer

-- | \(O(n)\). Show the underlying tree of a vector.
showTree :: (Show a) => Vector a -> String
showTree :: Vector a -> String
showTree Vector a
Empty = String
"Empty"
showTree (Root Int
size Int
sh Tree a
tree) = String
"Root {size = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
size String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", shift = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sh String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", tree = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tree a -> String
forall a. Show a => Tree a -> String
debugShowTree Tree a
tree String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
  where
    debugShowTree :: Tree a -> String
debugShowTree (Balanced Array (Tree a)
arr) = String
"Balanced " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Array (Tree a) -> String
debugShowArray Array (Tree a)
arr
    debugShowTree (Unbalanced Array (Tree a)
arr PrimArray Int
sizes) = String
"Unbalanced " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Array (Tree a) -> String
debugShowArray Array (Tree a)
arr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
sizes) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    debugShowTree (Leaf Array a
arr) = String
"Leaf " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show (Array a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array a
arr)

    debugShowArray :: Array (Tree a) -> String
debugShowArray Array (Tree a)
arr = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((Tree a -> String) -> [Tree a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree a -> String
debugShowTree (Array (Tree a) -> [Tree a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array (Tree a)
arr)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

-- | \(O(n)\). Create a new unbalanced vector from a list.
--
-- Note that it is not possbible to create an invalid 'Vector' with this function.
fromListUnbalanced :: [a] -> Vector a
fromListUnbalanced :: [a] -> Vector a
fromListUnbalanced [] = Vector a
forall a. Vector a
Empty
fromListUnbalanced [a
x] = a -> Vector a
forall a. a -> Vector a
singleton a
x
fromListUnbalanced [a]
ls = case (Array a -> Tree a) -> [a] -> [Tree a]
forall a a. (Array a -> a) -> [a] -> [a]
nodes Array a -> Tree a
forall a. Array a -> Tree a
Leaf [a]
ls of
    [Tree a
tree] -> Int -> Int -> Tree a -> Vector a
forall a. Int -> Int -> Tree a -> Vector a
Root (Int -> Tree a -> Int
forall a. Int -> Tree a -> Int
treeSize Int
0 Tree a
tree) Int
0 Tree a
tree -- tree is a single leaf
    [Tree a]
ls' -> Int -> [Tree a] -> Vector a
forall a. Int -> [Tree a] -> Vector a
iterateNodes Int
blockShift [Tree a]
ls'
  where
    n :: Int
n = Int
blockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

    nodes :: (Array a -> a) -> [a] -> [a]
nodes Array a -> a
f [a]
trees = (forall s. ST s [a]) -> [a]
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s [a]) -> [a]) -> (forall s. ST s [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ do
        Buffer s a
buffer <- Int -> ST s (Buffer s a)
forall s a. Int -> ST s (Buffer s a)
Buffer.new Int
n
        let loop :: [a] -> ST s [a]
loop [] = do
                Array a
result <- Buffer s a -> ST s (Array a)
forall s a. Buffer s a -> ST s (Array a)
Buffer.get Buffer s a
buffer
                [a] -> ST s [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Array a -> a
f Array a
result]
            loop (a
t : [a]
ts) = do
                Int
size <- Buffer s a -> ST s Int
forall s a. Buffer s a -> ST s Int
Buffer.size Buffer s a
buffer
                if Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n then do
                    Array a
result <- Buffer s a -> ST s (Array a)
forall s a. Buffer s a -> ST s (Array a)
Buffer.get Buffer s a
buffer
                    Buffer s a -> a -> ST s ()
forall s a. Buffer s a -> a -> ST s ()
Buffer.push Buffer s a
buffer a
t
                    [a]
rest <- [a] -> ST s [a]
loop [a]
ts
                    [a] -> ST s [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array a -> a
f Array a
result a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rest)
                else do
                    Buffer s a -> a -> ST s ()
forall s a. Buffer s a -> a -> ST s ()
Buffer.push Buffer s a
buffer a
t
                    [a] -> ST s [a]
loop [a]
ts
        [a] -> ST s [a]
loop [a]
trees
    {-# INLINE nodes #-}

    iterateNodes :: Int -> [Tree a] -> Vector a
iterateNodes Int
sh [Tree a]
trees = case (Array (Tree a) -> Tree a) -> [Tree a] -> [Tree a]
forall a a. (Array a -> a) -> [a] -> [a]
nodes (Int -> Array (Tree a) -> Tree a
forall a. Int -> Array (Tree a) -> Tree a
computeSizes Int
sh) [Tree a]
trees of
        [Tree a
tree] -> Int -> Int -> Tree a -> Vector a
forall a. Int -> Int -> Tree a -> Vector a
Root (Int -> Tree a -> Int
forall a. Int -> Tree a -> Int
treeSize Int
sh Tree a
tree) Int
sh Tree a
tree
        [Tree a]
trees' -> Int -> [Tree a] -> Vector a
iterateNodes (Int -> Int
up Int
sh) [Tree a]
trees'