Copyright | (c) Dima Szamozvancev |
---|---|
License | MIT |
Maintainer | ds709@cam.ac.uk |
Stability | experimental |
Portability | portable |
Safe Haskell | Safe |
Language | Haskell2010 |
Mezzo.Model.Types
Contents
Description
Types modeling basic musical constructs at the type level.
- data PitchClass
- data Accidental
- data OctaveNum
- type Duration = Nat
- data PC pc where
- data Acc acc where
- data Oct oct where
- data Dur dur where
- data PitchType where
- Pitch :: PitchClass -> Accidental -> OctaveNum -> PitchType
- Silence :: PitchType
- data Pit p where
- type family (p :: PitchType) =?= (q :: PitchType) :: Bool where ...
- type family (p1 :: PitchType) <<=? (p2 :: PitchType) :: Bool where ...
- type family (p1 :: PitchType) <<? (p2 :: PitchType) where ...
- data Mode
- data ScaleDegree
- data DegreeType = Degree ScaleDegree Accidental OctaveNum
- data KeyType = Key PitchClass Accidental Mode
- data RootType where
- PitchRoot :: PitchType -> RootType
- DegreeRoot :: KeyType -> DegreeType -> RootType
- data Mod m = Mod
- data ScaDeg sd = ScaDeg
- data KeyS k = KeyS
- data Deg d = Deg
- data Root r where
- type family RootToPitch (dr :: RootType) :: PitchType where ...
- type family PitchToNat (p :: PitchType) :: Nat where ...
- type family Sharpen (r :: RootType) :: RootType where ...
- type family Flatten (r :: RootType) :: RootType where ...
- type family Dot (d :: Duration) :: Duration where ...
- type family HalfOf (n :: Nat) :: Nat where ...
- type family FromRoot (r :: RootType) (d :: Nat) :: Partiture 1 d where ...
- type family FromSilence (d :: Nat) :: Partiture 1 d where ...
- type family FromTriplet (d :: Nat) (r1 :: RootType) (r2 :: RootType) (r3 :: RootType) :: Partiture 1 ((d + HalfOf d) + HalfOf d) where ...
- type Voice l = OptVector PitchType l
- type Partiture n l = Matrix PitchType n l
- data IntervalSize
- data IntervalClass
- data IntervalType where
- type family MakeInterval (p1 :: PitchType) (p2 :: PitchType) :: IntervalType where ...
- data IC ic = IC
- data IS is = IS
- data Intv i = Intv
- type family OctPred (o :: OctaveNum) :: OctaveNum where ...
- type family OctSucc (o :: OctaveNum) :: OctaveNum where ...
- type family HalfStepsUpBy (p :: PitchType) (n :: Nat) :: PitchType where ...
- type family HalfStepsDownBy (p :: PitchType) (n :: Nat) :: PitchType where ...
- type family RaiseBy (p :: PitchType) (i :: IntervalType) :: PitchType where ...
- type family LowerBy (p :: PitchType) (i :: IntervalType) :: PitchType where ...
- type family RaiseAllBy (ps :: Voice l) (i :: IntervalType) :: Voice l where ...
- type family LowerAllBy (ps :: Voice l) (i :: IntervalType) :: Voice l where ...
- type family RaiseAllBy' (ps :: Vector PitchType n) (i :: IntervalType) :: Vector PitchType n where ...
- type family LowerAllBy' (ps :: Vector PitchType n) (i :: IntervalType) :: Vector PitchType n where ...
- type family RaiseByOct (p :: PitchType) :: PitchType where ...
- type family LowerByOct (p :: PitchType) :: PitchType where ...
- type family RaiseAllByOct (ps :: Voice l) :: Voice l where ...
- type family TransposeUpBy (p :: Partiture n l) (i :: IntervalType) :: Partiture n l where ...
- type family TransposeDownBy (p :: Partiture n l) (i :: IntervalType) :: Partiture n l where ...
Note properties
data PitchClass Source #
The diatonic pitch class of the note.
Instances
Primitive PitchClass C Source # | |
Primitive PitchClass D Source # | |
Primitive PitchClass E Source # | |
Primitive PitchClass F Source # | |
Primitive PitchClass G Source # | |
Primitive PitchClass A Source # | |
Primitive PitchClass B Source # | |
type Rep PitchClass C Source # | |
type Rep PitchClass D Source # | |
type Rep PitchClass E Source # | |
type Rep PitchClass F Source # | |
type Rep PitchClass G Source # | |
type Rep PitchClass A Source # | |
type Rep PitchClass B Source # | |
data Accidental Source #
The accidental applied to a note.
Instances
Primitive Accidental Natural Source # | |
Primitive Accidental Flat Source # | |
Primitive Accidental Sharp Source # | |
type Rep Accidental Natural Source # | |
type Rep Accidental Flat Source # | |
type Rep Accidental Sharp Source # | |
The octave where the note resides (middle C is Oct4).
Instances
Primitive OctaveNum Oct_1 Source # | |
Primitive OctaveNum Oct0 Source # | |
Primitive OctaveNum Oct1 Source # | |
Primitive OctaveNum Oct2 Source # | |
Primitive OctaveNum Oct3 Source # | |
Primitive OctaveNum Oct4 Source # | |
Primitive OctaveNum Oct5 Source # | |
Primitive OctaveNum Oct6 Source # | |
Primitive OctaveNum Oct7 Source # | |
Primitive OctaveNum Oct8 Source # | |
type Rep OctaveNum Oct_1 Source # | |
type Rep OctaveNum Oct0 Source # | |
type Rep OctaveNum Oct1 Source # | |
type Rep OctaveNum Oct2 Source # | |
type Rep OctaveNum Oct3 Source # | |
type Rep OctaveNum Oct4 Source # | |
type Rep OctaveNum Oct5 Source # | |
type Rep OctaveNum Oct6 Source # | |
type Rep OctaveNum Oct7 Source # | |
type Rep OctaveNum Oct8 Source # | |
Singleton types for note properties
The singleton type for Accidental
.
The singleton type for Octave
.
The singleton type for Duration
.
Pitches
The type of pitches.
Constructors
Pitch :: PitchClass -> Accidental -> OctaveNum -> PitchType | A pitch made up of a pitch class, an accidental and an octave. |
Silence :: PitchType | Silence, the pitch of rests. |
Instances
type family (p :: PitchType) =?= (q :: PitchType) :: Bool where ... Source #
Enharmonic equality of pitches.
Equations
Silence =?= Silence = True | |
Silence =?= _ = False | |
_ =?= Silence = False | |
(Pitch pc acc oct) =?= (Pitch pc acc oct) = True | |
(Pitch C Flat o1) =?= (Pitch B Natural o2) = o1 .~. OctSucc o2 | |
(Pitch C Natural o1) =?= (Pitch B Sharp o2) = o1 .~. OctSucc o2 | |
(Pitch E Natural oct) =?= (Pitch F Flat oct) = True | |
(Pitch E Sharp oct) =?= (Pitch F Natural oct) = True | |
(Pitch F Flat oct) =?= (Pitch E Natural oct) = True | |
(Pitch F Natural oct) =?= (Pitch E Sharp oct) = True | |
(Pitch B Natural o1) =?= (Pitch C Flat o2) = OctSucc o1 .~. o2 | |
(Pitch B Sharp o1) =?= (Pitch C Natural o2) = OctSucc o1 .~. o2 | |
(Pitch pc1 Sharp oct) =?= (Pitch pc2 Flat oct) = ClassSucc pc1 .~. pc2 | |
(Pitch pc1 Flat oct) =?= (Pitch pc2 Sharp oct) = pc1 .~. ClassSucc pc2 | |
_ =?= _ = False |
type family (p1 :: PitchType) <<=? (p2 :: PitchType) :: Bool where ... infixl 3 Source #
Greater than or equal to for pitches.
Equations
p <<=? p = True | |
(Pitch pc1 acc oct) <<=? (Pitch pc2 acc oct) = ClassToNat pc1 <=? ClassToNat pc2 | |
(Pitch pc acc oct) <<=? (Pitch pc Sharp oct) = True | |
(Pitch pc Sharp oct) <<=? (Pitch pc acc oct) = False | |
(Pitch pc Flat oct) <<=? (Pitch pc acc oct) = True | |
(Pitch pc acc oct) <<=? (Pitch pc Flat oct) = False | |
(Pitch E Sharp oct) <<=? (Pitch F Flat oct) = False | |
(Pitch F Flat oct) <<=? (Pitch E Sharp oct) = True | |
(Pitch B Sharp oct) <<=? (Pitch C Flat oct') = If (NextOct oct oct') False (Pitch B Natural oct <<=? Pitch C Flat oct') | |
(Pitch C Flat oct) <<=? (Pitch B Sharp oct') = If (NextOct oct' oct) True (Pitch C Natural oct <<=? Pitch B Sharp oct') | |
(Pitch pc1 acc1 oct) <<=? (Pitch pc2 acc2 oct) = ClassToNat pc1 <=? ClassToNat pc2 | |
(Pitch pc1 acc1 oct1) <<=? (Pitch pc2 acc2 oct2) = OctToNat oct1 <=? OctToNat oct2 | |
p1 <<=? p2 = PitchToNat p1 <=? PitchToNat p2 |
type family (p1 :: PitchType) <<? (p2 :: PitchType) where ... infixl 3 Source #
Greater than for pitches.
Harmonic types
The mode of a key: major or minor.
data ScaleDegree Source #
The seven scale degrees.
Instances
Primitive ScaleDegree I Source # | |
Primitive ScaleDegree II Source # | |
Primitive ScaleDegree III Source # | |
Primitive ScaleDegree IV Source # | |
Primitive ScaleDegree V Source # | |
Primitive ScaleDegree VI Source # | |
Primitive ScaleDegree VII Source # | |
type Rep ScaleDegree I Source # | |
type Rep ScaleDegree II Source # | |
type Rep ScaleDegree III Source # | |
type Rep ScaleDegree IV Source # | |
type Rep ScaleDegree V Source # | |
type Rep ScaleDegree VI Source # | |
type Rep ScaleDegree VII Source # | |
data DegreeType Source #
Constructors
Degree ScaleDegree Accidental OctaveNum |
Instances
(IntRep ScaleDegree sd, IntRep Accidental acc, IntRep OctaveNum oct) => Primitive DegreeType (Degree sd acc oct) Source # | |
type Rep DegreeType (Degree sd acc oct) Source # | |
The of a scale, chord or piece.
Constructors
Key PitchClass Accidental Mode |
The root of a chord.
Constructors
PitchRoot :: PitchType -> RootType | A pitch constructs a diatonic root. |
DegreeRoot :: KeyType -> DegreeType -> RootType | A key and a scale degree constructs a scalar root. |
Instances
IntRep PitchType p => Primitive RootType (PitchRoot p) Source # | |
(IntRep PitchType p, (~) PitchType (RootToPitch (DegreeRoot k deg)) p, Primitive DegreeType deg, Primitive KeyType k) => Primitive RootType (DegreeRoot k deg) Source # | |
type Rep RootType (PitchRoot p) Source # | |
type Rep RootType (DegreeRoot k deg) Source # | |
The singleton type for Root
.
type family RootToPitch (dr :: RootType) :: PitchType where ... Source #
Convert a root to a pitch.
Note: the default octave for scalar roots is Oct2
.
Equations
RootToPitch (PitchRoot p) = p | |
RootToPitch (DegreeRoot (Key pc acc m) (Degree sd dacc oct)) = HalfStepsUpBy (Pitch pc acc oct) (DegreeOffset m sd dacc) |
type family PitchToNat (p :: PitchType) :: Nat where ... Source #
Convert a pitch to a natural number (equal to its MIDI code).
Equations
PitchToNat Silence = TypeError (Text "Can't convert a rest to a number.") | |
PitchToNat (Pitch C Natural Oct_1) = 0 | |
PitchToNat (Pitch C Sharp Oct_1) = 1 | |
PitchToNat (Pitch D Flat Oct_1) = 1 | |
PitchToNat (Pitch C Natural Oct1) = 24 | |
PitchToNat (Pitch C Natural Oct2) = 36 | |
PitchToNat (Pitch C Natural Oct3) = 48 | |
PitchToNat (Pitch C Natural Oct4) = 60 | |
PitchToNat (Pitch C Natural Oct5) = 72 | |
PitchToNat (Pitch C Natural Oct6) = 84 | |
PitchToNat p = 1 + PitchToNat (HalfStepDown p) |
type family Sharpen (r :: RootType) :: RootType where ... Source #
Sharpen a root.
Equations
Sharpen r = PitchRoot (HalfStepUp (RootToPitch r)) |
type family Flatten (r :: RootType) :: RootType where ... Source #
Flatten a root.
Equations
Flatten r = PitchRoot (HalfStepDown (RootToPitch r)) |
type family FromRoot (r :: RootType) (d :: Nat) :: Partiture 1 d where ... Source #
Create a new partiture with one voice of the given pitch.
Equations
FromRoot r d = (RootToPitch r +*+ d) :-- None |
type family FromSilence (d :: Nat) :: Partiture 1 d where ... Source #
Create a new partiture with one voice of silence.
Equations
FromSilence d = (Silence +*+ d) :-- None |
type family FromTriplet (d :: Nat) (r1 :: RootType) (r2 :: RootType) (r3 :: RootType) :: Partiture 1 ((d + HalfOf d) + HalfOf d) where ... Source #
Create a new partiture with a triplet of three notes.
Specialised musical vector types
type Partiture n l = Matrix PitchType n l Source #
A Partiture
is made up of a fixed number of voices.
Intervals
data IntervalSize Source #
The size of the interval.
Instances
data IntervalClass Source #
The class of the interval.
Instances
Primitive IntervalClass Maj Source # | |
Primitive IntervalClass Perf Source # | |
Primitive IntervalClass Min Source # | |
Primitive IntervalClass Aug Source # | |
Primitive IntervalClass Dim Source # | |
type Rep IntervalClass Maj Source # | |
type Rep IntervalClass Perf Source # | |
type Rep IntervalClass Min Source # | |
type Rep IntervalClass Aug Source # | |
type Rep IntervalClass Dim Source # | |
data IntervalType where Source #
The type of intervals.
Constructors
Interval :: IntervalClass -> IntervalSize -> IntervalType | An interval smaller than 13 semitones, where musical rules can still be enforced. |
Compound :: IntervalType | An interval larger than 13 semitones, which is large enough so that dissonance effects are not significant. |
Instances
(FunRep IntervalClass Int Int ic, IntRep IntervalSize is) => Primitive IntervalType (Interval ic is) Source # | |
type Rep IntervalType (Interval ic is) Source # | |
type family MakeInterval (p1 :: PitchType) (p2 :: PitchType) :: IntervalType where ... Source #
Make an interval from two arbitrary pitches.
Equations
MakeInterval Silence Silence = TypeError (Text "Can't make intervals from rests.") | |
MakeInterval Silence p2 = TypeError (Text "Can't make intervals from rests.") | |
MakeInterval p1 Silence = TypeError (Text "Can't make intervals from rests.") | |
MakeInterval p1 p2 = If (p1 <<=? p2) (MakeIntervalOrd p1 p2) (MakeIntervalOrd p2 p1) |
Singleton types for interval properties
Operations
type family OctPred (o :: OctaveNum) :: OctaveNum where ... Source #
Decrement an octave.
Equations
OctPred o = DecreaseOctave o 1 |
type family OctSucc (o :: OctaveNum) :: OctaveNum where ... Source #
Increment an octave.
Equations
OctSucc o = IncreaseOctave o 1 |
type family HalfStepsUpBy (p :: PitchType) (n :: Nat) :: PitchType where ... Source #
Move a pitch up by the specified number of semitones.
Equations
HalfStepsUpBy p 0 = p | |
HalfStepsUpBy p n = HalfStepUp (HalfStepsUpBy p (n - 1)) |
type family HalfStepsDownBy (p :: PitchType) (n :: Nat) :: PitchType where ... Source #
Move a pitch down by the specified number of semitones.
Equations
HalfStepsDownBy p 0 = p | |
HalfStepsDownBy p n = HalfStepDown (HalfStepsDownBy p (n - 1)) |
type family RaiseBy (p :: PitchType) (i :: IntervalType) :: PitchType where ... Source #
Raise a pitch by an interval.
Equations
RaiseBy Silence _ = Silence | |
RaiseBy _ Compound = TypeError (Text "Can't shift by compound interval") | |
RaiseBy p (Interval Min is) = HalfStepDown (HalfStepsUpBy p (IntervalWidth (Interval Min is) + 1)) | |
RaiseBy p (Interval Dim is) = HalfStepDown (HalfStepsUpBy p (IntervalWidth (Interval Dim is) + 1)) | |
RaiseBy p i = HalfStepsUpBy p (IntervalWidth i) |
type family LowerBy (p :: PitchType) (i :: IntervalType) :: PitchType where ... Source #
Lower a pitch by an interval.
Equations
LowerBy Silence _ = Silence | |
LowerBy _ Compound = TypeError (Text "Can't shift by compound interval") | |
LowerBy p (Interval Maj is) = HalfStepUp (HalfStepsDownBy p (IntervalWidth (Interval Maj is) + 1)) | |
LowerBy p (Interval Aug is) = HalfStepUp (HalfStepsDownBy p (IntervalWidth (Interval Aug is) + 1)) | |
LowerBy p i = HalfStepsDownBy p (IntervalWidth i) |
type family RaiseAllBy (ps :: Voice l) (i :: IntervalType) :: Voice l where ... Source #
Raise all pitches in a voice by an interval.
Equations
RaiseAllBy End _ = End | |
RaiseAllBy ((p :* d) :- ps) i = (RaiseBy p i :* d) :- RaiseAllBy ps i |
type family LowerAllBy (ps :: Voice l) (i :: IntervalType) :: Voice l where ... Source #
Lower all pitches in a voice by an interval.
Equations
LowerAllBy End _ = End | |
LowerAllBy ((p :* d) :- ps) i = (LowerBy p i :* d) :- LowerAllBy ps i |
type family RaiseAllBy' (ps :: Vector PitchType n) (i :: IntervalType) :: Vector PitchType n where ... Source #
Raise multiple pitches by an interval.
Equations
RaiseAllBy' None _ = None | |
RaiseAllBy' (p :-- ps) i = RaiseBy p i :-- RaiseAllBy' ps i |
type family LowerAllBy' (ps :: Vector PitchType n) (i :: IntervalType) :: Vector PitchType n where ... Source #
Lower multiple pitches by an interval.
Equations
LowerAllBy' None _ = None | |
LowerAllBy' (p :-- ps) i = LowerBy p i :-- LowerAllBy' ps i |
type family RaiseByOct (p :: PitchType) :: PitchType where ... Source #
Raise a pitch by an octave.
Equations
RaiseByOct p = RaiseBy p (Interval Perf Octave) |
type family LowerByOct (p :: PitchType) :: PitchType where ... Source #
Lower a pitch by an octave.
Equations
LowerByOct p = LowerBy p (Interval Perf Octave) |
type family RaiseAllByOct (ps :: Voice l) :: Voice l where ... Source #
Equations
RaiseAllByOct v = RaiseAllBy v (Interval Perf Octave) |
type family TransposeUpBy (p :: Partiture n l) (i :: IntervalType) :: Partiture n l where ... Source #
Transpose a partiture up by the given interval.
Equations
TransposeUpBy _ Compound = TypeError (Text "Can't transpose by compound interval.") | |
TransposeUpBy None i = None | |
TransposeUpBy (v :-- vs) i = RaiseAllBy v i :-- TransposeUpBy vs i |
type family TransposeDownBy (p :: Partiture n l) (i :: IntervalType) :: Partiture n l where ... Source #
Transpose a partiture down by the given interval.
Equations
TransposeDownBy _ Compound = TypeError (Text "Can't transpose by compound interval.") | |
TransposeDownBy None i = None | |
TransposeDownBy (v :-- vs) i = LowerAllBy v i :-- TransposeDownBy vs i |