-- | Data representation and parser for MEAPsoft analysis frames.
module Sound.Analysis.Meapsoft
    ( MEAP
    , read_meap
    , features
    , n_frames
    , uarray_data
    , n_columns
    , frame_l
    , column_l
    , position
    , segments_l
    , feature_names
    , module Sound.Analysis.Meapsoft.Data
    , module Sound.Analysis.Meapsoft.Header ) where

import Data.Array.Unboxed
import Sound.Analysis.Meapsoft.Data
import Sound.Analysis.Meapsoft.Header

-- | Data type representing a MEAPsoft anaylsis file.
data MEAP = MEAP { -- | The list of 'Feature's contained in the
                   --   analysis file.
                   features :: [Feature]
                   -- | The number of frames (rows) contained in the
                   --   analysis file.
                 , n_frames :: Int
                   -- | The analysis data stored in a 'UArray'.
                   --   Indices are of the form (row, column).
                 , uarray_data :: UArray (Int, Int) Double }

-- | Load a MEAPsoft analysis file, either a segmentation file or a
--   feature file.
--
-- > Right m <- read_meap "/home/rohan/data/audio/jonchaies.wav.seg"
-- > map feature_name (features m) == ["onset_time","chunk_length"]
read_meap :: FilePath -> IO (Either String MEAP)
read_meap fn = do
  r <- read_header fn
  case r of
    (Left e) -> return (Left e)
    (Right h) -> do let nc = sum (map feature_degree h)
                    (nf, d) <- read_data fn nc
                    return (Right (MEAP h nf d))

-- | The number of columns at each analysis frame (row).  Segmentation
-- files have two columns, onset time and segment length.
--
-- > n_columns m == 2
n_columns :: MEAP -> Int
n_columns = sum . map feature_degree . features

-- | Extract the indicated column as a list.  The length of the column
-- is the 'n_frames' of the analysis file.
--
-- > length (column_l m 0) == n_frames m
column_l :: MEAP -> Int -> [Double]
column_l m j =
    let d = uarray_data m
        is = [0 .. n_frames m - 1]
    in map (\i -> d ! (i, j)) is

-- | Extract the indicated frame (row) as a list.
--
-- > length (frame_l m 0) == n_columns m
frame_l :: MEAP -> Int -> [Double]
frame_l m i =
    let d = uarray_data m
        js = [0 .. n_columns m - 1]
    in map (\j -> d ! (i, j)) js

-- | Extract data from the indicated frame and column.
--
-- > position m (0,0) == frame_l m 0 !! 0
position :: MEAP -> (Int, Int) -> Double
position m (i, j) = uarray_data m ! (i, j)

-- | Extract segmentation data as a list.  The segmentation data is
--   given by the two columns onset_time and chunk_length.
--
-- > length (segments_l m) == n_frames m
-- > segments_l m !! 0 == (\[i,j] -> (i,j)) (frame_l m 0)
segments_l :: MEAP -> [(Double, Double)]
segments_l m =
    let fs = features m
        ec n = feature_column (required_feature n fs)
        o = ec "onset_time"
        d = ec "chunk_length"
    in zip (column_l m o) (column_l m d)

-- | The list of feature names generated by MEAPsoft 2.0.
--
-- > map (`elem` feature_names) ["onset_time","chunk_length"] == [True,True]
feature_names :: [String]
feature_names =
    ["onset_time"
    ,"chunk_length"
    ,"AvgChroma"
    ,"AvgChromaScalar"
    ,"AvgChunkPower"
    ,"AvgFreqSimple"
    ,"AvgMelSpec"
    ,"AvgMFCC"
    ,"AvgPitch"
    ,"AvgSpec"
    ,"AvgSpecCentroid"
    ,"AvgSpecFlatness"
    ,"AvgTonalCentroid"
    ,"ChunkLength"
    ,"ChunkStartTime"
    ,"Entropy"
    ,"RMSAmplitude"
    ,"SpectralStability"]