ChordTokens.hs

{-# 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