module Text.HTML.TreeUtils (mkHTMLBox, 
                            BoxProps(..), 
                            defBoxProps,
                            displayBoxJS,
                            tree2ltree)
where
--import Data.List (sortBy, intercalate, groupBy)
import Text.Html
import Data.Tree

data BoxProps = BoxProps { boxFillColor :: String, boxBorderColor :: String, boxBorderWidth :: Int } deriving Show

defBoxProps :: BoxProps
defBoxProps = BoxProps "white" "black" 2

-- Javascript resposible for correct reaction onclick event. 
-- Purporse of this code is fold / unfold given element using
-- HTML element style none. 
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>"]

-- Label which call displayBox(x) in the case of mouse click.
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) ]

-- Ineffectient function for assign unique number to each Node.
-- Has to be rewritten.
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)