{-# 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 :: TreeCursor a b -> String
drawTreeCursor = Tree String -> String
drawTree (Tree String -> String)
-> (TreeCursor a b -> Tree String) -> TreeCursor a b -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeCursor a b -> Tree String
forall a b. (Show a, Show b) => TreeCursor a b -> Tree String
treeCursorWithPointer

treeCursorWithPointer :: (Show a, Show b) => TreeCursor a b -> Tree String
treeCursorWithPointer :: TreeCursor a b -> Tree String
treeCursorWithPointer TreeCursor {a
Maybe (TreeAbove b)
CForest b
treeBelow :: forall a b. TreeCursor a b -> CForest b
treeCurrent :: forall a b. TreeCursor a b -> a
treeAbove :: forall a b. TreeCursor a b -> Maybe (TreeAbove b)
treeBelow :: CForest b
treeCurrent :: a
treeAbove :: Maybe (TreeAbove b)
..} =
  Maybe (TreeAbove b) -> Tree String -> Tree String
forall b.
Show b =>
Maybe (TreeAbove b) -> Tree String -> Tree String
wrapAbove Maybe (TreeAbove b)
treeAbove (Tree String -> Tree String) -> Tree String -> Tree String
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Node (a -> String
forall a. Show a => a -> String
show a
treeCurrent String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" <---") (Forest String -> Tree String) -> Forest String -> Tree String
forall a b. (a -> b) -> a -> b
$ CForest b -> Forest String
forall a. Show a => CForest a -> Forest String
showCForest CForest b
treeBelow
  where
    wrapAbove :: (Show b) => Maybe (TreeAbove b) -> Tree String -> Tree String
    wrapAbove :: Maybe (TreeAbove b) -> Tree String -> Tree String
wrapAbove Maybe (TreeAbove b)
Nothing Tree String
t = Tree String
t
    wrapAbove (Just TreeAbove {b
[CTree b]
Maybe (TreeAbove b)
treeAboveRights :: forall b. TreeAbove b -> [CTree b]
treeAboveNode :: forall b. TreeAbove b -> b
treeAboveAbove :: forall b. TreeAbove b -> Maybe (TreeAbove b)
treeAboveLefts :: forall b. TreeAbove b -> [CTree b]
treeAboveRights :: [CTree b]
treeAboveNode :: b
treeAboveAbove :: Maybe (TreeAbove b)
treeAboveLefts :: [CTree b]
..}) Tree String
t =
      Maybe (TreeAbove b) -> Tree String -> Tree String
forall b.
Show b =>
Maybe (TreeAbove b) -> Tree String -> Tree String
wrapAbove Maybe (TreeAbove b)
treeAboveAbove (Tree String -> Tree String) -> Tree String -> Tree String
forall a b. (a -> b) -> a -> b
$
        String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Node (b -> String
forall a. Show a => a -> String
show b
treeAboveNode) (Forest String -> Tree String) -> Forest String -> Tree String
forall a b. (a -> b) -> a -> b
$
          [Forest String] -> Forest String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(CTree b -> Tree String) -> [CTree b] -> Forest String
forall a b. (a -> b) -> [a] -> [b]
map CTree b -> Tree String
forall a. Show a => CTree a -> Tree String
showCTree ([CTree b] -> Forest String) -> [CTree b] -> Forest String
forall a b. (a -> b) -> a -> b
$ [CTree b] -> [CTree b]
forall a. [a] -> [a]
reverse [CTree b]
treeAboveLefts, [Tree String
t], (CTree b -> Tree String) -> [CTree b] -> Forest String
forall a b. (a -> b) -> [a] -> [b]
map CTree b -> Tree String
forall a. Show a => CTree a -> Tree String
showCTree [CTree b]
treeAboveRights]

showCForest :: Show a => CForest a -> Forest String
showCForest :: CForest a -> Forest String
showCForest CForest a
EmptyCForest = []
showCForest (ClosedForest NonEmpty (Tree a)
ts) = (Tree a -> Tree String) -> [Tree a] -> Forest String
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> Tree String -> Tree String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"hidden: " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (Tree String -> Tree String)
-> (Tree a -> Tree String) -> Tree a -> Tree String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> Tree String
forall a. Show a => Tree a -> Tree String
showTree) ([Tree a] -> Forest String) -> [Tree a] -> Forest String
forall a b. (a -> b) -> a -> b
$ NonEmpty (Tree a) -> [Tree a]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Tree a)
ts
showCForest (OpenForest NonEmpty (CTree a)
ts) = (CTree a -> Tree String) -> [CTree a] -> Forest String
forall a b. (a -> b) -> [a] -> [b]
map CTree a -> Tree String
forall a. Show a => CTree a -> Tree String
showCTree ([CTree a] -> Forest String) -> [CTree a] -> Forest String
forall a b. (a -> b) -> a -> b
$ NonEmpty (CTree a) -> [CTree a]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (CTree a)
ts

showCTree :: Show a => CTree a -> Tree String
showCTree :: CTree a -> Tree String
showCTree (CNode a
n CForest a
fs) = String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Node (a -> String
forall a. Show a => a -> String
show a
n) (Forest String -> Tree String) -> Forest String -> Tree String
forall a b. (a -> b) -> a -> b
$ CForest a -> Forest String
forall a. Show a => CForest a -> Forest String
showCForest CForest a
fs

showForest :: Show a => Forest a -> Forest String
showForest :: Forest a -> Forest String
showForest = (Tree a -> Tree String) -> Forest a -> Forest String
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> Tree String
forall a. Show a => Tree a -> Tree String
showTree

showTree :: Show a => Tree a -> Tree String
showTree :: Tree a -> Tree String
showTree = (a -> String) -> Tree a -> Tree String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> String
forall a. Show a => a -> String
show