module HarmTrace.Models.Jazz.Model where
import HarmTrace.Models.TypeLevel
import HarmTrace.Base.MusicRep
import HarmTrace.Models.ChordTokens
import Language.Haskell.TH.Syntax (Name)
#ifndef NUMLEVELS
#define NUMLEVELS T5
#endif
data MajMode
data MinMode
data Piece = forall mode. Piece [Phrase mode]
data Phrase mode where
PT :: Ton mode -> Phrase mode
PD :: Dom mode -> Phrase mode
data Ton mode where
T_1 :: Final I MajClass -> Ton MajMode
T_2 :: Final I MajClass -> Final IV MajClass
-> Final I MajClass -> Ton MajMode
T_3_par :: Final III MinClass -> Ton MajMode
T_6_bor :: TMinBorrow -> Ton MajMode
Tm_1 :: SD MinMode I MinClass -> Ton MinMode
Tm_2 :: Final I MinClass -> Final IV MinClass
-> Final I MinClass -> Ton MinMode
Tm_3_par :: Final IIIb MajClass -> Ton MinMode
Tm_6_bor :: TMajBorrow -> Ton MinMode
data Dom mode where
D_1 :: SDom mode -> Dom mode -> Dom mode
D_2 :: SD mode V DomClass -> Dom mode
D_3 :: SD mode V MajClass -> Dom mode
D_4 :: SD MajMode VII MinClass -> Dom MajMode
D_8_bor :: DMinBorrow -> Dom MajMode
Dm_4 :: SD MinMode VIIb MajClass -> Dom MinMode
Dm_8_bor :: DMajBorrow -> Dom MinMode
data SDom mode where
S_1_par :: SD mode II MinClass -> SDom mode
S_2_par :: SD mode II DomClass -> Final II MinClass
-> SDom mode
S_3 :: SD MajMode IV MajClass -> SDom MajMode
S_4 :: SD MajMode III MinClass -> Final IV MajClass
-> SDom MajMode
S_5_bor :: SMinBorrow -> SDom MajMode
Sm_3 :: SD MinMode IV MinClass -> SDom MinMode
Sm_4 :: SD MinMode IIIb MajClass -> Final IV MinClass
-> SDom MinMode
Sm_5_bor :: SMajBorrow -> SDom MinMode
Sm_6 :: SD MinMode IIb MajClass -> SDom MinMode
data TMinBorrow = Tm_21_bor (SD MinMode I MinClass)
| Tm_23_bor (SD MinMode IIIb MajClass)
data DMinBorrow = Dm_24_bor (SD MinMode VIIb MajClass)
data SMinBorrow = Sm_20_bor (SD MinMode IV MinClass)
| Sm_22_bor (SD MinMode IIb MajClass)
data TMajBorrow = T_21_bor (SD MajMode I MajClass)
| T_23_bor (SD MajMode III MinClass)
data DMajBorrow = D_24_bor (SD MajMode VII MinClass)
data SMajBorrow = S_20_bor (SD MajMode IV MajClass)
type SD mode deg clss = Base_SD deg clss NUMLEVELS
type TritMinVSub deg clss = Base_Final deg clss T2
type FinalDimTrans deg clss = Surface_Chord deg clss T4
type Final deg clss = Surface_Chord deg clss T1
data Base_SD deg clss n where
Base_SD :: TritMinVSub deg clss
-> Base_SD deg clss (Su n)
Cons_Vdom :: Base_SD (VDom deg) DomClass n -> Base_SD deg clss n
-> Base_SD deg clss (Su n)
Cons_Diat :: Base_SD (DiatV deg) MinClass n -> Base_SD deg MinClass n
-> Base_SD deg MinClass (Su n)
Cons_DiatM :: Base_SD (DiatVM deg) MajClass n -> Base_SD deg MajClass n
-> Base_SD deg MajClass (Su n)
Cons_DiatM' :: Base_SD (DiatVM deg) MajClass n -> Base_SD deg MinClass n
-> Base_SD deg MinClass (Su n)
Cons_Vmin :: Base_SD (VMin deg) MinClass n -> Base_SD deg DomClass n
-> Base_SD deg DomClass (Su n)
data Base_Final deg clss n where
Base_Final :: FinalDimTrans deg clss -> Base_Final deg clss (Su n)
Final_Tritone :: Base_Final (Tritone deg) DomClass n
-> Base_Final deg DomClass (Su n)
Final_Dim_V :: Base_Final (IIbDim deg) DimClass n
-> Base_Final deg DomClass (Su n)
data Surface_Chord deg clss n where
Surface_Chord :: ChordToken
-> Surface_Chord deg clss (Su n)
Dim_Chord_Trns :: Surface_Chord (MinThird deg) DimClass n
-> Surface_Chord deg DimClass (Su n)
data MajClass
data MinClass
data DomClass
data DimClass
data I
data Ib
data Is
data II
data IIb
data IIs
data III
data IIIb
data IIIs
data IV
data IVb
data IVs
data V
data Vb
data Vs
data VI
data VIb
data VIs
data VII
data VIIb
data VIIs
data Imp
class ToClass clss where
toClass :: clss -> ClassType
instance ToClass MajClass where toClass _ = MajClass
instance ToClass MinClass where toClass _ = MinClass
instance ToClass DomClass where toClass _ = DomClass
instance ToClass DimClass where toClass _ = DimClass
instance ToClass Imp where toClass _ = DimClass
class ToDegree deg where
toDegree :: deg -> ScaleDegree
instance ToDegree I where toDegree _ = Note Nothing I
instance ToDegree II where toDegree _ = Note Nothing II
instance ToDegree III where toDegree _ = Note Nothing III
instance ToDegree IV where toDegree _ = Note Nothing IV
instance ToDegree V where toDegree _ = Note Nothing V
instance ToDegree VI where toDegree _ = Note Nothing VI
instance ToDegree VII where toDegree _ = Note Nothing VII
instance ToDegree Ib where toDegree _ = Note (Just Fl) I
instance ToDegree IIb where toDegree _ = Note (Just Fl) II
instance ToDegree IIIb where toDegree _ = Note (Just Fl) III
instance ToDegree IVb where toDegree _ = Note (Just Fl) IV
instance ToDegree Vb where toDegree _ = Note (Just Fl) V
instance ToDegree VIb where toDegree _ = Note (Just Fl) VI
instance ToDegree VIIb where toDegree _ = Note (Just Fl) VII
instance ToDegree IIs where toDegree _ = Note (Just Sh) II
instance ToDegree IIIs where toDegree _ = Note (Just Sh) III
instance ToDegree IVs where toDegree _ = Note (Just Sh) IV
instance ToDegree Vs where toDegree _ = Note (Just Sh) V
instance ToDegree VIs where toDegree _ = Note (Just Sh) VI
instance ToDegree VIIs where toDegree _ = Note (Just Sh) VII
instance ToDegree Imp where toDegree _ = Note Nothing Imp
type family DiatV deg :: *
type instance DiatV I = Imp
type instance DiatV V = Imp
type instance DiatV II = VI
type instance DiatV VI = III
type instance DiatV III = VII
type instance DiatV VII = Imp
type instance DiatV IV = Imp
type instance DiatV IIb = Imp
type instance DiatV IIIb = Imp
type instance DiatV IVs = Imp
type instance DiatV VIb = Imp
type instance DiatV VIIb = Imp
type instance DiatV Imp = Imp
type family DiatVM deg :: *
type instance DiatVM I = Imp
type instance DiatVM V = Imp
type instance DiatVM II = VIb
type instance DiatVM VI = Imp
type instance DiatVM III = Imp
type instance DiatVM VII = Imp
type instance DiatVM IV = Imp
type instance DiatVM IIb = Imp
type instance DiatVM IIIb = VIIb
type instance DiatVM IVs = Imp
type instance DiatVM VIb = IIIb
type instance DiatVM VIIb = Imp
type instance DiatVM Imp = Imp
type family VDom deg :: *
type instance VDom I = Imp
type instance VDom IIb = VIb
type instance VDom II = VI
type instance VDom IIIb = VIIb
type instance VDom III = VII
type instance VDom IV = I
type instance VDom IVs = IIb
type instance VDom V = II
type instance VDom VIb = IIIb
type instance VDom VI = III
type instance VDom VIIb = IV
type instance VDom VII = IVs
type instance VDom Imp = Imp
type family VMin deg :: *
type instance VMin I = V
type instance VMin IIb = VIb
type instance VMin II = VI
type instance VMin IIIb = VIIb
type instance VMin III = VII
type instance VMin IV = I
type instance VMin IVs = IIb
type instance VMin V = Imp
type instance VMin VIb = IIIb
type instance VMin VI = III
type instance VMin VIIb = Imp
type instance VMin VII = IVs
type instance VMin Imp = Imp
type family Tritone deg :: *
type instance Tritone I = IVs
type instance Tritone IVs = I
type instance Tritone IIb = V
type instance Tritone V = IIb
type instance Tritone II = VIb
type instance Tritone VIb = II
type instance Tritone IIIb = VI
type instance Tritone VI = IIIb
type instance Tritone III = VIIb
type instance Tritone VIIb = III
type instance Tritone IV = VII
type instance Tritone VII = IV
type instance Tritone Imp = Imp
type family IIbDim deg :: *
type instance IIbDim I = IIb
type instance IIbDim IIb = II
type instance IIbDim II = IIIb
type instance IIbDim IIIb = III
type instance IIbDim III = IV
type instance IIbDim IV = IVs
type instance IIbDim IVs = V
type instance IIbDim V = VIb
type instance IIbDim VIb = VI
type instance IIbDim VI = VIIb
type instance IIbDim VIIb = VII
type instance IIbDim VII = I
type instance IIbDim Imp = Imp
type family MinThird deg :: *
type instance MinThird I = IIIb
type instance MinThird IIb = III
type instance MinThird II = IV
type instance MinThird IIIb = IVs
type instance MinThird III = V
type instance MinThird IV = VIb
type instance MinThird IVs = VI
type instance MinThird V = VIIb
type instance MinThird VIb = VII
type instance MinThird VI = I
type instance MinThird VIIb = IIb
type instance MinThird VII = II
type instance MinThird Imp = Imp
allTypes :: [Name]
allTypes = [ ''Phrase, ''Ton, ''Dom, ''SDom
, ''TMinBorrow, ''DMinBorrow, ''SMinBorrow
, ''TMajBorrow, ''DMajBorrow, ''SMajBorrow ]