module HarmTrace.Audio.DataParser (
parseBeatData
, parseBarTimeData
, pBeat
, parseChordinoData
, parseChromaData
, pNumData
, pComma
, pParentheticalString
, pQuotedString
, pLabel
, shift
) where
import HarmTrace.Base.MusicTime
import HarmTrace.Base.Parsing hiding (pComma,pQuotedString,pParentheticalString)
parseBeatData :: Parser BeatTrackerData
parseBeatData = pListSep_ng pLineEnd pLine <* pLineEnd where
pLine = opt pLabel "" *> pNumData <* opt (pComma *> pQuotedString) ""
parseBarTimeData :: Parser BarTimeTrackData
parseBarTimeData = pListSep_ng pLineEnd pLine <* pLineEnd where
pLine = BarTime <$> (opt pLabel "" *> pNumData )
<*> (pComma *> pBeat)
pBeat :: Parser Beat
pBeat = toBeat <$> pQuotedString where
toBeat :: String -> Beat
toBeat "1" = One
toBeat "2" = Two
toBeat "3" = Three
toBeat "4" = Four
toBeat b = error ("HarmTrace.Audio.Parser.toBeat: unknown beat " ++ b)
parseChordinoData :: Parser ChordinoData
parseChordinoData = pListSep_ng pLineEnd pChordinoLine <* pLineEnd where
pChordinoLine = const convert <$> opt pLabel ""
<*> pList1Sep (pSym ',') pNumData
convert :: [NumData] -> ChordinoLine
convert l | length l == 25 = ChordinoLine h (shift 3 a) (shift 3 b)
| otherwise = error ("parseChordinoData: Wrong list length of "
++ show (length l))
where (h:t) = l
(a,b) = splitAt 12 t
shift :: Int -> [a] -> [a]
shift p l = b ++ a where (a,b) = splitAt p l
parseChromaData :: Parser [ChordinoLine]
parseChromaData = pListSep_ng pLineEnd pCrmLine <* pLineEnd where
pCrmLine = convert <$> (opt pLabel "" *> pList1Sep (pSym ',') pNumData)
convert :: [NumData] -> ChordinoLine
convert l | length t == 12 = ChordinoLine h (shift 3 t) []
| otherwise = error ("parseChromaData: Wrong list length of "
++ show (length l))
where (h:t) = l
pNumData :: Parser NumData
pNumData = pDoubleRaw
pComma :: Parser Char
pComma = pSym ','
pParentheticalString :: Char -> Parser String
pParentheticalString d = pSym d *> pList pNonQuoteVChar <* pSym d where
pNonQuoteVChar = pSatisfy (\c -> visibleChar c && c /= d)
(Insertion ("Character in a string set off from main text" ++
"by delimiter, e.g. double-quotes or comment token") 'y' 5)
visibleChar c = '\032' <= c && c <= '\126'
pQuotedString :: Parser String
pQuotedString = pParentheticalString '"'
pLabel :: Parser String
pLabel = (pQuotedString `opt` "") <* pComma