1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133 | > module Scale where
> import Data.List
I'm going to use Shellac for interactivity...
> import System.Console.Shell
> import System.Console.Shell.Backend.Haskeline
> import System.Console.Shell.ShellMonad
... HughesPJ for pretty printing (in a small way, but it's just so pretty)...
> import Text.PrettyPrint.HughesPJ
... and Text.Regex for splitting a string on spaces.
> import Text.Regex
So the idea is to compute the possible scales a given set of notes
might be part of.
Scales can be represented simply as lists of intervals, naturally
denoting the tonic as the value 0.
> type Interval = Int
> data Scale = Scale {
> scaleName :: String,
> scaleIntervals :: [Interval]
> } deriving Show
We know a few different scales, namely the ones whose Wikipedia
articles made a reasonable amount of sense to us... :-) This may be
stupid and/or wrong, and there are certainly nicer ways to represent
these scales, but it'll do for now.
> knownScales :: [Scale]
> knownScales = [Scale "Major" [0, 2, 4, 5, 7, 9, 11]
> ,Scale "Minor" [0, 2, 3, 5, 7, 8, 10]
> ,Scale "Harmonic Minor" [0, 2, 3, 5, 7, 8, 11]
> ,Scale "Major Pentatonic" [0, 2, 4, 7, 9]
> ,Scale "Relative Minor Pentatonic" [0, 3, 5, 7, 10]
> ,Scale "Yo" [0, 2, 5, 7, 9]
> ]
Notes (A, B, C, etc.) can also be represented as integers.
> type Note = Int
Then we can use modular arithmetic (Z12) without any hassles.
> noteMod :: Note -> Note
> noteMod n = n `mod` 12
Given a base note and a scale, we can compute the notes in that scale.
> scaleNotes :: Note -> Scale -> [Note]
> scaleNotes base (Scale _ scale) =
> nub . sort . map noteMod $ zipWith (+) (repeat base) scale
We will also want to refer to notes by their names.
> type NoteName = String
And so we need to know the order those names come in. We'll
arbitrarily set C to 0.
> chromatic :: [NoteName]
> chromatic = ["C", "C#", "D", "D#", "E", "F", "F#", "G", "G#", "A",
> "A#", "B"]
We need to be able to convert between note names and numbers easily.
We just die if anything goes wrong (i.e. unknown note name).
> namedNote :: NoteName -> Note
> namedNote name = case elemIndex name chromatic of
> Just a -> a
> Nothing -> error $ "unknown note " ++ name
> noteName :: Note -> NoteName
> noteName note = chromatic !! noteMod note
Given a set of base notes and a set of scales, we can compute all
possible combinations, for each one returning its name (e.g. "C
Major") and the notes found in it.
> mkScales :: [Note] -> [Scale] -> [(String, [Note])]
> mkScales notes scales =
> do note <- notes
> scale <- scales
> return (noteName note ++ " " ++ scaleName scale,
> scaleNotes note scale)
Then we can compute all the scales we know about.
> allScales :: [(String, [Note])]
> allScales = mkScales [0..11] knownScales
For I/O we want to be able to parse strings of space-separated note
names into lists of note numbers.
> parseNotes :: String -> [Note]
> parseNotes = map namedNote . splitRegex (mkRegex " +")
... and we want to be able to pretty print the same.
> ppNotes :: [Note] -> String
> ppNotes = show . hsep . map (text . noteName) . nub . sort . map noteMod
Then, to compute the scales a given set of notes belong to, we can
just stupidly brute force iterate over every note in the octave, and
every scale we know, and just decide if the set of notes we've got
fits or not.
> checkFit :: [Note] -> [(String, [Note])]
> checkFit notes = filter ((notes `isSubList`) . snd) allScales
> where isSubList :: (Eq a) => [a] -> [a] -> Bool
> isSubList x y = null $ x \\ y
OK, let's do some interactivity, courtesy of Shellac.
We interpret whatever the user enteres as a space-separated list of
note names, and in response we print the names (and notes) of every
scale those notes are in.
> react :: String -> Sh () ()
> react = mapM_ (uncurry printScale) . checkFit . parseNotes
> where printScale :: String -> [Note] -> Sh () ()
> printScale n ns = shellPutStrLn (n ++ ": " ++ ppNotes ns)
Our main function just runs that function in an interactive shell.
> main :: IO ()
> main = runShell (mkShellDescription [] react) haskelineBackend ()
|