-- | Parser for SBench data files.
module Test.SBench.File.Parser 
  ( getMetaInfo
  , getWholeFile
  ) where

import Text.Parsec.String ( Parser(..), parseFromFile)
import Text.Parsec.Error ( ParseError )
import Text.Parsec.Combinator ( manyTill, many1, sepBy, count )
import Text.Parsec.Prim ( many, (<?>), (<|>), try )
import Text.Parsec.Char ( anyChar, spaces, string, newline, digit, char  )
import System.FilePath ( FilePath )
import Test.SBench.File.Types ( MetaInfo(..), Range(..) )
import Test.SBench.Options ( EvalMod (..) )


getMetaInfo :: FilePath -> IO (MetaInfo Double Double)
getMetaInfo file = do
    emi <- parseFromFile metaInfoParser file
    case emi of
      Left err -> error $ show err
      Right mi -> return mi

getWholeFile :: FilePath -> IO (MetaInfo Double Double, [(Double,Double)])
getWholeFile file = do
    emi <- parseFromFile wholeFileParser file
    case emi of
      Left err -> error $ show err
      Right mi -> return mi

wholeFileParser :: Parser (MetaInfo Double Double, [(Double,Double)])
wholeFileParser = do
    mi  <- metaInfoParser
    dat <- dataParser
    return (mi, dat)

metaInfoParser :: Parser (MetaInfo Double Double)
metaInfoParser = do
   hs    <- many $ try headerLineParser
   v     <- versionParser
   pt    <- graphTitleParser
   alg   <- algNameParser
   gen   <- genNameParser
   evMod <- evalModParser
   prs   <- graphRangesParser
   bopts <- buildOptsParser
   eopts <- exeOptsParser
   return MetaInfo {
        header = hs
      , sbenchVersion = v
      , miGraphTitle = pt
      , miAlgName = alg
      , miGenName = gen
      , evalMod = evMod
      , graphRanges = prs
      , buildOptions = bopts
      , exeOptions = eopts
      }

headerLineParser :: Parser String
headerLineParser = do
    commentLine <?> "HeaderLineParser: Expected Line to start with '#'.\n"
    spaces
    string "header: "
    manyTill anyChar newline

versionParser :: Parser String
versionParser = do
    commentLine <?> "versionParser: Expected Line to start with '#'.\n"
    spaces
    string "SBench version:" <?> "expected SBench version number"
    spaces
    andNewLine (vnumParser <?> "Invalid SBench version number.")
  where
    vnumParser :: Parser String
    vnumParser = do main <- many1 digit
                    subs <- many subnum
                    return $ foldl (++) main subs
    subnum = do char '.' 
                ds <- many1 digit                
                return $ '.' : ds

testNameParser :: Parser String
testNameParser = do
    commentLine <?> "testNameParser: Expected Line to start with '#'.\n"
    spaces
    string "test name:" <?> "expected test name"
    spaces
    andNewLine wordParser

genDimParser :: Parser Int
genDimParser = do
    commentLine <?> "genDimParser: Expected Line to start with '#'.\n"
    spaces
    string "number of generators:"
    spaces
    snum <- andNewLine $ many1 digit
    return ((read snum) :: Int)

graphTitleParser :: Parser String
graphTitleParser = do
    commentLine <?> "graphTitleParser: Expected Line to start with '#'.\n"
    spaces
    string "graph title:" <?> "expected graph title"
    spaces
    andNewLine wordParser

algNameParser :: Parser String
algNameParser = do
    commentLine <?> "algNameParser: Expected Line to start with '#'.\n"
    spaces
    string "tested algorithm: " <?> "expected name of tested algorithm"
    spaces
    andNewLine wordParser

genNameParser :: Parser (Either String String)
genNameParser = do
    commentLine <?> "genNameParser: Expected Line to start with '#'.\n"
    spaces
    string "input"
    (try inputParser) <|> inputGenParser
  where inputParser = do string ": "
                         spaces
                         n <- andNewLine wordParser
                         return (Right n)
        inputGenParser = do string " generator: " <?> "expected name of the input generator or input"
                            spaces
                            n <- andNewLine wordParser
                            return (Left n)

evalModParser :: Parser (Maybe EvalMod)
evalModParser = do
    commentLine <?> "evalModParser: Expected Line to start with '#'.\n"
    spaces
    string "evaluation mode: " <?> "expected evaluation mode"
    spaces
    andNewLine (evMod <|> return Nothing)
  where
    evMod = ((string "nf" >> return (Just NF)) <|> (string "whnf" >> return (Just WHNF)))

buildOptsParser :: Parser String
buildOptsParser = do
    commentLine <?> "buildOptsParser: Expected Line to start with '#'.\n"
    spaces
    string "build options: " <?> "expected build options"
    spaces
    andNewLine wordParser

exeOptsParser :: Parser String
exeOptsParser = do
    commentLine <?> "exeOptsParser: Expected Line to start with '#'.\n"
    spaces
    string "execution options: " <?> "expected execution options"
    spaces
    andNewLine wordParser

graphRangesParser :: Parser (Range Double, Range Double)
graphRangesParser = do
    commentLine <?> "graphRangesParser: Expected Line to start with '#'.\n"
    spaces
    string "graph ranges:" <?> "expected graph ranges"
    spaces
    let p = try autoParser <|> manParser 
    andNewLine $ pairParser p p
  where
    autoParser :: Parser (Range Double)
    autoParser = do string "Auto"
                    return AutoRange
    manParser :: Parser (Range Double)
    manParser = do
        r <- pairParser doubleParser doubleParser
        return $ ManRange r

pairParser :: Parser a -> Parser b -> Parser (a, b)
pairParser p1 p2 = do
    rmAllWhiteParser '('
    c1 <- p1
    rmAllWhiteParser ','
    c2 <- p2
    rmLeadingWhiteParser ')'
    return (c1, c2)

doubleParser :: Parser Double
doubleParser = do
    i <- many digit
    f <- (char '.' >> many digit) <|> return "0"
    e <- do  char 'e' 
             s <- string "+" <|> string "-" <|> return "+"
             e <- many1 digit
             return $ "e" ++ s ++ e
         <|> return ""
    return $ (read (i ++ "." ++ f  ++ e) :: Double)

intParser :: Parser Int
intParser = do
    i <- many1 digit <?> "expected an integer"
    return (read i :: Int)

axisLabelParser :: Parser [String]
axisLabelParser = do
    commentLine <?> "axisLabelParser: Expected Line to start with '#'.\n"
    spaces
    string "axis labels:" <?> "expected axis labels"
    spaces
    andNewLine $ listParser wordParser

rmAllWhiteParser :: Char -> Parser ()
rmAllWhiteParser c = spaces >> char c >> spaces

rmLeadingWhiteParser :: Char -> Parser ()
rmLeadingWhiteParser c = spaces >> char c >> return ()



listParser :: Parser a -> Parser [a]
listParser p = do
    rmAllWhiteParser '['
    ret <- sepBy p (rmAllWhiteParser ',')
    rmLeadingWhiteParser ']'
    return ret

wordParser :: Parser String
wordParser = char '"' >> manyTill anyChar (char '"')

andNewLine :: Parser a -> Parser a
andNewLine p = do
    ret <- p
    manyTill anyChar newline
    return ret

commentLine :: Parser ()
commentLine = many1 (char '#') >> return ()
        
dataParser :: Parser [(Double, Double)]
dataParser = many $ oneDataLineParser

oneDataLineParser :: Parser (Double, Double)
oneDataLineParser = do
    gens <- spaces >> doubleParser
    rt   <- andNewLine $ spaces >> doubleParser
    return (gens, rt)