{-# LANGUAGE PatternSynonyms #-}

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

module Data.RRBVector.Internal.Debug
    ( showTree
    , fromListUnbalanced
    , pattern Empty, pattern Root
    , Tree, Shift
    , pattern Balanced, pattern Unbalanced, pattern Leaf
    ) where

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

import Data.RRBVector.Internal hiding (Empty, Root, Balanced, Unbalanced, Leaf)
import qualified Data.RRBVector.Internal as RRB
import Data.RRBVector.Internal.Array (Array)
import qualified Data.RRBVector.Internal.Buffer as Buffer

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

    debugShowArray :: Array (Tree a) -> String
debugShowArray Array (Tree a)
arr = String
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree a -> String
debugShowTree (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array (Tree a)
arr)) 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 :: forall a. [a] -> Vector a
fromListUnbalanced [] = forall a. Vector a
RRB.Empty
fromListUnbalanced [a
x] = forall a. a -> Vector a
singleton a
x
fromListUnbalanced [a]
ls = case forall {a} {a}. (Array a -> a) -> [a] -> [a]
nodes forall a. Array a -> Tree a
RRB.Leaf [a]
ls of
    [Tree a
tree] -> forall a. Int -> Int -> Tree a -> Vector a
RRB.Root (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' -> forall {a}. Int -> [Tree a] -> Vector a
iterateNodes Int
blockShift [Tree a]
ls'
  where
    n :: Int
n = Int
blockSize forall a. Num a => a -> a -> a
- Int
1

    nodes :: (Array a -> a) -> [a] -> [a]
nodes Array a -> a
f [a]
trees = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        Buffer s a
buffer <- forall s a. Int -> ST s (Buffer s a)
Buffer.new Int
n
        let loop :: [a] -> ST s [a]
loop [] = do
                Array a
result <- forall s a. Buffer s a -> ST s (Array a)
Buffer.get Buffer s a
buffer
                forall (f :: * -> *) a. Applicative f => a -> f a
pure [Array a -> a
f Array a
result]
            loop (a
t : [a]
ts) = do
                Int
size <- forall s a. Buffer s a -> ST s Int
Buffer.size Buffer s a
buffer
                if Int
size forall a. Eq a => a -> a -> Bool
== Int
n then do
                    Array a
result <- forall s a. Buffer s a -> ST s (Array a)
Buffer.get Buffer s a
buffer
                    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
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array a -> a
f Array a
result forall a. a -> [a] -> [a]
: [a]
rest)
                else do
                    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 forall {a} {a}. (Array a -> a) -> [a] -> [a]
nodes (forall a. Int -> Array (Tree a) -> Tree a
computeSizes Int
sh) [Tree a]
trees of
        [Tree a
tree] -> forall a. Int -> Int -> Tree a -> Vector a
RRB.Root (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'

pattern Empty :: Vector a
pattern $mEmpty :: forall {r} {a}. Vector a -> ((# #) -> r) -> ((# #) -> r) -> r
Empty <- RRB.Empty

pattern Root :: Int -> Shift -> Tree a -> Vector a
pattern $mRoot :: forall {r} {a}.
Vector a -> (Int -> Int -> Tree a -> r) -> ((# #) -> r) -> r
Root size sh tree <- RRB.Root size sh tree

{-# COMPLETE Empty, Root #-}

pattern Balanced :: Array (Tree a) -> Tree a
pattern $mBalanced :: forall {r} {a}.
Tree a -> (Array (Tree a) -> r) -> ((# #) -> r) -> r
Balanced arr <- RRB.Balanced arr

pattern Unbalanced :: Array (Tree a) -> PrimArray Int -> Tree a
pattern $mUnbalanced :: forall {r} {a}.
Tree a
-> (Array (Tree a) -> PrimArray Int -> r) -> ((# #) -> r) -> r
Unbalanced arr sizes <- RRB.Unbalanced arr sizes

pattern Leaf :: Array a -> Tree a
pattern $mLeaf :: forall {r} {a}. Tree a -> (Array a -> r) -> ((# #) -> r) -> r
Leaf arr <- RRB.Leaf arr

{-# COMPLETE Balanced, Unbalanced, Leaf #-}