{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} -------------------------------------------------------------------------------- -- | -- Module : HarmTrace.Models.Simple.Model -- Copyright : (c) 2010-2012 Universiteit Utrecht, 2012 University of Oxford -- License : GPL3 -- -- Maintainer : bash@cs.uu.nl, jpm@cs.ox.ac.uk -- Stability : experimental -- Portability : non-portable -- -- Summary: The Simple model -------------------------------------------------------------------------------- module HarmTrace.Models.Simple.Model where import HarmTrace.Base.MusicRep import HarmTrace.Models.ChordTokens import Language.Haskell.TH.Syntax (Name) -------------------------------------------------------------------------------- -- Musical structure as a datatype -------------------------------------------------------------------------------- #ifndef NUMLEVELS #define NUMLEVELS T5 #endif -- data MajMode -- data MinMode data Proxy (t :: k) = Proxy -- High level structure data Piece = forall (mode :: Mode). Piece [Phrase mode] -- The Phrase level data Phrase (mode :: Mode) where P_1451 :: Ton mode -> SDom mode -> Dom mode -> Ton mode -> Phrase mode P_151 :: Ton mode -> Dom mode -> Ton mode -> Phrase mode P_51 :: Dom mode -> Ton mode -> Phrase mode P_15 :: Ton mode -> Dom mode -> Phrase mode P_1 :: Ton mode -> Phrase mode -- Harmonic categories -- Tonic data Ton (mode :: Mode) where -- major mode T_1 :: SD MajMode I MajClass -> Ton MajMode -- minor mode Tm_1 :: SD MinMode I MinClass -> Ton MinMode -- Dominant data Dom (mode :: Mode) where -- major mode D_2 :: SD mode V DomClass -> Dom mode -- JPM: I don't fully understand why, but D_1 cannot be the first constructor, -- else the generator loops... D_1 :: SDom mode -> Dom mode -> Dom mode D_3 :: SD mode V MajClass -> Dom mode D_4 :: SD MajMode VII DimClass -> Dom MajMode -- hard-coded V/V D_5 :: SD mode II DomClass -> SD mode V DomClass -> Dom mode -- minor mode (there must be at least one rule with "MinMode" otherwise -- no you get a "No instance for (ParseG (Dom MinMode))" error Dm_4 :: SD MinMode VII DimClass -> Dom MinMode -- Subdominant data SDom (mode :: Mode) where S_1 :: SD MajMode IV MajClass -> SDom MajMode S_2 :: SD mode II MinClass -> SDom mode -- dubious for MinMode S_3 :: SD MajMode III MinClass -> SD MajMode IV MajClass -> SDom MajMode Sm_1 :: SD MinMode IV MinClass -> SDom MinMode -- Limit secondary dominants to a few levels -- type SD mode deg clss = Base_SD deg clss NUMLEVELS type SD (mode :: Mode) (deg :: DiatonicDegree) (clss :: ClassType) = Surface_Chord deg clss data Surface_Chord (deg :: DiatonicDegree) (clss :: ClassType) where Surface_Chord :: ChordToken -> Surface_Chord deg clss {- -- A Scale degree that translates into a (non-tranformable) surface chord type Final deg clss = Surface_Chord deg clss T1 -- Datatypes for clustering harmonic degrees data Base_SD deg clss n where Base_SD :: TritMinVSub deg clss -- Min5 deg clss n -> Base_SD deg clss (Su n) -- Rule for explaining perfect secondary dominants 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) -- Minor fifth insertion 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 -- Just a "normal", final degree. The Strings are the original input. Base_Final :: FinalDimTrans deg clss -> Base_Final deg clss (Su n) -- Tritone substitution 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) -- Dimished tritone substitution accounting for dimished chord transistions 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) -} -------------------------------------------------------------------------------- -- Type Level Scale Degrees -------------------------------------------------------------------------------- -- typelevel chord classes -- data MajClass -- data MinClass -- data DomClass -- data DimClass -- Degrees (at the type level) -- 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 -- Used when we don't want to consider certain possibilities -- data Imp -- Degrees at the value level are in Tokenizer -- Type to value conversions class ToClass (clss :: ClassType) where toClass :: Proxy 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 -- The class doesn't really matter, since the degree will be impossible to parse instance ToClass NoClass where toClass _ = error "toClass NoClass" class ToDegree (deg :: DiatonicDegree) where toDegree :: Proxy 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 -- Can't ever parse these instance ToDegree Imp where toDegree _ = Note Nothing Imp {- -------------------------------------------------------------------------------- -- Type Families for Relative Scale Degrees -------------------------------------------------------------------------------- -- Diatonic fifths, and their class (comments with the CMaj scale) -- See http://en.wikipedia.org/wiki/Circle_progression type family DiatV deg :: * type instance DiatV I = Imp -- V -- G7 should be Dom type instance DiatV V = Imp -- II -- Dm7 should be SDom type instance DiatV II = VI -- Am7 type instance DiatV VI = III -- Em7 type instance DiatV III = VII -- Bhdim7 can be explained by Dim rule type instance DiatV VII = Imp -- IV -- FMaj7 should be SDom type instance DiatV IV = Imp -- I -- CMaj7 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 -- V -- G7 should be Dom type instance DiatVM V = Imp -- Dm7 should be SDom type instance DiatVM II = VIb -- Ab type instance DiatVM VI = Imp -- Em7 type instance DiatVM III = Imp -- Bhdim7 can be explained by Dim rule type instance DiatVM VII = Imp -- IV -- FMaj7 should be SDom type instance DiatVM IV = Imp -- I -- CMaj7 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 families for secondary dominants -------------------------------------------------------------------------------- -- Perfect fifths (class is always Dom) -- See http://en.wikipedia.org/wiki/Circle_of_fifths type family VDom deg :: * type instance VDom I = Imp -- interferes with dom type instance VDom IIb = VIb type instance VDom II = VI type instance VDom IIIb = VIIb -- interferes with Dm_3 type instance VDom III = VII type instance VDom IV = I type instance VDom IVs = IIb type instance VDom V = II -- interferes with Sm_1 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 -- Perfect fifths for the minor case (this is an additional -- type family to controll the reduction of ambiguities -- specifically in the minor case) type family VMin deg :: * type instance VMin I = V type instance VMin IIb = VIb type instance VMin II = VI -- interferes with sub 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 -- II interferes with sub type instance VMin VIb = IIIb type instance VMin VI = III type instance VMin VIIb = Imp --IV -- inteferes with sub IV:min type instance VMin VII = IVs type instance VMin Imp = Imp -- The tritone substitution -- See http://en.wikipedia.org/wiki/Tritone_substitution type family Tritone deg :: * type instance Tritone I = IVs type instance Tritone IVs = I type instance Tritone IIb = V -- gives undesired (ambiguous results) as type instance Tritone V = IIb -- Dom = IIb/I = IIbdim type instance Tritone II = VIb -- interferes IIbDim V type instance Tritone VIb = II type instance Tritone IIIb = VI type instance Tritone VI = IIIb type instance Tritone III = VIIb -- Interferes with VIIb from minor type instance Tritone VIIb = III type instance Tritone IV = VII type instance Tritone VII = IV type instance Tritone Imp = Imp -------------------------------------------------------------------------------- -- Type families for diminished chord transformations -------------------------------------------------------------------------------- -- in combination with the secondary dominants and enharmonic equivalency -- these type families account for ascending dim chord progressions 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 -- interferes with dim tritone V/V 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 -- Dimchords can be transposed a minor third without changing their role, -- they are enharmonically equivalent. 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 -} -- Belongs in Instances, but needs to be here due to staging restrictions allTypes :: [Name] allTypes = [ ''Phrase, ''Ton, ''Dom, ''SDom ]