Draw.hs

{-# 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