module NoSlow.Analyse.Table (
  Table(..),

  table,
  filterTags, filterRows,
  intersect, union, prune,

  html, csv
) where

import NoSlow.Util.Tag

import qualified Data.Map as M
import qualified Data.List as L

data Table = Table {
               tRows     :: [String]
             , tCells    :: M.Map Tag Double
             , tShowCell :: Double -> String
             }

-- | Create new table
table :: (Double -> String) -> [(Tag, Double)] -> Table
table show es
  = Table {
      tRows     = L.nub $ map (tagName . fst) es
    , tCells    = M.fromList es
    , tShowCell = show
    }

filterTags :: (Tag -> Bool) -> Table -> Table
filterTags f t@(Table { tCells = tCells })
  = t { tCells = M.filterWithKey (\tag _ -> f tag) tCells }

filterRows :: (String -> Bool) -> Table -> Table
filterRows f t@(Table { tRows = tRows, tCells = tCells })
  = t { tRows  = filter f tRows
      , tCells = M.filterWithKey (\tag _ -> f (tagName tag)) tCells
      }

intersect :: (Double -> String) -> (Double -> Double -> Double)
                    -> Table -> Table -> Table
intersect show f t1 t2
  = Table { tRows     = L.intersect (tRows t1) (tRows t2)
          , tCells    = M.intersectionWith f (tCells t1) (tCells t2)
          , tShowCell = show
          }

union :: Table -> Table -> Table
union t1 t2
  = Table { tRows     = tRows t1 ++ (tRows t2 L.\\ tRows t1)
          , tCells    = M.unionWith (\x y -> y) (tCells t1) (tCells t2)
          , tShowCell = tShowCell t1
          }

prune :: Table -> Table
prune t
  = t { tRows = filter keep (tRows t) }
  where
    keep s = any (\t -> tagName t == s) $ M.keys $ tCells t
          

columns :: Table -> [Tag]
columns = map head . spans (==) . map clear_name . map fst . M.toAscList . tCells
  where
    clear_name tag = tag { tagName = "" }

header :: [Tag] -> [[(Int, String)]]
header cols
  | all (head groups ==) groups = [libraries, subsystems]
  | otherwise                   = [libraries, subsystems, groups]
  where
    libraries  = [(length ts, tagLibrary $ head ts) | ts <- libs]
    subsystems = [(length ts, tagSubsystem $ head ts)
                    | us <- libs
                    , ts <- spans (eqOn tagSubsystem) us]
    groups     = [(1, tagGroup t) | t <- cols]

    libs = spans (eqOn tagLibrary) cols

cells :: [Tag] -> Table -> [[Maybe Double]]
cells cols (Table { tRows = rows, tCells = t })
  = map mk_row rows
  where
    mk_row name = [M.lookup (set_name tag name) t | tag <- cols]

    set_name tag name = tag { tagName = name }

spans :: (a -> a -> Bool) -> [a] -> [[a]]
spans eq [] = []
spans eq (x:xs) = (x:ys) : spans eq zs
  where
    (ys,zs) = span (eq x) xs

on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
on f g x y = f (g x) (g y)

eqOn :: Eq b => (a -> b) -> a -> a -> Bool
eqOn = on (==)


html :: Table -> String
html t = unlines
  [ "<table border=\"1\">"
  , unlines $ map (tr . header_row) (header cols)
  , unlines $ map (tr . row) $ zip (tRows t) (cells cols t)
  , "</table>"
  ]
  where
    cols  = columns t

    row (s, cs) = th (concatMap escape s) ++ concatMap cell cs
    cell Nothing = td ""
    cell (Just s) = td (tShowCell t s)

    tr s = "<tr>" ++ s ++ "</tr>"

    th s = "<th>" ++ s ++ "</th>"
    td s = "<td>" ++ s ++ "</td>"

    th' 1 s = th s
    th' n s = "<th colspan=\"" ++ show n ++ "\">" ++ s ++ "</th>"

    header_row cs
     = th "" ++ concatMap (uncurry th') cs

    escape '<' = "&lt;"
    escape '>' = "&gt;"
    escape '&' = "&amp;"
    escape c   = [c]

csv :: Table -> String
csv t = unlines
  [ L.intercalate "," $ "Kernel" : map show cols
  , unlines $ map row $ zip (tRows t) (cells cols t)
  ]
  where
    cols = columns t

    row (t, cs) = L.intercalate "," $ t : map cell cs

    cell Nothing = ""
    cell (Just s) = tShowCell t s