{-# 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 = drawVT . vpTree drawVT :: (Show a, PrintfArg d) => VT d a -> IO () drawVT = putStrLn . toStringVT toStringVT :: (Show a, PrintfArg d) => VT d a -> String toStringVT = B.render . toBox toBox :: (Show a, PrintfArg d) => VT d a -> B.Box toBox = \case (Bin d x tl tr) -> txt (node x d) `stack` (toBox tl `byside` toBox tr) Tip x -> txt $ show x -- Nil -> txt "*" where node x d = printf "%s,%5.2f" (show x) d -- nodeBox x d = -- txt (printf "%s,%5.2f" (show x) d) txt :: String -> B.Box txt t = spc `byside` B.text t `byside` spc where spc = B.emptyBox 1 1 byside :: B.Box -> B.Box -> B.Box byside l r = B.hcat B.top [l, r] stack :: B.Box -> B.Box -> B.Box stack t b = B.vcat B.center1 [t, b]