module HarmTrace.Models.ChordTokens ( ChordToken (..)
, PieceToken (..)
, ParseStatus (..)
, toKeyRelTok
) where
import HarmTrace.Base.MusicRep
import HarmTrace.Base.Instances ()
import Data.Binary
import GHC.Generics (Generic)
data ChordToken = ChordToken { root :: ScaleDegree
, classType :: ClassType
, chords :: [ChordLabel]
, status :: ParseStatus
, chordNumReps :: Int
, dur :: Int
} deriving Generic
data ParseStatus = NotParsed | Parsed | Deleted | Inserted
deriving (Eq, Show, Generic)
data PieceToken = PieceToken Key [ChordToken]
toKeyRelTok :: Key -> [ChordLabel] -> [ChordToken]
toKeyRelTok k (c@(Chord r _sh _add _loc d):cs) = toKeyRelTok' k
(ChordToken (toScaleDegree k r) (toClassType c) [c] NotParsed 1 d) cs
toKeyRelTok _key [] = []
toKeyRelTok' :: Key -> ChordToken -> [ChordLabel] -> [ChordToken]
toKeyRelTok' _k p [] = [p]
toKeyRelTok' k p@(ChordToken deg clss cs' _stat n d1) (c@(Chord r _sh _a _l d2):cs)
| deg == deg2 && clss == clss2 =
toKeyRelTok' k (ChordToken deg clss (cs' ++ [c]) NotParsed (n+1) (d1+d2)) cs
| otherwise = p : toKeyRelTok' k (ChordToken deg2 clss2 [c] NotParsed 1 d2) cs
where clss2 = toClassType c
deg2 = toScaleDegree k r
instance Eq ChordToken where
(ChordToken sd clss _cs stat _n _d) == (ChordToken sd2 clss2 _cs2 stat2 _n2 _d2)
= sd == sd2 && clss == clss2 && stat == stat2
instance Show ChordToken where
show (ChordToken sd clss _cs Inserted _n _d) = show sd ++ show clss++"[Inserted]"
show (ChordToken sd clss cs Deleted _n _d) =
show sd ++ show clss ++ "[Deleted" ++ showChords cs ++ "]"
show (ChordToken sd clss cs _ _n d) = show sd ++ show clss ++ '_' : show d
++ showChords cs
showChords :: [ChordLabel] -> String
showChords = concatMap (\x -> '[' : show x ++ "]")
instance Binary ChordToken
instance Binary ParseStatus