{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE ScopedTypeVariables #-}

module HarmTrace.IO.Parse (

    parseTree, parseTreeVerb, parseDir

  ) where


-- Common IO functions
import HarmTrace.IO.Common

-- Parser stuff
import Text.ParserCombinators.UU

-- Music stuff
import HarmTrace.HarmTrace
import HarmTrace.Base.MusicRep
import HarmTrace.Models.Jazz.Instances ()
import HarmTrace.HAnTree.Tree (Tree)
import HarmTrace.HAnTree.ToHAnTree
import HarmTrace.IO.Errors

-- Library modules
import Data.List (sort, intersperse, genericLength)
import System.FilePath
import System.Directory
import System.CPUTime
import Data.Binary


--------------------------------------------------------------------------------
-- Symbolic Parsing IO 
--------------------------------------------------------------------------------

-- parses a string of chords and returns a parse tree with the harmony structure
parseTree, parseTreeVerb :: (GTree g) => Grammar g -> [PPOption] -> String 
                         -> IO (ParseResult g)
parseTree g opts s =
  do let pr@(ParseResult _ tks _ _ n te pe _) = postProc opts $ string2Piece g s
     putStrLn ("parsed " ++ show (length tks) ++ " chords into " 
                         ++ show n            ++ " ambiguous trees")
     if not $ null te then showErrors "tokenizer: " te 
                     else putStr ""
     if not $ null pe then showErrors "parser: " pe 
                     else putStr ""
     return pr

parseTreeVerb g opts s = 
  do let pr@(ParseResult _ tks _ _ n te pe _) = postProc opts $ string2Piece g s
     putStrLn ("parsed " ++ show (length tks) ++ " chords into " 
                         ++ show n            ++ " ambiguous trees")
     if not $ null te then mapM_ print te
                      else putStr ""
     if not $ null pe then mapM_ print pe
                      else putStr ""
     return pr                 
      
-- Batch analyzing a directory with chord sequence files with reduced output.
parseDir :: (GTree g)
         => Grammar g -> [PPOption] -> FilePath -> Maybe FilePath -> IO ()
parseDir g opts filepath bOut =     getDirectoryContents filepath 
                                >>= parseDir' g opts bOut filepath . sort

parseDir' :: (GTree g)
          => Grammar g -> [PPOption] -> Maybe FilePath
          -> String -> [String] -> IO ()
parseDir' g opts bOut fp fs = 
  do putStr "Filename\tNumber of trees\t"
     putStr "Insertions\tDeletions\tReplacements\tDeletions at the end\t"
     putStr "Tot_Correction\tNr_of_chords\t"
     putStrLn "Error ratio"
     --putStrLn "Error ratio\tTime taken"
     let process :: FilePath -> FilePath -> IO ([ChordLabel],Tree HAn, Int)
         process path x =
          do content <- readFile (path </> x)
             let (ParseResult _ tks ps ts nr e1 e2 _) 
                      = postProc opts $ string2Piece g content
                 -- @Pedro: I think that the (length ts) only is here to 
                 -- evaluate all trees right? Since the tree selection is now
                 -- incorporated in the postprocessing I replaced it with 
                 -- length ps
                 -- t                = seq (length ts) (return ())
                 t                = seq (length ps) (return ())
                 ErrorNrs i d e r = countErrors e2
                 errRat           = errorRatio e2 tks
                 nrOfChords       = length tks -- (mergeDups toks)
             t1 <- getCPUTime
             t
             t2 <- getCPUTime
             let _diff = fromIntegral (t2 - t1) / (1000000000 :: Float)
             when (not $ null e1) $ putErrLn (show x ++ ": " ++ show e1)
             printLn . concat $ intersperse "\t" [ x, show nr
                                       , show i, show d, show r, show e
                                       , show (i+d+e+r)
                                       , show nrOfChords, showFloat errRat
                                        -- JPM: do not print the time taken so
                                        -- as to allow diffing output in tests
                                       ] -- , showFloat diff]
             return (tks, ts, i+d+e+r)
     res <- mapM (process fp) (filter ((== ".txt") . takeExtension) fs)
     let (cs,ts,err) = (unzip3 res :: ([[ChordLabel]],[Tree HAn], [Int]))
     printLn ("average error: " ++ 
               show ((fromIntegral $ sum err) / (genericLength err) :: Double))
     case bOut of
       Nothing -> return ()
       Just bf -> encodeFile bf (cs, ts)