moduleMusic.Theory.IntervalwhereimportMusic.Theory.PitchdataInterval_T=Unison|Second|Third|Fourth|Fifth|Sixth|Seventhderiving(Eq,Ord,Enum,Show)dataInterval_Q=Diminished|Minor|Perfect|Major|Augmentedderiving(Eq,Ord,Enum,Show)dataInterval=Interval{interval_type::Interval_T,interval_quality::Interval_Q,interval_direction::Ordering,interval_octave::Octave}deriving(Eq,Show)interval_ty::Note_T->Note_T->Interval_Tinterval_tyn1n2=toEnum((fromEnumn2-fromEnumn1)`mod`7)interval_q_tbl::[(Interval_T,[(Int,Interval_Q)])]interval_q_tbl=[(Unison,[(11,Diminished),(0,Perfect),(1,Augmented)]),(Second,[(0,Diminished),(1,Minor),(2,Major),(3,Augmented)]),(Third,[(2,Diminished),(3,Minor),(4,Major),(5,Augmented)]),(Fourth,[(4,Diminished),(5,Perfect),(6,Augmented)]),(Fifth,[(6,Diminished),(7,Perfect),(8,Augmented)]),(Sixth,[(7,Diminished),(8,Minor),(9,Major),(10,Augmented)]),(Seventh,[(9,Diminished),(10,Minor),(11,Major),(12,Augmented)])]interval_q::Interval_T->Int->MaybeInterval_Qinterval_qin=caselookupiinterval_q_tblofJustt->lookupntNothing->Nothingnote_span::Note_T->Note_T->[Note_T]note_spann1n2=letfnx=toEnum(x`mod`7)n1'=fromEnumn1n2'=fromEnumn2n2''=ifn1'>n2'thenn2'+7elsen2'inmapfn[n1'..n2'']invert_ordering::Ordering->Orderinginvert_orderingx=casexofGT->LTLT->GTEQ->EQinterval::Pitch->Pitch->Intervalintervalp1p2=letc=comparep1p2(Pitchn1_o1)=p1(Pitchn2_o2)=p2p1'=pitch_to_pcp1p2'=pitch_to_pcp2st=(p2'-p1')`mod`12ty=interval_tyn1n2(Justqu)=interval_qty(fromIntegralst)o_a=ifn1>n2then-1else0incasecofGT->(intervalp2p1){interval_direction=GT}_->Intervaltyquc(o2-o1+o_a)invert_interval::Interval->Intervalinvert_interval(Intervaltqudo)=letd'=invert_orderingdinIntervaltqud'o-- can this be written without knowing the Interval_T?quality_difference::Interval_Q->Interval_Q->Intquality_differenceab=letrule(x,y)=ifx==ythenJust0elsecase(x,y)of(Diminished,Minor)->Just1(Diminished,Major)->Just2(Diminished,Augmented)->Just3(Minor,Major)->Just1(Minor,Augmented)->Just2(Major,Augmented)->Just1(Diminished,Perfect)->Just1(Perfect,Augmented)->Just1_->Nothingfwd=rule(a,b)rvs=rule(b,a)err=error("quality_difference: "++show(a,b))incasefwdofJustn->nNothing->caservsofJustn->negatenNothing->errtranspose::Interval->Pitch->Pitchtransposeiip=let(Pitchp_np_ap_o)=ip(Intervali_ti_qi_di_o)=ii_d'=ifi_d==GTthen-1else1p_n'=toEnum((fromEnump_n+(fromEnumi_t*i_d'))`mod`7)-- oa = octave alterationoa=ifp_n'>p_n&&i_d==GTthen-1elseifp_n'<p_n&&i_d==LTthen1else0ip'=Pitchp_n'p_a(p_o+i_o+oa)st=ifi_d==GTthen(pitch_to_pcip-pitch_to_pcip')`mod`12else(pitch_to_pcip'-pitch_to_pcip)`mod`12ty=ifi_d==GTtheninterval_typ_n'p_nelseinterval_typ_np_n'qu=maybe(error("qu: "++show(ty,st)))id(interval_qty(fromIntegralst))qd=quality_differencequi_q*i_d'p_a'=toEnum(fromEnump_a+(qd*2))inip'{alteration=p_a'}circle_of_fifths::Pitch->([Pitch],[Pitch])circle_of_fifthsx=letp4=IntervalFourthPerfectLT0p5=IntervalFifthPerfectLT0mky=take12(iterate(transposey)x)in(mkp4,mkp5)