{-# OPTIONS_GHC -Wall #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Billboard.BillboardData
-- Copyright   :  (c) 2012--2013 Utrecht University
-- License     :  LGPL-3
--
-- Maintainer  :  W. Bas de Haas <bash@cs.uu.nl>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Summary: A set of datatypes for representing Billboard chord sequence data 
-- See: John Ashley Burgoyne, Jonathan Wild, Ichiro Fujinaga, 
-- /An Expert Ground-Truth Set for Audio Chord Recognition and Music Analysis/,
-- In: Proceedings of International Conference on Music Information Retrieval,
-- 2011. (<http://ismir2011.ismir.net/papers/OS8-1.pdf>) 
--------------------------------------------------------------------------------

module Billboard.BillboardData ( -- * The BillBoard data representation
                                 BillboardData (..)
                               , Meta (..)
                               , BBChord (..)                               
                               , Artist
                               , Title
                               , noneBBChord
                               -- * Billboard data utilities
                               -- ** Data access
                               , getBBChords
                               , getBBChordsNoSilence
                               , addStart
                               , addEnd
                               , addLabel
                               , addStartEnd
                               , getDuration
                               , getStructAnn
                               , setChordIxsT
                               -- ** Tests
                               , isStructSegStart
                               , isNoneBBChord
                               , isChange
                               , hasAnnotations
                               , isEnd
                               -- ** Chord reduction
                               , reduceBBChords
                               , expandBBChords
                               , reduceTimedBBChords
                               , expandTimedBBChords
                               -- * Showing
                               , showInMIREXFormat
                               , showFullChord
                               ) where

-- HarmTrace stuff
import HarmTrace.Base.MusicRep  hiding (isNone)
import HarmTrace.Base.MusicTime (TimedData (..), timedDataBT, getData
                                , onset, offset, concatTimedData)

import Billboard.BeatBar
import Billboard.Annotation ( Annotation (..), isStart, isStruct
                            , getLabel, Label, isEndAnno
                            , isFirstChord, isLastChord)

import Data.List (partition)

-- | The 'BillboardData' datatype stores all information that has been extracted
-- from a Billboard chord annotation
data BillboardData = BillboardData { getTitle   :: Title    
                                   , getArtist  :: Artist 
                                   , getTimeSig :: TimeSig 
                                   , getKeyRoot :: Root    
                                   , getSong    :: [TimedData BBChord]
                                   } deriving Show

-- | Represents the artists of the piece
type Artist = String 
-- | Represents the title of the piece
type Title  = String  
-- | Represents other metadata of the piece, i.e. the time signature 
-- and key root
data Meta   = Metre   TimeSig 
            | KeyRoot Root    deriving Show


-- | We wrap the 'HarmTrace.Base.MusicRep.Chord' datatype into a 'BBChord' type, 
-- so that we can augment it with 'Annotation's and 'BeatWeight's.
data BBChord = BBChord { annotations :: [Annotation]
                       , weight      :: BeatWeight
                       , chord       :: Chord Root
                       } 

instance Show BBChord where 
  show (BBChord [] Beat  _c) = show Beat
  show (BBChord bd Beat  _c) = show Beat ++ show bd
  show (BBChord [] w      c) = show w ++ ' ' : show c -- ++ (show $ duration c)
  show (BBChord bd w      c) = 
    let (srt, end) = partition isStart bd
    in  show w ++ concatMap show srt ++ ' ' : show c ++ ' ' : concatMap show end

instance Ord BBChord where
  compare (BBChord _ _ a) (BBChord _ _ b)
    | rt == EQ = compare (toTriad a) (toTriad b) -- N.B.toTriad can be expensive
    | otherwise  = rt where
        rt = compare (chordRoot a) (chordRoot b)

-- TODO replace by derived EQ, use a specific EQ where needed.
instance Eq BBChord where
  (BBChord _ _ a) == (BBChord _ _ b) = chordRoot a == chordRoot b && 
                                       toTriad   a == toTriad   b


--------------------------------------------------------------------------------
-- Some BBChord Utilities
--------------------------------------------------------------------------------
-- | A chord label with no root, shorthand or other information to represent
-- a none harmonic sections
noneBBChord :: BBChord
noneBBChord = BBChord [] Change noneLabel {duration =1}

-- | Returns True if the 'BBChord' represents a starting point of a structural
-- segment
isStructSegStart :: BBChord -> Bool-- look for segTypes that are Start and Struct
isStructSegStart = not . null . filter isStruct . map getLabel 
                              . filter isStart  . annotations 

-- | Returns True if the 'BBChord' represents a chord Change (must be set 
-- beforehand, only the 'BeatWeight' stored in the 'BBChord' is examined)
isChange :: BBChord -> Bool
isChange c = case weight c of
  Change    -> True
  UnAligned -> error "BBChord.isChange: the BBChord is not beat aligned"
  _         -> False
  
-- | Returns True if the 'BBChord' is a 'noneBBChord', i.e. has not root note 
-- and no shorthand
isNoneBBChord :: BBChord -> Bool
isNoneBBChord = isNoneChord . chord

-- | Returns True if this 'BBChord' is the last (N) chord of the song
isEnd :: BBChord -> Bool
isEnd c = isNoneBBChord c && hasAnnotation isEndAnno c 

-- | Returns True if the 'BBChord' has any 'Annotations's and False otherwise
hasAnnotations :: BBChord -> Bool
hasAnnotations = not . null . annotations

-- | Takes an 'Annotation' predicate and checks if it holds for a 'BBChord'
hasAnnotation :: (Annotation -> Bool) -> BBChord -> Bool
hasAnnotation f c = case annotations c of
  [] -> False
  a  -> or . map f $ a

-- | Adds a starting point of an 'Annotation' 'Label' to a 'BBChord'
addStart :: Label -> BBChord -> BBChord
addStart lab chrd = chrd { annotations = Start lab : annotations chrd }

-- | Adds an end point of an 'Annotation' 'Label' to a 'BBChord'
addEnd :: Label -> BBChord -> BBChord
addEnd lab chrd = chrd { annotations = End lab : annotations chrd }

-- | Adds both a start and an end 'Annotation' 'Label' to a 'BBChord'
addStartEnd :: Label -> BBChord -> BBChord
addStartEnd lab c = c { annotations = Start lab : End lab : annotations c }

-- | Annotates a sequence of 'BBChord's by adding a Start 'Label' 'Annotation'
-- at the first chord and an End 'Label' 'Annotation' at the last chord. The
-- remainder of the list remains untouched
addLabel :: Label -> [BBChord] -> [BBChord]
addLabel _ [ ] = [ ]
addLabel lab [c] = [addStart lab . addEnd lab $ c]
addLabel lab (c:cs)  = addStart lab c : foldr step [] cs where
  step :: BBChord -> [BBChord] -> [BBChord]
  step x [] = [addEnd lab x] -- add a label to the last element of the list
  step x xs = x : xs

-- | Sets the indexes of a list of 'TimedData' 'BBChord's (starting at 0)
setChordIxsT :: [TimedData BBChord] -> [TimedData BBChord]
setChordIxsT cs = zipWith (fmap . flip setChordIx) [0..] cs   
  
-- | Sets the indexes of a list of 'BBChords' (starting at 0)
setChordIxs :: [BBChord] -> [BBChord]
setChordIxs cs = zipWith setChordIx cs [0..]
  
-- sets the index of a 'BBChord' (should not be exported)
setChordIx :: BBChord -> Int -> BBChord 
setChordIx rc i = let x = chord rc in rc {chord = x {getLoc = i} }

-- | Returns the duration of the chord (the unit of the duration can be 
-- application dependent, but will generally be measured in eighth notes)
-- If the data comes directly from the parser the duration will be 1 for
-- all 'BBChord's. However, if it has been \reduced\ with 'reduceBBChords'
-- the duration will be the number of consecutive tatum units.
getDuration :: BBChord -> Int
getDuration = duration . chord

-- sets the duration of an 'BBChord'
setDuration :: BBChord -> Int -> BBChord
setDuration c i = let x = chord c in c { chord = x { duration = i } }
  
-- | Strips the time stamps from BillBoardData and concatenates all 'BBChords'
getBBChords :: BillboardData -> [BBChord]
getBBChords = map getData . getSong

-- | Strips the time stamps from BillBoardData and concatenates all 'BBChords'
-- and removes the silence at the beginning and end of the song.
getBBChordsNoSilence :: BillboardData -> [BBChord]
getBBChordsNoSilence = removeSilence . getBBChords where

  -- Removes the Silence, Applause, and other non-harmonic None chords at the
  -- beginning and end of a piece
  removeSilence :: [BBChord] -> [BBChord]
  removeSilence = takeIncl  (not . hasAnnotation isLastChord ) .
                  dropWhile (not . hasAnnotation isFirstChord) 
                  
  -- Does exactly the same as 'takeWhile' but includes the element for which
  -- the predicate holds. For example takeIncl (< 3) [1..5] = [1, 2, 3]
  takeIncl :: (a -> Bool) -> [a] -> [a]
  takeIncl _ []     = [ ]
  takeIncl p (x:xs) 
     | p x          =  x : takeIncl p xs
     | otherwise    = [x]

-- | Returns the structural segmentation 'Annotation's, 
-- given a 'BBChord'
getStructAnn :: BBChord -> [Annotation]
getStructAnn = filter ( isStruct . getLabel ) . annotations

--------------------------------------------------------------------------------
-- Utilities
--------------------------------------------------------------------------------

-- | Given a list of 'BBChord's that have a certain duration (i.e. the number of 
-- beats that the chord should sound), every 'BBChord' is replaced by /x/ 
-- 'BBChord's with the same properties, but whit a duration of 1 beat, where /x/ 
-- is the duration of the original 'BBChord'
expandBBChords :: [BBChord] -> [BBChord]
expandBBChords = setChordIxs . concatMap replic where
  replic c = let x = setDuration c 1 
             in  x : replicate (pred . duration $ chord c) 
                               x { weight = Beat, annotations = []}
                               
-- | The inverse function of 'expandChordDur': given a list of 'BBChords' that 
-- all have a duration of 1 beat, all subsequent /x/ 'BBChords' with the same 
-- label are grouped into one 'BBChord' with durations /x/. N.B. 
--
-- >>> expandBBChords (reduceBBChords cs) = cs
-- 
-- also,
--
-- >>> (expandBBChords cs) = cs
--
-- and,
--
-- >>> reduceBBChords (reduceBBChords cs) = (reduceBBChords cs)
--
-- hold. This has been tested on the first tranch of 649 Billboard songs
reduceBBChords :: [BBChord] -> [BBChord]
reduceBBChords = setChordIxs . foldr group []  where
  
  group :: BBChord -> [BBChord] -> [BBChord]
  group c [] = [c]
  group c (h:t)
    | c `bbChordEq` h  = setDuration c (succ . duration $ chord h): t
    | otherwise        = c : h : t


-- | Returns the reduced chord sequences, where repeated chords are merged
-- into one 'BBChord', similar to 'reduceBBChords', but then wrapped in a 
-- 'TimedData' type.
reduceTimedBBChords :: [TimedData BBChord] -> [TimedData BBChord]
reduceTimedBBChords = setChordIxsT . foldr groupT [] where

   groupT :: TimedData BBChord -> [TimedData BBChord] -> [TimedData BBChord]
   groupT c [] = [c]
   groupT tc@(TimedData c _ ) (th@(TimedData h _ ) : t)
     | c `bbChordEq` h = concatTimedData 
                           (setDuration c (succ . duration $ chord h)) tc th : t
     | otherwise       = tc : th : t

-- | Similar to 'expandBBChords' the inverse of 'reduceTimedBBChords'
expandTimedBBChords :: [TimedData BBChord] -> [TimedData BBChord]
expandTimedBBChords = setChordIxsT . concatMap replic where

  replic :: TimedData BBChord -> [TimedData BBChord]
  replic (TimedData c ts) = 
    let x  = setDuration c 1 
    in  zipWith3 timedDataBT
                 (x : repeat x { weight = Beat, annotations = []}) ts (tail ts)

             
-- keep groupBBChord and expandChordDur "inverseable" we use a more strict
-- 'BBChord' equallity  
bbChordEq :: BBChord -> BBChord -> Bool
bbChordEq (BBChord anA btA cA) (BBChord anB btB cB) = 
  chordRoot cA      == chordRoot cB && 
  chordShorthand cA == chordShorthand cB && 
  chordAdditions cA == chordAdditions cB &&
  anA          `annEq` anB &&
  btA         `beatEq` btB where
  
    annEq :: [Annotation] -> [Annotation] -> Bool
    annEq [] [] = True
    annEq _  [] = True
    annEq a  b  = a == b
      
    beatEq :: BeatWeight -> BeatWeight -> Bool  
    beatEq LineStart Beat       = True
    beatEq Bar       Beat       = True
    beatEq Change    Beat       = True
    beatEq Bar       Bar        = False
    beatEq Change    Change     = False
    beatEq LineStart LineStart  = False
    beatEq a         b          = a == b

--------------------------------------------------------------------------------
-- Printing chord sequences
--------------------------------------------------------------------------------

-- | Shows the chord sequence in the 'BillboardData'
showFullChord :: ([TimedData BBChord] -> [TimedData BBChord]) 
              -> BillboardData -> String
showFullChord redf = concatMap (showLine (show . chord)) . redf . getSong 

-- | Shows the 'BillboardData' in MIREX format, using only :maj, :min, :aug,
-- :dim, sus2, sus4, and ignoring all chord additions
showInMIREXFormat :: ([TimedData BBChord] -> [TimedData BBChord]) 
                  -> BillboardData -> String
showInMIREXFormat redf = concatMap (showLine mirexBBChord) . redf . getSong 

-- | Shows a 'TimedData' 'BBChord' in MIREX triadic format, using only :maj, 
-- :min, :aug, :dim, sus2, sus4, and ignoring all chord additions 
showLine ::  (BBChord -> String) -> TimedData BBChord ->  String
showLine shwf c = show (onset c) ++ '\t' :  show (offset c) 
                                 ++ '\t' : (shwf . getData $ c) ++ "\n" 
                               
-- Categorises a chord as Major or Minor and shows it in Harte et al. syntax
mirexBBChord :: BBChord -> String
mirexBBChord bbc = let x = chord bbc 
                   in case (chordRoot x, chordShorthand x) of
                        ((Note _ N), None ) -> "N"
                        ((Note _ X), _    ) -> "X"
                        (r         , Sus2 ) -> show r ++ ":sus2"
                        (r         , Sus4 ) -> show r ++ ":sus4"
                        (r         , _    ) -> case toTriad x of
                                                 NoTriad ->  "X"
                                                 t   -> show r ++':' : show t