{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GADTs #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} module HarmTrace.Models.ChordTokens ( ChordToken (..) , sdToNote, ctToCL , PieceToken (..) , ParseStatus (..) ) where import HarmTrace.Base.MusicRep import HarmTrace.Base.Instances () import Data.Binary import GHC.Generics (Generic) -------------------------------------------------------------------------------- -- Tokens for parsing chords -------------------------------------------------------------------------------- -- merged Chords that will be presented to the parser data ChordToken = ChordToken { root :: ScaleDegree , classType :: ClassType , chords :: [ChordLabel] , status :: ParseStatus , chordNumReps :: Int , dur :: Int -- duration } deriving Generic data ParseStatus = NotParsed | Parsed | Deleted | Inserted deriving (Eq, Show, Generic) -- a datatype to store a tokenized chords data PieceToken = PieceToken Key [ChordToken] -------------------------------------------------------------------------------- -- Instances for Chord Tokens -------------------------------------------------------------------------------- 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 _ _ _ _) = show sd ++ show clss -------------------------------------------------------------------------------- -- ChordToken to ChordLabel -------------------------------------------------------------------------------- -- This function should be moved to harmtrace-base sdToNote :: Key -> ScaleDegree -> Root sdToNote (Key r _mode) sd = toRoot . toSemitone . transposeSem sd $ toSemitone r -- This function should be moved to harmtrace-base classTypeToSH :: ClassType -> Shorthand classTypeToSH MajClass = Maj classTypeToSH MinClass = Min classTypeToSH DomClass = Sev classTypeToSH DimClass = Dim classTypeToSH NoClass = None ctToCL :: Key -> ChordToken -> ChordLabel ctToCL k (ChordToken sd ct _cs _st _reps d) = Chord (sdToNote k sd) (classTypeToSH ct) [] 0 d -------------------------------------------------------------------------------- -- Binary instances -------------------------------------------------------------------------------- instance Binary ChordToken instance Binary ParseStatus