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 Synth
s. 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?