{-# LANGUAGE LambdaCase #-}
{-# options_ghc -Wno-unused-imports #-}
module Data.VPTree.Draw (
  draw, drawVT
  -- * helpers
  , toStringVT
  ) where

import Text.Printf (PrintfArg, printf)
import Data.VPTree.Internal (VPTree(..), VT(..))

-- boxes
import qualified Text.PrettyPrint.Boxes as B (Box, render, emptyBox, vcat, hcat, text, top, bottom, center1)

-- | Render a tree to stdout
--
-- Useful for debugging
--
-- This should be called only for small trees, otherwise the printed result quickly overflows the screen and becomes hard to read.
--
-- NB : prints distance information rounded to two decimal digits
draw :: (Show a, PrintfArg d) => VPTree d a -> IO ()
draw :: VPTree d a -> IO ()
draw = VT d a -> IO ()
forall a d. (Show a, PrintfArg d) => VT d a -> IO ()
drawVT (VT d a -> IO ()) -> (VPTree d a -> VT d a) -> VPTree d a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VPTree d a -> VT d a
forall d a. VPTree d a -> VT d a
vpTree

drawVT :: (Show a, PrintfArg d) => VT d a -> IO ()
drawVT :: VT d a -> IO ()
drawVT = String -> IO ()
putStrLn (String -> IO ()) -> (VT d a -> String) -> VT d a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VT d a -> String
forall a d. (Show a, PrintfArg d) => VT d a -> String
toStringVT

toStringVT :: (Show a, PrintfArg d) => VT d a -> String
toStringVT :: VT d a -> String
toStringVT = Box -> String
B.render (Box -> String) -> (VT d a -> Box) -> VT d a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VT d a -> Box
forall a d. (Show a, PrintfArg d) => VT d a -> Box
toBox

toBox :: (Show a, PrintfArg d) => VT d a -> B.Box
toBox :: VT d a -> Box
toBox = \case
  (Bin d
d a
x VT d a
tl VT d a
tr) ->
    String -> Box
txt (a -> d -> String
forall t t a. (PrintfArg t, PrintfType t, Show a) => a -> t -> t
node a
x d
d) Box -> Box -> Box
`stack` (VT d a -> Box
forall a d. (Show a, PrintfArg d) => VT d a -> Box
toBox VT d a
tl Box -> Box -> Box
`byside` VT d a -> Box
forall a d. (Show a, PrintfArg d) => VT d a -> Box
toBox VT d a
tr)
  Tip Vector a
x -> String -> Box
txt (String -> Box) -> String -> Box
forall a b. (a -> b) -> a -> b
$ Vector a -> String
forall a. Show a => a -> String
show Vector a
x
  -- Nil   -> txt "*"
  where
    node :: a -> t -> t
node a
x t
d = String -> String -> t -> t
forall r. PrintfType r => String -> r
printf String
"%s,%5.2f" (a -> String
forall a. Show a => a -> String
show a
x) t
d
    -- nodeBox x d =
    --   txt (printf "%s,%5.2f" (show x) d)

txt :: String -> B.Box
txt :: String -> Box
txt String
t = Box
spc Box -> Box -> Box
`byside` String -> Box
B.text String
t Box -> Box -> Box
`byside` Box
spc
  where spc :: Box
spc = Int -> Int -> Box
B.emptyBox Int
1 Int
1

byside :: B.Box -> B.Box -> B.Box
byside :: Box -> Box -> Box
byside Box
l Box
r = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
B.hcat Alignment
B.top [Box
l, Box
r]

stack :: B.Box -> B.Box -> B.Box
stack :: Box -> Box -> Box
stack Box
t Box
b = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
B.vcat Alignment
B.center1 [Box
t, Box
b]