{-# LANGUAGE
    FlexibleInstances
 #-}

-- | parse profile file generated by @+RTS -p@
module GHC.ProfileAnalyzer.ParseProfile
       ( -- * function
         readProfile
       )
       where
import Control.Applicative ((<*), (*>))
import Control.Monad
import Data.Char
import Data.List (sortBy)
import Data.Monoid
import Data.Ord
import Text.Parsec
import Text.Parsec.String
import Text.Parsec.Token
import Text.Parsec.Language (haskellDef)
import Text.Printf
import System.Environment (getArgs)

import  GHC.ProfileAnalyzer.Types

-- | Token require laguage-driven token generator
lexer = makeTokenParser haskellDef

main = do
     args <- getArgs
     res <- parseFromFile header $ if null args then "sih4-prof.prof" else head args
     case res of
          Left err -> print err
          Right (title, cmd, totalTime, totalAlloc, ls) -> print (title, cmd, totalTime, ls)

readProfile :: String -> IO (Maybe RunProfile)
readProfile file = do
     res <- parseFromFile header file
     case res of
          Left err -> return Nothing
          Right (_, cmd, tTime, tHeap, ls) -> return $ Just (RunProfile (mempty { elapsedTime = tTime, usedHeap = tHeap }) (canonizeCostCenterStats ls))

header = do
  title <- readLine <* skipLine
  cmd <- readLine <* skipLine
  tTime <- pTotalTime
  tHeap <- liftM fromIntegral pTotalAlloc
  count 3 skipLine
  l <- statLine `manyTill` (try (string "individual     inherited\n"))
  return (title, cmd, tTime, tHeap, map (\(CostCenterStat n t h) -> CostCenterStat n (0.01 * t * tTime) (0.01 * h * tHeap)) l)

skipLine = optional (many1 (noneOf "\n")) >> newline
readLine =  optional spaces *> many1 (noneOf "\n") <* newline

pTotalTime = do
  optional spaces
  string "total time" >> spaces >> string "=" >> spaces
  float lexer <* readLine

pTotalAlloc = do
  optional spaces
  string "total alloc" >> spaces >> string "=" >> spaces
  num <- many1 (char ',' <|> digit)
  readLine
  return ((read . filter isDigit $ num) :: Int)

statLine = do
 optional $ many1 (oneOf " \t")
 id <- many1 (noneOf " \t\n") <* many1 (oneOf " \t")
 pac <- many1 (noneOf " \t\n") <* many1 (oneOf " \t")
 time <- float lexer
 mem <- float lexer
 return $ CostCenterStat (id, pac) time mem

