Generating .wav Sound Data in Haskell

Question

I'm trying to programatically generate .wav files from a file with the format "Note Octave Note Octave" (e.g. A 4 F# 1) in Haskell using the Data.WAVE library, and I've reached a problem: I can't figure out how exactly to calculate what to store as the notes. As of now, I'm trying storing them as a sine wave calculated from the frequencies of the notes at the octaves, but all I'm getting out of my speakers is clicks. What am I doing wrong that this is not generating tones?

import Data.WAVE
import Graphics.UI.SDL.Mixer.Samples

import Control.Applicative
import Data.List.Split (splitOn)
import Data.Char
import Data.Int (Int32)
import Data.List (group)
import System.IO (hGetContents, Handle, openFile, IOMode(..))

a4 = 440.0

frameRate = 16000

noteToFreq :: (String, Int) -> Double
noteToFreq (note, octave) =
    if octave >= -1 && octave < 10
    then if n /= 15.0
         then (2 ** (n + (12.0 * ((fromIntegral octave ::Double) - 4.0)))) * a4
         else error $ "Bad note: " ++ note
    else error $ "Bad octave: " ++ show octave
    where n = case note of
                "B#" -> -9.0
                "C"  -> -9.0
                "C#" -> -8.0
                "Db" -> -8.0
                "D"  -> -7.0
                "D#" -> -6.0
                "Eb" -> -6.0
                "E"  -> -5.0
                "Fb" -> -5.0
                "E#" -> -4.0
                "F"  -> -4.0
                "F#" -> -3.0
                "Gb" -> -3.0
                "G"  -> -2.0
                "G#" -> -1.0
                "Ab" -> -1.0
                "A"  -> 0.0
                "A#" -> 1.0
                "Bb" -> 1.0
                "B"  -> 2.0
                "Cb" -> 2.0
                _    -> 15.0

notesToSamples :: [(String, Int)] -> [WAVESample]
notesToSamples ns =
    map doubleToSample [sin $ pi * i * (f/fr) | i <- [0,0.1..len], f <- freqs]
    where freqs = map noteToFreq ns
          fr = fromIntegral frameRate :: Double
          len = fromIntegral (length ns) :: Double

getFileName :: IO FilePath
getFileName = putStr "Enter the name of the file: " >> getLine

openMFile :: IO Handle
openMFile = getFileName >>= \path -> 
            openFile path ReadMode

getNotesAndOctaves :: IO String
getNotesAndOctaves = openMFile >>= hGetContents

noteValuePairs :: String -> [(String, Int)]
noteValuePairs = pair . splitOn " "
    where pair (x:y:ys) = (x, read y) : pair ys
          pair []       = []

getWavSamples :: IO [WAVESample]
getWavSamples = (notesToSamples . noteValuePairs) <$> getNotesAndOctaves 

constructWAVE :: IO WAVE
constructWAVE = do
  samples <- map (:[]) . concatMap (replicate 1000) <$> getWavSamples
  let channels      = 1
      bitsPerSample = 32
      frames        = Just (length samples)
      header        =
          WAVEHeader channels frameRate bitsPerSample frames
  return $ WAVE header samples

makeWavFile :: IO ()
makeWavFile = constructWAVE >>= \wav -> putWAVEFile "temp.wav" wav

Answer 1

Here is some code to generate a tone using that library, you should hopefully be able to use the code with your own problem. Firstly check though that it is producing the correct frequency for the given input - I never tested that. I didn't actually check through your code, as most has nothing to do with sound generation. With this kind of problem, I normally try to write the simplest code necessary to get the external library working before writing my own abstractions around it:

module Sound where
import Data.WAVE
import Data.Int (Int32)
import Data.List.Split (splitOn)

samplesPS = 16000
bitrate = 32

header = WAVEHeader 1 samplesPS bitrate Nothing

sound :: Double  -- | Frequency
      -> Int -- | Samples per second
      -> Double -- | Lenght of sound in seconds
      -> Int32 -- | Volume, (maxBound :: Int32) for highest, 0 for lowest
      -> [Int32]
sound freq samples len volume = take (round $ len * (fromIntegral samples)) $ 
                         map (round . (* fromIntegral volume)) $
                         map sin [0.0, (freq * 2 * pi / (fromIntegral samples))..]

samples :: [[Int32]]
samples = map (:[]) $ sound 600 samplesPS 3 (maxBound `div` 2)

samples2 :: [[Int32]] -- play two tones at once
samples2 = map (:[]) $ zipWith (+) (sound 600 samplesPS 3 (maxBound `div` 2)) (sound 1000 samplesPS 3 (maxBound `div` 2))

waveData = WAVE header samples


makeWavFile :: WAVE -> IO ()
makeWavFile wav = putWAVEFile "temp.wav" wav

main = makeWavFile waveData

Once you get that working you can go and write a better abstraction around it. You should be able to get a nice pure abstraction for this library, as the only function that uses IO is the one that writes it to a file.