I wrote a set of utility functions around the bindings-fluidsynth library:
module FSUtilities where
import Control.Monad
import System.Directory
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.C.Types
import Foreign.C.String
import Bindings.FluidSynth
newtype Settings = Settings (ForeignPtr C'fluid_settings_t)
newtype Synth = Synth (ForeignPtr C'fluid_synth_t)
type Channel = Int
type Key = Int
type Velocity = Int
initSynth :: IO Synth
initSynth = createSettings >>=
changeSettingStr "audio.driver" "alsa" >>=
changeSettingInt "synth.polyphony" 64 >>=
(\s -> createSynth s >>= createDriver s) >>=
loadSF "GS.sf2"
createSettings :: IO Settings
createSettings =
c'new_fluid_settings >>=
newForeignPtr p'delete_fluid_settings >>= (pure $!) . Settings
changeSettingStr :: String -> String -> Settings -> IO Settings
changeSettingStr k v (Settings s) =
withForeignPtr s $ \ptr ->
withCAString k $ \cstr ->
withCAString v $ \cstr' ->
c'fluid_settings_setstr ptr cstr cstr' >>
(pure $! Settings s)
changeSettingInt :: String -> Int -> Settings -> IO Settings
changeSettingInt k v (Settings s) =
withForeignPtr s $ \ptr ->
withCAString k $ \cstr ->
c'fluid_settings_setint ptr cstr (fromIntegral v) >>
(pure $! Settings s)
createSynth :: Settings -> IO Synth
createSynth (Settings s) =
withForeignPtr s c'new_fluid_synth >>=
newForeignPtr p'delete_fluid_synth >>= (pure $!) . Synth
createDriver :: Settings -> Synth -> IO Synth
createDriver (Settings set) (Synth syn) =
withForeignPtr set $ \ptr ->
withForeignPtr syn $ \ptr' ->
c'new_fluid_audio_driver ptr ptr' >>=
newForeignPtr p'delete_fluid_audio_driver >>
(pure $! Synth syn)
loadSF :: String -> Synth -> IO Synth
loadSF path (Synth syn) =
withForeignPtr syn $ \s ->
makeAbsolute path >>= \p ->
withCAString p $ \p' ->
c'fluid_synth_sfload s p' 1 >>=
\c -> if c == (-1) then error "loadSF: Could not load SoundFont"
else putStrLn "loadSF: SoundFont loaded" >>
(pure $! Synth syn)
noteOn :: Channel -> Key -> Velocity -> Synth -> IO ()
noteOn c k v (Synth ptr) =
withForeignPtr ptr $ \syn ->
c'fluid_synth_noteon syn c' k' v' >> pure ()
where c' = fromIntegral c
k' = fromIntegral k
v' = fromIntegral v
justPlay :: Channel -> Key -> IO ()
justPlay c k = initSynth >>= noteOn c k 127
justPlay' :: Channel -> Key -> IO Synth
justPlay' c k = initSynth >>= \s -> noteOn c k 127 s >> pure s
The justPlay and justPlay' functions serve to illustrate the issue. When I call justPlay from ghci, I get random segfaults (not consistently, around 30% of the time), while justPlay' never does that (but swiftly fills up my system's memory after a bunch of calls, due to dangling Synths. I think this is because I'm not cleaning up after myself when the Synth is no longer referenced, but I thought the call to newForeignPtr with a finalizer function at the creation of Synth was supposed to take care of that automatically.
I'm new to Haskell and I don't know C, so I'm trying to feel my way through this. What's the proper way to handle such a situation?
It is hard to say what exactly couses the crash, but there is at least one obviuosly wrong thing. Occurding to the documentation:
Other users of a synthesizer instance, such as audio and MIDI drivers, should be deleted prior to freeing the FluidSynth instance.
In your case the order of finalizers is not defined, so synthesizer could be deleted before driver. Probably other objects also has restrictions on their life circle.
To explicitly finalize foreign pointer use finalizeForeignPtr.