module Data.Tree.View
( showTree
, drawTree
, NodeInfo (..)
, htmlTree
, writeHtmlTree
) where
import Control.Monad.State
import Data.Traversable (traverse)
import Data.Tree (Tree (..))
import qualified Data.Tree as Tree
indentInit :: [String] -> [String]
indentInit [] = []
indentInit (s:ss) = (" ├╴" ++ s) : map (" │ " ++) ss
indentLast :: [String] -> [String]
indentLast [] = []
indentLast (s:ss) = (" └╴" ++ s) : map (" " ++) ss
indentChildren :: [[String]] -> [[String]]
indentChildren [] = []
indentChildren ns = map indentInit (init ns) ++ [indentLast (last ns)]
appLast :: [String] -> String -> [String]
appLast ss s = init ss ++ [last ss ++ s]
showTree' :: Tree String -> [String]
showTree' (Node n ns) = n : concat (indentChildren (map showTree' ns))
-- | Show a 'Tree' using Unicode art
showTree :: Tree String -> String
showTree = unlines . showTree'
-- | Draw a 'Tree' on the terminal using Unicode art
--
-- Example:
--
-- > *Data.Tree.View> drawTree $ Node "Add" [Node "Sub" [Node "3" [], Node "Mul" [Node "1" [], Node "2" []]], Node "4" []]
-- > Add
-- > ├╴Sub
-- > │ ├╴3
-- > │ └╴Mul
-- > │ ├╴1
-- > │ └╴2
-- > └╴4
drawTree :: Tree String -> IO ()
drawTree = putStrLn . showTree
enumTree :: Tree a -> Tree (a,Int)
enumTree = flip evalState 0 . traverse count
where
count :: a -> State Int (a,Int)
count a = do
i <- get; put (i+1)
return (a,i)
-- | A tree node
data NodeInfo = NodeInfo
{ nodeName :: String -- ^ Node name (to be displayed in the HTML tree view)
, nodeInfo :: String -- ^ Additional information (to be displayed when hovering the mouse over
-- the node). This field may contain line breaks.
}
htmlNode :: (NodeInfo, Int) -> String
htmlNode (n,i)
= ""
++ nodeName n
++ ""
showTreeHtml' :: Tree (NodeInfo, Int) -> [String]
showTreeHtml' (Node n []) = [htmlNode n]
showTreeHtml' (Node n ns)
= [htmlNode n ++ ""]
++ appLast (concat (indentChildren (map showTreeHtml' ns))) ""
-- | Convert a 'Tree' to HTML with foldable nodes
htmlTree :: Tree NodeInfo -> String
htmlTree tree = unlines $ lines template1 ++ showTreeHtml' (enumTree tree) ++ lines template2
-- | Convert a 'Tree' to an HTML file with foldable nodes
writeHtmlTree :: FilePath -> Tree NodeInfo -> IO ()
writeHtmlTree file = writeFile file . htmlTree
template1 =
"\n\
\\n\
\\n\
\\n\
\ \n\
\ Tree view\n\
\ \n\
\ \n\
\\n\
\\n\
\\n\
\\n"
template2 =
"
\n\
\\n\
\\n\
\\n"