module Sound.Analysis.Meapsoft.Header ( Feature(..)
, read_header
, find_feature
, required_feature
, has_feature
) where
import Control.Monad
import Data.List
import Data.Maybe
import System.IO
import Text.ParserCombinators.Parsec
data Feature = Feature { feature_name :: String
, feature_column :: Int
, feature_degree :: Int }
deriving (Show)
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))
find_feature :: String -> [Feature] -> Maybe Feature
find_feature n = find (\x -> feature_name x == n)
required_feature :: String -> [Feature] -> Feature
required_feature n fs = fromMaybe (error n) (find_feature n fs)
has_feature :: String -> [Feature] -> Bool
has_feature n = isJust . find_feature n
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, fromMaybe 1 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 = parse header
normalize_header :: Header -> Header
normalize_header h =
case h of
("filename",1):h' -> h'
_ -> h
mk_features :: Header -> [Feature]
mk_features h =
let acc i (f, n) = (i+n,Feature f i n)
in snd (mapAccumL acc 0 h)