{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} module Cursor.Tree.Draw ( drawTreeCursor, treeCursorWithPointer, showCForest, showCTree, showForest, showTree, ) where import Cursor.Tree.Types import qualified Data.List.NonEmpty as NE import Data.Tree drawTreeCursor :: (Show a, Show b) => TreeCursor a b -> String drawTreeCursor = drawTree . treeCursorWithPointer treeCursorWithPointer :: (Show a, Show b) => TreeCursor a b -> Tree String treeCursorWithPointer TreeCursor {..} = wrapAbove treeAbove $ Node (show treeCurrent ++ " <---") $ showCForest treeBelow where wrapAbove :: (Show b) => Maybe (TreeAbove b) -> Tree String -> Tree String wrapAbove Nothing t = t wrapAbove (Just TreeAbove {..}) t = wrapAbove treeAboveAbove $ Node (show treeAboveNode) $ concat [map showCTree $ reverse treeAboveLefts, [t], map showCTree treeAboveRights] showCForest :: Show a => CForest a -> Forest String showCForest EmptyCForest = [] showCForest (ClosedForest ts) = map (fmap ("hidden: " ++) . showTree) $ NE.toList ts showCForest (OpenForest ts) = map showCTree $ NE.toList ts showCTree :: Show a => CTree a -> Tree String showCTree (CNode n fs) = Node (show n) $ showCForest fs showForest :: Show a => Forest a -> Forest String showForest = map showTree showTree :: Show a => Tree a -> Tree String showTree = fmap show