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 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 = maybe (error n) id (find_feature n fs)
has_feature :: String -> [Feature] -> Bool
has_feature n fs = maybe False (const True) (find_feature n fs)
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
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)