-- | A data representation of, and parser for, MEAPsoft analysis frames.
module Sound.Analysis.Meapsoft ( Frame(..), Segment
                               , features
                               , read_file
                               , segments) where

import Control.Monad
import System.IO

-- | The data type representing an analysis frame.
data Frame = Frame { 
    -- | Onset time of frame (seconds).
    onset_time :: Double
    -- | Duration of frame (seconds).
    , duration :: Double
    -- | Mean spectrum converted to the perceptually weighted Mel
    --   frequency scale.
    , avg_mel_spec :: [Double]
    -- | Vector of energy distribution across each semitone of the
    --   octave.
    , avg_chroma :: [Double]
    -- | Average power.
    , avg_chunk_power :: Double
    -- | Dominant semitone within the octave.
    , avg_chroma_scalar :: Double
    -- | A frequency estimation.
    , avg_freq_simple :: Double
    -- | Mean MFCCs, a commonly used feature in speech recognition.
    , avg_mfcc :: [Double]
    -- | Pitch estimation.
    , avg_pitch_simple :: Double
    -- | Average spectral center of mass of the frame.
    , avg_spec_centroid :: Double
    -- | Measure of flatness of the average spectrum.
    , avg_spec_flatness :: Double
    -- | Mean spectrum.
    , avg_spec :: [Double]
    -- | Length of analysis frame (sample frames).
    , chunk_length :: Double
    -- | Start time of analysis frame (sample frames).
    , chunk_start_time :: Double
    -- | The stability of the spectral energy.  More spectrally stable
    --   frames are more likely to be pitched material.
    , spectral_stability :: Double 
    , raw_data :: (Double, Double, [[Double]]) }
             deriving (Show, Read)

-- | A segment is a pair (onset_time, duration).
type Segment = (Double, Double)

-- | Extract frame timing information.
segments :: [Frame] -> [Segment]
segments = map (\c -> (onset_time c, duration c))

-- | As association list indicating the number of data values
--   associated with each feature type.
features :: [(String, Int)]
features = [ ("AvgMelSpec", 40)
           , ("AvgChroma", 12)
           , ("AvgFramePower", 1)
           , ("AvgChromaScalar", 1)
           , ("AvgFreqSimple", 1)
           , ("AvgMFCC", 13)
           , ("AvgPitchSimple", 1)
           , ("AvgSpecCentroid", 1)
           , ("AvgSpecFlatness", 1)
           , ("AvgSpec", 513)
           , ("FrameLength", 1)
           , ("FrameStartTime", 1)
           , ("SpectralStability", 1) ]

-- | Read a MEAPsoft analysis file.
read_file :: FilePath -> IO [Frame]
read_file f =
    do h <- openFile f ReadMode
       t <- hGetContents h
       let l = drop 2 (lines t)
       return (map parse_frame l)

form_groups :: [Int] -> [a] -> [[a]]
form_groups [] _ = []
form_groups (n:ns) l = a : form_groups ns b
    where (a, b) = splitAt n l

type Chunk = (Double, Double, [[Double]])

make_chunk :: [Double] -> Chunk
make_chunk (o:t:f) = (o, t, form_groups (map snd features) f)
make_chunk _ = error "misformed data"

make_frame :: Chunk -> Frame
make_frame c@(o, t, [ f1, f2, [f3], [f4], [f5]
                    , f6, [f7], [f8], [f9], f10
                    , [f11], [f12], [f13] ]) =
    Frame o t f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 c
make_frame _ = error "make_frame"

split_on :: (Eq a) => a -> [a] -> [[a]]
split_on x xs = l' ++ r'
    where (l, r) = span (/= x) xs
          l' = if null l then [] else [l]
          r' = if null r then [] else split_on x (tail r)

to_f :: String -> Double
to_f = read

parse_frame :: String -> Frame
parse_frame = make_frame . make_chunk . map to_f . drop 1 . split_on ' '