-- | 'String' variant of parser.
module Sound.Analysis.Spear.PTPF.String where

import Data.List
import Sound.Analysis.Spear.PTPF hiding (ptpf_node,ptpf_seq,ptpf_header,parse_ptpf)

-- | Parse 'Node'.
ptpf_node :: Int -> (String,String,String) -> Node
ptpf_node n (t,f,a) = Node n (read t) (read f) (read a)

-- | Parse 'Seq' from pair of input lines.
ptpf_seq :: (String,String) -> Seq
ptpf_seq (i,j) =
    let [ix,n,st,et] = words i
        ix' = read ix
        n' = read n
        p = map (ptpf_node ix') (triples (words j))
    in if n' /= length p
       then error "ptpf_seq"
       else Seq ix' (read st) (read et) n' (at_last n_zero_amplitude p)

-- | Parse header section, result is number of partials.
ptpf_header :: [String] -> Maybe Int
ptpf_header h =
    let r0 = "par-text-partials-format"
        r1 = "point-type time frequency amplitude"
        r2 = "partials-count "
        r3 = "partials-data"
    in case h of
         [h0,h1,h2,h3] -> if h0 == r0 && h1 == r1 && h3 == r3
                          then fmap read (stripPrefix r2 h2)
                          else Nothing
         _ -> Nothing

-- | Parse 'PTPF' at 'String'.
parse_ptpf :: String -> Either String PTPF
parse_ptpf s =
    let l = lines s
        (h,d) = splitAt 4 l
    in case ptpf_header h of
         Just np -> let p = map ptpf_seq (duples d)
                    in if length p /= np
                       then Left "parse_ptpf: partial count"
                       else Right (PTPF np p)
         _ -> Left "parse_ptpf: illegal header"