hpastetwo

New Revision

> 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 ()

author title

language channel