Draw.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveFunctor #-}

module Cursor.Tree.Draw
  ( drawTreeCursor
  , treeCursorWithPointer
  , showCForest
  , showCTree
  , showForest
  , showTree
  ) where

import qualified Data.List.NonEmpty as NE
import Data.Tree

import Cursor.Tree.Types

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: " ++)) $ map 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