tree-view 0.4 → 0.5
raw patch · 2 files changed
+112/−32 lines, 2 files
Files
- src/Data/Tree/View.hs +111/−31
- tree-view.cabal +1/−1
src/Data/Tree/View.hs view
@@ -1,6 +1,7 @@ module Data.Tree.View ( showTree , drawTree+ , Behavior (..) , NodeInfo (..) , htmlTree , writeHtmlTree@@ -12,6 +13,7 @@ import Data.Traversable (traverse) import Data.Tree (Tree (..)) import qualified Data.Tree as Tree+import System.IO @@ -60,58 +62,136 @@ i <- get; put (i+1) return (a,i) +data Behavior+ = Fixed -- ^ Non-collapsible+ | InitiallyCollapsed+ | InitiallyExpanded+ -- | 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.+ { nodeBehavior :: Behavior+ , 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. } +escapeBrackets :: String -> String+escapeBrackets = concatMap fixBrack+ where+ fixBrack '<' = "<"+ fixBrack '>' = ">"+ fixBrack c = [c]+ htmlNode :: (NodeInfo, Int) -> String-htmlNode (n,i)- = "<span id=\"node"- ++ show i- ++ "\" class=\"node\" onclick=\"toggle(event)\" "- ++ "title=\""- ++ nodeInfo n- ++ "\""- ++ ">"- ++ nodeName n- ++ "</span>"+htmlNode (n,i) = concat+ [ "<span id=\"node"+ , show i+ , "\" class=\"node "+ , mode+ , "\""+ , onclick+ , "title=\""+ , nodeInfo n+ , "\""+ , ">"+ , escapeBrackets $ nodeName n+ , "</span>"+ ]+ where+ mode = case nodeBehavior n of+ Fixed -> "fixed"+ InitiallyCollapsed -> "interactive collapsed"+ InitiallyExpanded -> "interactive expanded"+ onclick = case nodeBehavior n of+ Fixed -> " "+ _ -> " onclick=\"toggle(event)\" " showTreeHtml' :: Tree (NodeInfo, Int) -> [String]-showTreeHtml' (Node n []) = [htmlNode n]+showTreeHtml' (Node (n,i) []) = [htmlNode (n {nodeBehavior = Fixed}, i)] showTreeHtml' (Node n ns)- = [htmlNode n ++ "<span id=\"children_node" ++ show (snd n) ++ "\" class=\"children\">"]+ = [ htmlNode n ++ "<span id=\"children_node" ++ show (snd n)+ ++ "\" class=" ++ display ++ ">"+ ] ++ appLast (concat (indentChildren (map showTreeHtml' ns))) "</span>"+ where+ display = case nodeBehavior $ fst n of+ InitiallyCollapsed -> show "hidden"+ _ -> show "shown" -- | Convert a 'Tree' to HTML with foldable nodes-htmlTree :: Tree NodeInfo -> String-htmlTree tree = unlines $ lines template1 ++ showTreeHtml' (enumTree tree) ++ lines template2+htmlTree+ :: Maybe FilePath -- ^ Path/URL to external CSS file+ -> Tree NodeInfo -- ^ Tree to render+ -> String+htmlTree css tree = unlines+ $ lines templatePre1+ ++ lines cssLink+ ++ lines cssTempl+ ++ lines templatePre2+ ++ showTreeHtml' (enumTree tree)+ ++ lines templatePost+ where+ cssTempl = case css of+ Nothing -> cssTemplate+ _ -> "" + cssLink = case css of+ Just file+ -> " <link rel=\"stylesheet\" href=\""+ ++ file+ ++ "\" type=\"text/css\" />"+ _ -> ""+ -- | Convert a 'Tree' to an HTML file with foldable nodes-writeHtmlTree :: FilePath -> Tree NodeInfo -> IO ()-writeHtmlTree file = writeFile file . htmlTree+writeHtmlTree+ :: Maybe FilePath -- ^ Path/URL to external CSS file+ -> FilePath -- ^ Output file+ -> Tree NodeInfo -- ^ Tree to render+ -> IO ()+writeHtmlTree css file tree = do+ h <- openFile file WriteMode+ hSetEncoding h utf8+ hPutStr h $ htmlTree css $ tree+ hClose h -template1 =+templatePre1 = "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\ \<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\ \\n\ \<head>\n\ \ <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\"/>\n\- \ <title>Tree view</title>\n\- \ <style type=\"text/css\">\n\+ \ <title>Tree view</title>\n"++cssTemplate =+ " <style type=\"text/css\">\n\ \ .node {\n\- \ color: blue;\n\+ \ }\n\+ \ .interactive:hover {\n\+ \ background-color: #CCC;\n\+ \ }\n\+ \ .collapsed {\n\+ \ cursor: pointer;\n\+ \ color: grey;\n\ \ font-weight: bold;\n\+ \ }\n\+ \ .expanded {\n\ \ cursor: pointer;\n\+ \ color: #009;\n\+ \ font-weight: bold;\n\ \ }\n\- \ .node:hover {\n\- \ background-color: #CCC;\n\+ \ .fixed {\n\+ \ color: black;\n\ \ }\n\- \ .children {\n\+ \ </style>\n"++templatePre2 =+ " <style type=\"text/css\">\n\+ \ .shown {\n\ \ display: inline;\n\ \ }\n\+ \ .hidden {\n\+ \ display: none;\n\+ \ }\n\ \ </style>\n\ \ <script type=\"text/javascript\">\n\ \ function toggle(e) {\n\@@ -121,11 +201,11 @@ \ cstyle = window.getComputedStyle(children),\n\ \ cdispay = cstyle.getPropertyValue(\"display\");\n\ \ if (cdispay == \"inline\") {\n\- \ document.getElementById(\"children_\" + id).style.display = \"none\";\n\- \ document.getElementById(id).style.color = \"gray\";\n\+ \ document.getElementById(\"children_\" + id).className = \"hidden\";\n\+ \ document.getElementById(id).className = \"node interactive collapsed\";\n\ \ } else {\n\- \ document.getElementById(\"children_\" + id).style.display = \"inline\";\n\- \ document.getElementById(id).style.color = \"blue\";\n\+ \ document.getElementById(\"children_\" + id).className = \"shown\";\n\+ \ document.getElementById(id).className = \"node interactive expanded\";\n\ \ }\n\ \ }\n\ \ </script>\n\@@ -134,7 +214,7 @@ \<body>\n\ \<pre>\n" -template2 =+templatePost = "</pre>\n\ \</body>\n\ \\n\
tree-view.cabal view
@@ -1,5 +1,5 @@ name: tree-view-version: 0.4+version: 0.5 synopsis: Render trees as foldable HTML and Unicode art description: Render trees as foldable HTML and Unicode art .