module Text.HTML.TreeUtils (mkHTMLBox,
BoxProps(..),
defBoxProps,
displayBoxJS,
tree2ltree)
where
import Text.Html
import Data.Tree
data BoxProps = BoxProps { boxFillColor :: String, boxBorderColor :: String, boxBorderWidth :: Int } deriving Show
defBoxProps :: BoxProps
defBoxProps = BoxProps "white" "black" 2
displayBoxJS :: Html
displayBoxJS = primHtml $ unlines [ "<script type=\"text/javascript\">"
,"function displayBox(i){"
,"var row = document.getElementById(\"boxId\"+i);"
,"if (row.style.display == '') row.style.display = 'none';"
,"else row.style.display = '';"
," }"
,"</script>"]
clickLabel :: String -> Int -> Html
clickLabel cs i = let txt = prettyHtml $ linesToHtml (lines cs)
onclick = "onclick=\"displayBox("++(show i)++")\""
in primHtml $ "<div "++onclick++">" ++ txt ++ "</div>"
mkHTMLBox :: String -> Int -> [Html] -> Int -> BoxProps -> Html
mkHTMLBox cs i [] _ prop = simpleTable (tabAttrs prop) [] [[clickLabel cs i]]
mkHTMLBox cs i xs n prop = simpleTable (tabAttrs prop) [] $ [[clickLabel cs i]] ++ (filter (not . null) $ mkRows xs)
where
mkRows [] = [[]]
mkRows ys = (take n ys):(mkRows (drop n ys))
tabAttrs :: BoxProps -> [HtmlAttr]
tabAttrs prop = let borderStyle = thestyle $ concat [ "border: ",(show $ boxBorderWidth prop), "px solid "
, (boxBorderColor prop)
, ";" ]
in [ borderStyle, bgcolor (boxFillColor prop) ]
tree2ltree :: Tree a -> Tree (Int,a)
tree2ltree xs = tree2ltree' 1 xs
where
tree2ltree' l (Node r cx) = Node (l, r) lcx
where
lcx = snd $ foldr (labNode) (l+1,[]) cx
labNode c (l',lcx') = (l'+step, (tree2ltree' l' c):lcx')
where
step = length (flatten c)