module Report where

import Control.Arrow
import Control.Monad.Error
import Data.Function
import Data.List
import Data.List.Split
import Data.Maybe
import qualified Data.Map as Map
import qualified Text.Tabular          as Tab
import System.Directory
import System.FilePath
import System.IO

import Definitions
import Graph
import Shellish hiding ( run )
import Standard
import TabularRST as TR

-- ----------------------------------------------------------------------
-- tables
-- ----------------------------------------------------------------------

type BenchmarkTable = Tab.Table String String String

tabulateRepo :: Formatter -> RepoTable -> Tab.Table String String String
tabulateRepo format repo = Tab.Table rowhdrs colhdrs rows
 where
  rowhdrs = Tab.Group Tab.NoLine $ map Tab.Header (rtRows repo)
  colhdrs = Tab.Group Tab.SingleLine $ map Tab.Header $
              concatMap (format myundefined . ColHeader) $ rtColumns repo
  myundefined = error "Formatting is undefined for column headers"
  rows = map formatRow $ rtTable repo
  formatRow (tu, rs) = concatMap (fmt tu) rs
  fmt tu (Just mt) = format tu (Cell mt)
  fmt tu Nothing = format tu MissingCell

-- ----------------------------------------------------------------------
-- timings files
-- ----------------------------------------------------------------------

readAllTimings :: IO [[(Test a, Maybe MemTimeOutput)]]
readAllTimings = do
  rdir  <- resultsDir
  tdirs <- filter isTimingFile `fmap` getDirectoryContents rdir
  let pstamps = map dropExtension tdirs
  mapM readTimingsForParams pstamps
 where
  isTimingFile f = takeExtension f == ".timings"

readTimingsForParams :: String -> IO [(Test a, Maybe MemTimeOutput)]
readTimingsForParams pstamp = do
  rdir  <- resultsDir
  let pdir = rdir </> pstamp <.> "timings"
  -- let ifile = replaceExtension ".timings" ".info" pdir
  tfiles   <- filter notJunk `fmap` getDirectoryContents pdir
  entries  <- concat `fmap` mapM parseTimingsFile (map (pdir </>) tfiles)
  return . map process . Map.toList . Map.fromListWith (++) . map (second (:[])) $ entries
 where
  notJunk = not . (`elem` [".",".."])

process :: ((String, String, String), [MemTime]) -> (Test a, Maybe MemTimeOutput)
process ((repo, dbin, bm), times) = (key, val)
 where
   key = Test (Description bm) (mkTr repo) (TestBinary dbin)
   val = Just $ mkMemTimeOutput times
   mkTr n = TestRepo n (guessCoreName n) n Nothing []

guessCoreName :: String -> String
guessCoreName n =
  case [ n `chop` (' ':s) | s <- suffixes, s `isSuffixOf` n ] of
   []    -> n
   (h:_) -> h
 where
  x `chop` s = take (length x - length s) x
  suffixes   = sortBy (compare `on` (negate . length)) -- longest suffixes first
             $ map vShortName allVariants

type TimingsFileEntry = ((String,String,String),MemTime)

parseTimingsFile :: FilePath -> IO [TimingsFileEntry]
parseTimingsFile tf = do
  ms <- (map parseLine . lines) `fmap` readFile tf
  let unknowns = length $ filter isNothing ms
  when (unknowns > 0) $
    hPutStrLn stderr $ "Warning: could not understand " ++ show unknowns ++ " lines in " ++ tf
  return (catMaybes ms)

parseLine :: String -> Maybe TimingsFileEntry
parseLine l =
 case wordsBy (== '\t') l of
  [ repo, dbin, bm, mem, time ] -> Just ((repo, dbin, bm), memtime time mem)
  _ -> Nothing
 where
  memtime t m = MemTime (toRational (read m :: Float)) (read t)

-- ----------------------------------------------------------------------
-- reports
-- ----------------------------------------------------------------------

renderMany :: [(Test a, Maybe MemTimeOutput)] -> Command ()
renderMany results  = do
  echo . unlines $
   [ "Copy and paste below"
   , "====================================================="
   , ""
   , machine_details
   , ""
   , "How to read these tables"
   , "====================================================="
   , ""
   , def "?x" "less than  5 runs used"
   , def "~x" "less than 20 runs used"
   , def "sdev" "std deviation"
   , descriptions_of_variants
   , ""
   , "Timings"
   , "===================================================="
   , ""
   , intercalate "\n" (map showT t_tables)
   , "Memory"
   , "===================================================="
   , ""
   , intercalate "\n" (map showT m_tables)
   , "Timing Graphs"
   , "===================================================="
   , ""
   , intercalate "\n" (map showG t_graphs)
   , "Memory Graphs"
   , "===================================================="
   , ""
   , intercalate "\n" (map showG m_graphs)
   ]
 where
  tables = repoTables benchmarks results
  --
  machine_details = intercalate "\n" $
    map detail [ "GHC version"
               , "Machine description", "Year", "CPU", "Memory", "Hard disk"
               , "Notes" ]
  detail k = k ++ "\n    *Replace Me*"
  --
  descriptions_of_variants = intercalate "\n" $
    map (describe . toVariant) [ OptimizePristineVariant ]
  describe v = def (vSuffix v) (vDescription v ++ " variant")
  def k v = "* " ++ k ++ " = " ++ v
  --
  repoTuple tabulate repo = (rtRepo repo, tabulate repo)
  t_tables = map (repoTuple $ tabulateRepo formatTimeResult) tables
  m_tables = map (repoTuple $ tabulateRepo formatMemoryResult) tables
  showT (r,t) = intercalate "\n" [ r
                                 , replicate (length r) '-'
                                 , ""
                                 , TR.render id id id t ]
  --
  t_graphs = map (repoTuple graphRepoTime) tables
  m_graphs = map (repoTuple graphRepoMemory) tables
  showG (r,gs) = intercalate "\n" $ [ r
                                    , replicate (length r) '-'
                                    , ""
                                    ] ++ (map imgDirective gs) ++ [""]
  imgDirective = (".. image:: " ++)

printCumulativeReport :: Command ()
printCumulativeReport = do
  ts <- liftIO readAllTimings
  mapM_ renderMany ts -- TODO: split this into sections for each param stamp