{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall         #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  HarmTrace.Audio.AnnotationParser
-- Copyright   :  (c) 2010-2012 Universiteit Utrecht, 2012 University of Oxford
-- License     :  GPL3
--
-- Maintainer  :  bash@cs.uu.nl, jpm@cs.ox.ac.uk
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Summary: Parses textual ground-truth Chord annotations, such as the ones
-- found at: <http://isophonics.net/content/reference-annotations>
--------------------------------------------------------------------------------

module HarmTrace.Audio.AnnotationParser ( parseAnnotationData
                                        , parseKeyAnnotationData
                                        , preProcess) where

import Data.Maybe (isJust,fromJust)

import HarmTrace.Audio.DataParser (pNumData)
import HarmTrace.Audio.ChordTypes
import HarmTrace.Base.MusicRep
import HarmTrace.Base.Parsing
import HarmTrace.Tokenizer.Tokenizer ( parseDegrees, parseDegree
                                     , parseRoot   , parseShorthand)

-- perhaps this file should be moved to the tokeniser module, because it is 
-- is very related to tokenising

--------------------------------------------------------------------------------
-- Harmonically analysing Chord Annotations
--------------------------------------------------------------------------------

-- | Preprocesses a chord annotation for analysing their harmonic structure by
-- removing the time stamps and the None chords.
preProcess  :: [TimedData ChordLabel] -> [ChordLabel]
preProcess = preProcess' 0 
preProcess' :: Int -> [TimedData ChordLabel] -> [ChordLabel]
preProcess' _ [] = []
preProcess' ix (TimedData c@(Chord r sh ad _loc dur) _on _off : ns) 
  | isNoneChord c = preProcess' ix ns
  | otherwise     = Chord r sh ad ix dur : preProcess' (ix+1) ns

--------------------------------------------------------------------------------
-- Chords
--------------------------------------------------------------------------------
-- | Parses a chord annotation.
parseAnnotationData :: Parser ChordAnnotation
parseAnnotationData = pListSep_ng pLineEnd pChordSegment <* pLineEnd

pChordSegment :: Parser (TimedData ChordLabel)
pChordSegment = timedData' <$> pNumData <* pSpaceTab
                           <*> pNumData <* pSpaceTab <*> pChord


pChord :: Parser ChordLabel
pChord = f <$> parseRoot <*> pMaybe (pSym ':' *> parseShorthand)
                         <*> (parseDegrees `opt` []) 
                         -- there might be a basenote inversion annotation
                         -- which we currently ignore
                         <*> pMaybe (pSym '/' *> parseDegree) where
           -- if there is no root note, there is no chord type
           -- Chord root shorthand additions start duration
  f r sh _ _ | r == Note Nothing N = Chord r None [] 0 1 
             | isJust sh           = Chord r (fromJust sh) [] 0 1 
             | otherwise           = Chord r Maj  [] 0 1 

--------------------------------------------------------------------------------
-- Keys
--------------------------------------------------------------------------------
-- | Parses a 'Key' annotation.
parseKeyAnnotationData :: Parser [TimedData Key]
parseKeyAnnotationData = pListSep_ng pLineEnd pKeySegment <* pLineEnd

pKeySegment :: Parser (TimedData Key)
pKeySegment = timedData'  <$> pNumData <*  pSpaceTab
                          <*> pNumData <*  pSpaceTab 
                          <*> (pKey    <|> pKeyNone)

pKey :: Parser Key
pKey = Key <$ pString "Key" <* pSpaceTab <*> parseRoot <*> pMode

pKeyNone :: Parser Key
pKeyNone = Key (Note Nothing N) MajMode <$ pString "Silence"

pMode :: Parser Mode
pMode  =     MajMode <$ pString ""
         <|> MinMode <$ pString ":minor"
         <|> MinMode <$ pString ":aeolian"
         <|> MajMode <$ pString ":major"
         <|> MinMode <$ pString ":dorian"
         <|> MajMode <$ pString ":mixolydian" -- this must be solved differently
         <|> MajMode <$ pString ":modal"      -- and this too....
         

--------------------------------------------------------------------------------
-- General Parsers and Utils
--------------------------------------------------------------------------------

timedData' :: NumData -> NumData -> a -> TimedData a
timedData' on off chrd = TimedData chrd on off

pSpaceTab :: Parser Char
pSpaceTab =  pSym ' ' <|> pSym '\t'