FComp-1.0: src/HarmTrace/Models/Simple/Model.hs
{-# 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 ]