module Text.HTML.TreeMap  ( treeMapExt
                          , treeMap
                          , defaultTreeOpts
                          , TreeMapOptions(..))
where
import Data.Tree
import Data.List (sortBy, groupBy)
import Text.HTML.TreeUtils
import Text.Html

--
-- Configuration Data Types
--
data TreeMapOptions = TreeMapOptions { toLeafColor :: String    -- background color of boxes the leafs
                                     , toAltColors :: [String]  -- background colors of non-leafs. they are alternated
                                     }

-- Good default settings for the colors
defaultTreeOpts :: TreeMapOptions
defaultTreeOpts = TreeMapOptions "white" ["yellow", "orange", "#9ACD32", "#FFD700" , "#FF6347" ]

--
-- Box Data Types. It is used for better expressing layouting algorithm result.
-- Basically layouting algorithm has to decide how many tables with how many
-- columns are used for nested boxes representation. Current implementation 
-- uses only one big TableBox in BoxGrid. But for future there migh be better
-- approach. The goal is to display treemap with as much as possible taken place
-- and unused gaps.
-- 
data Box = BoxText { boName :: String,
                     boId   :: Int }
         | BoxGrid { boName :: String,
                     boId   :: Int,
                     boGrid :: [TableBox] } deriving (Ord,Eq,Show)

-- Type used witin Box with already decided layoting, for nested box groups
data TableBox = TableBox { tbCols :: Int, tbCels :: [Box] } deriving (Ord,Eq,Show)

--
-- Size Basic Functions
--
type IntW = Int
type IntH = Int
type BoxSize = (IntW,IntH)

concatRowSize :: [BoxSize] -> BoxSize
concatRowSize [] = (0,0)
concatRowSize (x:xs) = plusSize x (concatRowSize xs)
    where
      plusSize (a1,b1) (a2,b2) = (a1+a2,max b1 b2)
--
-- Get Size of Elements
-- 
tableSize :: TableBox -> BoxSize
tableSize (TableBox _ []) = (0,0)
tableSize (TableBox n xs) = (maximum (rowW xs), sum (rowH xs))
    where
      rowW [] = [0]
      rowW ys = (fst $ concatRowSize $ map (boxSize) (take n ys)):(rowW (drop n ys))
      rowH [] = [0]
      rowH ys = (snd $ concatRowSize $ map (boxSize) (take n ys)):(rowH (drop n ys)) 

labelSize :: String -> BoxSize
labelSize cs = (maximum $ map length (lines cs),length (lines cs))

-- size2square :: BoxSize -> Int
-- size2square (w,h) = w*h

-- boxSquare :: Box -> Int
-- boxSquare = size2square . boxSize

boxSize :: Box -> BoxSize
boxSize (BoxText cs _ ) = labelSize cs
boxSize (BoxGrid cs _ xs) = (boxW, boxH)
    where
      boxW = maximum (rowW xs)
      boxH = round (fontCorr * (fromIntegral $ sum (rowH xs)) :: Double)
      rowW [] = [fst $ labelSize cs]
      rowW ys = (fst $ concatRowSize $ map (tableSize) (take 1 ys)):(rowW (drop 1 ys))
      rowH [] = [snd $ labelSize cs]
      rowH ys = (snd $ concatRowSize $ map (tableSize) (take 1 ys)):(rowH (drop 1 ys))
      fontCorr = 1.3 -- this will increase height. It is heuristic constant :)
     
-- Function which figure <1..0) number with following meaning
--   1 : the Box is really Square
--   0 : the Box is actually Rectangle
boxFactor :: BoxSize -> Float
boxFactor (w,h) | h > w     = (fromIntegral w)/(fromIntegral h)
                 | otherwise = (fromIntegral h)/(fromIntegral w)
--
-- Layout Functions
--
mkBox :: String -> Int -> [Box] -> Box
mkBox cs i [] = BoxText cs i
mkBox cs i sx = BoxGrid cs i (sortBy (\t1 t2 -> (tbCols t2) `compare` (tbCols t1)) $ map findBestTable boxesGroupsSorted)
    where
      boxesGroupsSorted = map (sortBoxesByH) boxesGroups 
      boxesGroups = groupBy (\_ _ -> True) (sortBoxesBySize sx)
     --boxesGroups = groupBy (\a b -> (abs $ (snd $ boxSize a) - (snd $ boxSize b)) < thr) (sortBoxesBySize sx)
     --thr = 300

sortBoxesBySize, sortBoxesByH :: [Box] -> [Box]
sortBoxesBySize = sortBy (\a b -> boxSize a `compare` boxSize b)
sortBoxesByH    = sortBy (\a b -> (snd $ boxSize a) `compare` (snd $ boxSize b))

findBestTable :: [Box] -> TableBox
findBestTable ys = TableBox (bestBoxCols ys) ys
    where
      tables xs = [ TableBox c xs | c <- [1..50] ]
      bestBoxFactor xs = maximum [boxFactor $ tableSize t | t <- tables xs]
      bestBoxCols   xs = head [tbCols t | t <- tables xs, (boxFactor $ tableSize t) == bestBoxFactor xs]

--
-- Render Functions
-- 
renderTableBox :: TreeMapOptions -> Int -> TableBox -> Html
renderTableBox opts i (TableBox n xs) = simpleTable tAttr [] (filter (not . null) $ mkRows xs)
    where
      tAttr = [identifier ("boxId"++(show i)), thestyle "display: none;"]
      mkRows [] = [[]]
      mkRows ys = (map (renderBox (rotColors opts)) $ take n ys):(mkRows (drop n ys))

renderBox :: TreeMapOptions -> Box -> Html
renderBox opts (BoxText l i )   = mkHTMLBox l i []  1 (defBoxProps { boxFillColor = toLeafColor opts })
renderBox opts (BoxGrid l i xs) = mkHTMLBox l i tbl 1 (defBoxProps { boxFillColor = head $ toAltColors opts })
    where
      tbl = map (renderTableBox opts i) xs

-- Rotate colors during folding tree
rotColors :: TreeMapOptions -> TreeMapOptions
rotColors (TreeMapOptions lc []) = TreeMapOptions lc []
rotColors (TreeMapOptions lc (c:acs)) = TreeMapOptions lc (acs++[c])

--
-- Render given Tree of String into HTML with default
-- options.
--
treeMap :: Tree String -> String
treeMap xs = treeMapExt defaultTreeOpts xs

--
-- Render given Tree of String into HTML using options
-- provided.
--
treeMapExt :: TreeMapOptions -> Tree String -> String
treeMapExt opts xs = renderHtml $ concatHtml [displayBoxJS,boxes]
    where
      boxes = renderBox opts $ treeMapLBox lxs
      lxs = tree2ltree xs

--
-- Create for the Tree of Strings the Box which can
-- be than rendered to String.
--
treeMapLBox :: Tree (Int,String) -> Box
treeMapLBox (Node (i,s) xs) = mkBox s i (map treeMapLBox xs)

--
-- Testing Section, example & main
--
{-
exampleTree :: Tree String
exampleTree = Node "rado" [Node "peter" [Node "jano" [] ], Node "dusan" [Node "jozef" [Node "Longer Name" [] ] ]]

main = putStrLn (treeMap exampleTree)
-}