module Sound.Analysis.Meapsoft.Header ( Feature(..)
                                      , read_header
                                      , find_feature
                                      , required_feature
                                      , has_feature
                                      ) where

import Control.Monad
import Data.List
import System.IO
import Text.ParserCombinators.Parsec

-- | Data type representing a MEAPsoft analysis feature.  The
--   'feature_column' is the integer column index for the feature in
--   the analysis data.  The 'feature_degree' is the number of columns
--   the feature requires.
data Feature = Feature { feature_name :: String
                       , feature_column :: Int
                       , feature_degree :: Int }
               deriving (Show)

-- | Read the header of a MEAPsoft analysis file and extract the list
--   of stored features.
read_header :: FilePath -> IO (Either String [Feature])
read_header fn = do
  s <- read_header_string fn
  let r = parse_header fn s
  return (case r of
            (Right h) -> Right (mk_features (normalize_header h))
            (Left e) -> Left (show e))

-- | Search for a named feature.
find_feature :: String -> [Feature] -> Maybe Feature
find_feature n = find (\x -> feature_name x == n)

-- | A variant of 'find_feature' that raises an error if the feature
--   is not located.  All analysis files have the features onset_time
--   and chunk_length.
required_feature :: String -> [Feature] -> Feature
required_feature n fs = maybe (error n) id (find_feature n fs)

-- | True iff the analysis data contains the named feature.
has_feature :: String -> [Feature] -> Bool
has_feature n fs = maybe False (const True) (find_feature n fs)

-- Parsec parser for header string.

type P a = GenParser Char () a

word :: P String
word = many1 (letter <|> oneOf "_") <?> "word"

whitespace :: P String
whitespace = many1 (oneOf " \t")

in_paren :: P a -> P a
in_paren p =
    do { char '('
       ; r <- p
       ; char ')'
       ; return r }

int :: P Int
int = liftM read (optional (char '-') >> many1 digit)

feature :: P (String, Int)
feature =
  do { f <- word
     ; n <- optionMaybe (try (in_paren int))
     ; return (f, maybe 1 id n) }

type Header = [(String, Int)]

features :: P Header
features = sepEndBy1 feature whitespace

hash :: P Char
hash = char '#'

header :: P Header
header = hash >> features

read_header_string :: String -> IO String
read_header_string fn = withFile fn ReadMode hGetLine

parse_header :: String -> String -> Either ParseError Header
parse_header fn s = parse header fn s

-- Delete 'filename', which is a string.
normalize_header :: Header -> Header
normalize_header (("filename",1):xs) = xs
normalize_header xs = xs

mk_features :: Header -> [Feature]
mk_features h =
    let acc i (f, n) = (i+n, (Feature f i n))
    in snd (mapAccumL acc 0 h)