MusicalTheory.hs

import Test.HUnit

data NaturalNote = C | D | E | F | G | A | B deriving (Show, Eq, Enum)
data Note = Natural NaturalNote | Sharp NaturalNote | Flat NaturalNote deriving (Show, Eq)

data Interval = Half | Whole
type Jump = [Interval]

notes = cycle [Natural C,
               Sharp C,
               Natural D,
               Sharp D,
               Natural E,
               Natural F,
               Sharp F,
               Natural G,
               Sharp G,
               Natural A,
               Sharp A,
               Natural B]

nextNote B = C
nextNote note = succ note

valueOf Half = 1
valueOf Whole = 2

convert (Natural note1) (Sharp note2) = if note1 == note2
                                        then [Natural note1, Flat (nextNote note2)]
                                        else [(Natural note1), (Sharp note2)]
convert note1 note2 = [note1, note2]

uniqueNotes [n] = [n]
uniqueNotes [n,m] = [n,m]
uniqueNotes (note1:(note2:ns)) = convert note1 note2 ++ uniqueNotes ns

shift [interval] notes = drop (valueOf interval) notes
shift (interval:is) notes = shift is (drop (valueOf interval) notes)

scale :: Note -> [Jump] -> [Note]
scale root jumps = root:(scale' (dropWhile (/= root) notes) jumps)

scale' _ [] = []
scale' notes (jump:js) = newNote:(scale' (newNote:ns) js) where (newNote:ns) = shift jump notes

majorScaleJumps = map (\x -> [x]) [Whole, Whole, Half, Whole, Whole, Whole, Half]

majorTriad = [[Whole, Whole], [Whole, Half]]

cMajorScale = TestCase $ assertEqual "C Major Scale"
                (scale (Natural C) majorScaleJumps)
                [Natural C, Natural D, Natural E, Natural F, Natural G, Natural A, Natural B, Natural C]

cMajorTriad = TestCase $ assertEqual "C Major Scale"
              (scale (Natural C) majorTriad)
              [Natural C, Natural E, Natural G]

runTests :: IO Counts
runTests = runTestTT $ TestList [cMajorScale, cMajorTriad]