Housekeeping

src/Base/Chord/Chord.hs

@@ -39,7 +39,7 @@ import Base.Core.Interval
 import Common.Utils (uncurry4, uncurry5)
 
 import Data.Function (on)
-import Data.List (sortBy, zip4, zip5)
+import Data.List (sortBy, zip4, zip5, intercalate)
 import qualified Data.List as L
 import Data.Map as M
 import Data.Maybe (catMaybes, fromJust)
@@ -48,7 +48,11 @@ import Data.Maybe (catMaybes, fromJust)
 -- but with the specific notes as well.
 data Chord = Chord { getSymbol :: ChordSymbol
                    , getNotes :: [Note]
-                   } deriving (Eq, Show)
+                   } deriving (Eq)
+
+instance Show Chord where
+  show c = show (getSymbol c) ++ ", [" ++ intercalate ", " (show <$> getNotes c) ++ "]"
+
 
 -- | A Chord has all the properties of the Chordal typeclass
 instance Chordal Chord where
@@ -97,13 +101,13 @@ notesToChord notes =
 
     findQuality :: Note -> CQ.Quality
     findQuality root
-      | hasInterval IQ.Major 3 && hasInterval IQ.Minor 7 = CQ.Dominant
-      | hasInterval IQ.Major 3 && hasInterval (IQ.Augmented 1) 5 = CQ.Augmented
-      | hasInterval IQ.Major 3 = CQ.Major
-      | hasInterval IQ.Minor 3 && hasInterval IQ.Minor 7 = CQ.Minor
-      | hasInterval IQ.Minor 3 && hasInterval (IQ.Diminished 1) 5 = CQ.Diminished
-      | hasInterval IQ.Minor 3 = CQ.Minor
-      | hasInterval IQ.Minor 7 = CQ.Dominant
+      | hasInterval IQ.major 3 && hasInterval IQ.minor 7 = CQ.Dominant
+      | hasInterval IQ.major 3 && hasInterval (fromJust $ IQ.augmented 1) 5 = CQ.Augmented
+      | hasInterval IQ.major 3 = CQ.Major
+      | hasInterval IQ.minor 3 && hasInterval IQ.minor 7 = CQ.Minor
+      | hasInterval IQ.minor 3 && hasInterval (fromJust $ IQ.diminished 1) 5 = CQ.Diminished
+      | hasInterval IQ.minor 3 = CQ.Minor
+      | hasInterval IQ.minor 7 = CQ.Dominant
       | otherwise = CQ.Major
       where
         notesContainIntervalFromNote :: [Note] -> Note -> Interval -> Bool
@@ -132,7 +136,7 @@ notesToChord notes =
         cInts = intervalBetweenNotes root <$> roots
 
         majorOrNot :: Int -> HighestNatural
-        majorOrNot = if (quality /= CQ.Major) && fromJust (intervalFrom IQ.Major 7) `elem` cInts
+        majorOrNot = if (quality /= CQ.Major) && fromJust (intervalFrom IQ.major 7) `elem` cInts
                      then majorNatural
                      else nonMajorNatural
 
@@ -159,10 +163,10 @@ notesToChord notes =
         containsThird = 3 `elem` (getSize <$> cInts)
 
         has2 :: Bool
-        has2 = fromJust (intervalFrom IQ.Major 2) `elem` cInts
+        has2 = fromJust (intervalFrom IQ.major 2) `elem` cInts
 
         has4 :: Bool
-        has4 = fromJust (intervalFrom IQ.Perfect 4) `elem` cInts
+        has4 = fromJust (intervalFrom IQ.perfect 4) `elem` cInts
 
     chordSuses :: [Sus]
     chordSuses = uncurry findSus <$> zip roots highNats
@@ -187,10 +191,10 @@ notesToChord notes =
 
         noSusInts :: [Interval]
         noSusInts
-          | chordSus == sus 2 = L.delete (fromJust (intervalFrom IQ.Major 2)) noNatInts
-          | chordSus == sus 4 = L.delete (fromJust (intervalFrom IQ.Perfect 4)) noNatInts
-          | (chordSus == susNoNum && numHighNat < 9) = L.delete (fromJust (intervalFrom IQ.Major 2))
-                                                     $ L.delete (fromJust (intervalFrom IQ.Perfect 4)) noNatInts
+          | chordSus == sus 2 = L.delete (fromJust (intervalFrom IQ.major 2)) noNatInts
+          | chordSus == sus 4 = L.delete (fromJust (intervalFrom IQ.perfect 4)) noNatInts
+          | (chordSus == susNoNum && numHighNat < 9) = L.delete (fromJust (intervalFrom IQ.major 2))
+                                                     $ L.delete (fromJust (intervalFrom IQ.perfect 4)) noNatInts
           | otherwise = noNatInts
 
         intToExt :: Interval -> Extension

src/Base/Chord/Diatonic.hs

@@ -82,7 +82,7 @@ diatonicChord scale@(Scale note mode) numNotes degree jumpSize =
 -- | Given a degree, returns a function that creates a diatonic triadic major chord
 -- from a key (i.e. a Note) and the number of notes.
 getMajorFuncChord :: Int -> Note -> Int -> Maybe Chord
-getMajorFuncChord deg key numNotes = diatonicChord (Scale key (modeFrom Ionian [])) numNotes deg 2
+getMajorFuncChord deg key numNotes = diatonicChord (Scale key (fromJust (modeFrom Ionian []))) numNotes deg 2
 
 -- | Given a key and a number of notes, this returns a triadic I chord.
 -- If number of notes is not between 2 and 7, this returns Nothing.

src/Base/Chord/Shape.hs

@@ -26,13 +26,19 @@ import Base.Class.Chordal
 import Base.Scale.Heliotonic
 
 import Data.Set hiding (foldr)
+import Data.List(intercalate)
 
 -- | A ChordShape, e.g. a M7 chord, is a rootless abstract shape.
 data ChordShape = ChordShape { getQuality :: Quality
                              , getHighestNatural :: HighestNatural
                              , getExtensions :: [Extension]
                              , getSus :: Sus
-                             } deriving (Eq, Show)
+                             } deriving (Eq)
+
+instance Show ChordShape where
+  show c = show (getQuality c) ++ show (getHighestNatural c)
+        ++ concat (show <$> getExtensions c) ++ show (getSus c)
+
 
 -- | ChordShape has all the properties of the Chordal typeclass
 instance Chordal ChordShape where

src/Base/Chord/Subs.hs

@@ -47,20 +47,19 @@ import qualified Data.Set as S (delete)
 import Data.Maybe(fromJust, catMaybes, isJust)
 import Base.Core.PitchClass(pitchClass)
 import qualified Data.Map.Strict as M (lookup, elems)
-import Base.Scale.Scale
+import Base.Scale.Scale as Sc
 import Language.Parser
 
 -- | Removes the P5 interval from a given chord's note if it exists
 -- and returns the same chord symbol.
 --
--- prop> remove5 (chord, _) == chord
+-- prop> getSymbol $ remove5 chord == getSymbol chord
 --
 -- >>> c = canonicalizeChord $ fromJust $ parseChord "CM7"
--- >>> notes = chordToNotes c
--- >>> remove5 (c, notes)
--- (CM7,[C,E,B])
+-- >>> remove5 (chordFromSymbol c)
+-- CM7, [C, E, B]
 remove5 :: Chord -> Chord
-remove5 chord = updateNotes chord $ toNotes (root chord) $ S.delete (fromJust(intervalFrom Perfect 5)) (toIntervals chord)
+remove5 chord = updateNotes chord $ toNotes (root chord) $ S.delete (fromJust(intervalFrom perfect 5)) (toIntervals chord)
   where
     toNotes :: Note -> Set Interval -> [Note]
     toNotes root intSet = flip jumpIntervalFromNote root <$> toList intSet
@@ -118,33 +117,35 @@ negative key chord = head $ notesToChord newNotes
 -- this transposes the chord by that interval. Because this function
 -- is only used internally by the module, it assumes the intervals are
 -- validly constructed.
--- TODO: Make this a safe, general-purpose, exportable function
-transposeChord :: Chord -> IQ.Quality -> Int -> Chord
-transposeChord chord iQual i =
+transposeChord :: Chord -> Interval -> Chord
+transposeChord chord interval =
   let
-    newChord = transposeToRoot (getSymbol chord )$ respell $ jumpIntervalFromNote (fromJust (intervalFrom iQual i)) $ root chord
+    newChord = transposeToRoot (getSymbol chord )$ respell $ jumpIntervalFromNote interval $ root chord
   in
     chordFromSymbol newChord
 
 -- | Given a dominant chord or a minor 6 chord, this returns
 -- a list of chord substitutions from its diminished family.
 --
 -- >>> c = canonicalizeChord $ fromJust $ parseChord "C7"
--- >>> notes = chordToNotes c
--- >>> dimFamilySub (c, notes)
--- [(Eb7,[Eb,G,Bb,Db]),(Gb7,[Gb,Bb,Db,Fb]),(A7,[A,C#,E,G])]
+-- >>> dimFamilySub (chordFromSymbol c)
+-- [Chord {getSymbol = ChordSymbol {getChordRoot = Eb, getShape = ChordShape {getQuality = , getHighestNatural = 7, getExtensions = [], getSus = }}, getNotes = [Eb,G,Bb,Db]},Chord {getSymbol = ChordSymbol {getChordRoot = Gb, getShape = ChordShape {getQuality = , getHighestNatural = 7, getExtensions = [], getSus = }}, getNotes = [Gb,Bb,Db,Fb]},Chord {getSymbol = ChordSymbol {getChordRoot = A, getShape = ChordShape {getQuality = , getHighestNatural = 7, getExtensions = [], getSus = }}, getNotes = [A,C#,E,G]}]
 dimFamilySub :: Chord -> [Chord]
 dimFamilySub eChord
   |  quality eChord == CQ.Dominant ||
-    (quality eChord == CQ.Minor && (fromJust (intervalFrom IQ.Major 6) `member` toIntervals eChord))
-    = [transposeChord eChord IQ.Minor 3, transposeChord eChord (IQ.Diminished 1) 5, transposeChord eChord IQ.Major 6]
+    (quality eChord == CQ.Minor && (fromJust (intervalFrom IQ.major 6) `member` toIntervals eChord))
+    = [transposeBy IQ.minor 3, transposeBy (fromJust $ IQ.diminished 1) 5, transposeBy IQ.major 6]
   | otherwise = []
+  where
+    transposeBy :: IQ.Quality -> Int -> Chord
+    transposeBy iQual i = transposeChord eChord $ fromJust $ intervalFrom iQual i
+
 
 -- | Returns the same chord, but a tritone away.
 -- If applied twice in a row, returns the same chord:
 -- prop> tritoneSub $ tritoneSub (chord, notes) == (_, notes)
 tritoneSub :: Chord -> Chord
-tritoneSub eChord = transposeChord eChord (IQ.Augmented 1) 4
+tritoneSub eChord = transposeChord eChord $ fromJust $ intervalFrom (fromJust $ IQ.augmented 1) 4
 
 -- | Given a key, and a chord in the key, this returns
 -- a list of chords that are diatonic functional substitutes.
@@ -161,10 +162,10 @@ diatonicFuncSub key chord
   | validSub && degree == 7 = [fromJust (dominant key numNotes)]
   where
     validSub :: Bool
-    validSub = chord `isDiatonicTo` major key
+    validSub = chord `isDiatonicTo` Sc.major key
 
     degree :: Int
-    degree = 1 + fromJust (elemIndex (root chord) (scaleToNotes (major key)))
+    degree = 1 + fromJust (elemIndex (root chord) (scaleToNotes (Sc.major key)))
 
     numNotes :: Int
     numNotes = length $ toNotes chord

src/Base/Chord/Symbol.hs

@@ -36,7 +36,11 @@ import Data.Set
 -- a C and a M7 gives us a CM7.
 data ChordSymbol = ChordSymbol { getChordRoot :: Note
                                , getShape :: ChordShape
-                               } deriving (Eq, Show)
+                               } deriving (Eq)
+
+instance Show ChordSymbol where
+  show c = show (getChordRoot c) ++ show (getShape c)
+
 
 -- | ChordSymbol has all the properties of the Chordal typeclass,
 -- most importantly, that it can be converted to a set of intervals.

src/Base/Core/Interval.hs

@@ -44,7 +44,7 @@ import Common.Utils (modByFrom)
 
 import Control.Monad (zipWithM)
 
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, isJust, fromMaybe)
 import Data.Set as S hiding (filter)
 
 -- | Intervals are defined by a quality and a size.
@@ -74,8 +74,6 @@ normalizeIntervalSize = modByFrom 7 1
 -- TODO: This should probably return an Either String Interval (or an error
 -- type in place of String) instead of Maybe Interval, in order to facilitate
 -- more sophisticated error handling / reporting.
---
--- TODO: Make sure diminished and augmented don't get arguments > 11
 intervalFrom :: Quality -> Int -> Maybe Interval
 intervalFrom q s = if normalizedSize `elem` goodSizes then
                      Just Interval { getQuality = q, getSize = normalizedSize }
@@ -113,7 +111,7 @@ intervalToDistance interval =
     -- Minor shifts
     Interval Minor   i ->
       case baseQuality i of
-        Major   -> subtract 1 <$> intervalToDistance (Interval Major i)
+        Major   -> subtract 1 <$> intervalToDistance (Interval major i)
         Perfect -> Nothing
 
     -- Augmented shifts
@@ -149,35 +147,35 @@ instance Invertible Interval where
       newI = normalizeIntervalSize $ 9 - normalizeIntervalSize i
       newQual =
         case iQual of
-          Major          -> Minor
-          Minor          -> Major
-          Perfect        -> Perfect
-          (Augmented x)  -> Diminished x
-          (Diminished x) -> Augmented x
+          Major          -> minor
+          Minor          -> major
+          Perfect        -> perfect
+          (Augmented x)  -> fromJust $ diminished x
+          (Diminished x) -> fromJust $ augmented x
     in
       Interval newQual newI
 
 -- | When adding an integer to an interval with this infix operator,
 -- the interval's distance is increased by that integer without
 -- changing its size.
 --
--- TODO: Figure out what to do if dim and aug < 11 and this function
--- receives an integer argument > 11.
---
 -- prop> intervalToDistance i + x == intervalToDistance (i <+> x)
 -- prop> getSize (i <+> _) == getSize i
 infixl 6 <+>
 (<+>) :: Interval -> Int -> Interval
-Interval iQual i <+> x =
-  Interval (iterate modFunc iQual !! abs x) i
+Interval iQual i <+> x = Interval newQual i
   where
+    unwrapMaybeQ :: (Quality -> Maybe Quality) -> Quality -> Quality
+    unwrapMaybeQ f qual = fromMaybe (baseQuality i) (f qual)
     modFunc =
       case (baseQuality i, signum x) of
         (Perfect, 1)  -> raisePerfect
         (Major, 1)    -> raiseMajor
         (Perfect, -1) -> lowerPerfect
         (Major, -1)   -> lowerMajor
-        (_, 0)         -> id
+        (_, 0)         -> return
+    smartMod = unwrapMaybeQ modFunc
+    newQual = iterate smartMod iQual !! abs x
 
 -- | When subtracting an integer from an interval with this infix operator,
 -- the interval's distance is decreased by that integer without
@@ -252,7 +250,5 @@ nthDegreeIntervals ints n = S.map (|-| noteInterval) ints
   where
    noteInterval = toAscList ints !! (n - 1)
 
-zipToIntervalSet :: [Quality] -> [Int] -> Maybe (Set Interval)
-zipToIntervalSet quals sizes =
-  do ints <- zipWithM intervalFrom quals sizes
-     return $ fromList ints
+zipToIntervalSet :: [Quality] -> [Int] -> Set Interval
+zipToIntervalSet quals sizes = fromList (fromJust . uncurry intervalFrom <$> zip quals sizes)