diff --git a/sdl2-mixer.cabal b/sdl2-mixer.cabal --- a/sdl2-mixer.cabal +++ b/sdl2-mixer.cabal @@ -1,5 +1,5 @@ name: sdl2-mixer -version: 0.1 +version: 1.1.0 synopsis: Bindings to SDL2_mixer. description: Haskell bindings to SDL2_mixer. license: BSD3 @@ -25,7 +25,6 @@ SDL.Raw.Mixer other-modules: - SDL.ExceptionHelper, SDL.Raw.Helper hs-source-dirs: @@ -51,8 +50,6 @@ monad-control >= 1.0, sdl2 >= 2.0.0, template-haskell, - text >= 1.2, - transformers >= 0.2 && < 0.6, vector >= 0.10 default-language: @@ -60,7 +57,7 @@ flag example description: Build the example executables - default: True + default: False executable sdl2-mixer-basic ghc-options: -Wall diff --git a/src/SDL/ExceptionHelper.hs b/src/SDL/ExceptionHelper.hs deleted file mode 100644 --- a/src/SDL/ExceptionHelper.hs +++ /dev/null @@ -1,41 +0,0 @@ -module SDL.ExceptionHelper where - -import Control.Exception (throwIO) -import Control.Monad (when) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.ByteString (packCString) -import Data.Text (Text) -import Data.Text.Encoding (decodeUtf8) -import Foreign.Ptr (Ptr, nullPtr) -import SDL (SDLException(SDLCallFailed)) -import SDL.Raw (getError) - -throwIfNeg_ :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m () -throwIfNeg_ = throwIf_ (< 0) - -throwIfNeg :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m a -throwIfNeg = throwIf (< 0) - -throwIf0 :: (MonadIO m, Num a, Eq a) => Text -> Text -> m a -> m a -throwIf0 = throwIf (== 0) - -throwIfNull :: MonadIO m => Text -> Text -> m (Ptr a) -> m (Ptr a) -throwIfNull = throwIf (== nullPtr) - -throwIf :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m a -throwIf f caller rawf act = do - result <- act - liftIO $ when (f result) $ do - throwFailed caller rawf - return result - -throwIf_ :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m () -throwIf_ f caller rawf act = do - _ <- throwIf f caller rawf act - return () - --- Allows us to just throw an SDL exception directly. -throwFailed :: MonadIO m => Text -> Text -> m a -throwFailed caller rawf = liftIO $ do - err <- decodeUtf8 <$> (packCString =<< getError) - throwIO $ SDLCallFailed caller rawf err diff --git a/src/SDL/Mixer.hs b/src/SDL/Mixer.hs --- a/src/SDL/Mixer.hs +++ b/src/SDL/Mixer.hs @@ -166,6 +166,7 @@ ) where +import Control.Exception (throwIO) import Control.Exception.Lifted (finally) import Control.Monad (void, forM, when) import Control.Monad.IO.Class (MonadIO, liftIO) @@ -187,7 +188,8 @@ import Foreign.Ptr (Ptr, castPtr, nullPtr) import Foreign.Storable (Storable(..)) import Prelude hiding (foldl, readFile) -import SDL.ExceptionHelper +import SDL (SDLException(SDLCallFailed)) +import SDL.Internal.Exception import SDL.Raw.Filesystem (rwFromConstMem) import System.IO.Unsafe (unsafePerformIO) @@ -202,7 +204,7 @@ -- format. Using 'initialize' allows you to decide /when/ to load support. -- -- You may call this function multiple times. -initialize :: (Foldable f, Functor m, MonadIO m) => f InitFlag -> m () +initialize :: (Foldable f, MonadIO m) => f InitFlag -> m () initialize flags = do let raw = foldl (\a b -> a .|. initToCInt b) 0 flags throwIf_ ((/= raw) . (.&. raw)) "SDL.Mixer.initialize" "Mix_Init" $ @@ -213,20 +215,16 @@ data InitFlag = InitFLAC | InitMOD - | InitMODPlug | InitMP3 | InitOGG - | InitFluidSynth deriving (Eq, Ord, Bounded, Read, Show) initToCInt :: InitFlag -> CInt initToCInt = \case InitFLAC -> SDL.Raw.Mixer.INIT_FLAC InitMOD -> SDL.Raw.Mixer.INIT_MOD - InitMODPlug -> SDL.Raw.Mixer.INIT_MODPLUG InitMP3 -> SDL.Raw.Mixer.INIT_MP3 InitOGG -> SDL.Raw.Mixer.INIT_OGG - InitFluidSynth -> SDL.Raw.Mixer.INIT_FLUIDSYNTH -- | Cleans up any loaded libraries, freeing memory. quit :: MonadIO m => m () @@ -976,9 +974,7 @@ | MID | OGG | MP3 - | MP3_MAD | FLAC - | MODPlug deriving (Eq, Show, Read, Ord, Bounded) wordToMusicType :: SDL.Raw.Mixer.MusicType -> Maybe MusicType @@ -990,9 +986,7 @@ SDL.Raw.Mixer.MUS_MID -> Just MID SDL.Raw.Mixer.MUS_OGG -> Just OGG SDL.Raw.Mixer.MUS_MP3 -> Just MP3 - SDL.Raw.Mixer.MUS_MP3_MAD -> Just MP3_MAD SDL.Raw.Mixer.MUS_FLAC -> Just FLAC - SDL.Raw.Mixer.MUS_MODPLUG -> Just MODPlug _ -> Nothing -- | Gets the 'MusicType' of a given 'Music'. @@ -1057,14 +1051,18 @@ result <- SDL.Raw.Mixer.registerEffect channel ef' fin' nullPtr if result == 0 then do - liftIO $ freeHaskellFunPtr ef' >> freeHaskellFunPtr fin' - throwFailed "SDL.Raw.Mixer.addEffect" "Mix_RegisterEffect" + liftIO $ do + freeHaskellFunPtr ef' >> freeHaskellFunPtr fin' + err <- getError + throwIO $ SDLCallFailed "SDL.Raw.Mixer.addEffect" "Mix_RegisterEffect" err else return . liftIO $ do -- The unregister action. removed <- SDL.Raw.Mixer.unregisterEffect channel ef' freeHaskellFunPtr ef' >> freeHaskellFunPtr fin' - when (removed == 0) $ - throwFailed "SDL.Raw.Mixer.removeEffect" "Mix_UnregisterEffect" + when (removed == 0) $ do + err <- getError + throwIO $ + SDLCallFailed "SDL.Raw.Mixer.removeEffect" "Mix_UnregisterEffect" err -- | Applies an in-built effect implementing panning. -- diff --git a/src/SDL/Raw/Mixer.hsc b/src/SDL/Raw/Mixer.hsc --- a/src/SDL/Raw/Mixer.hsc +++ b/src/SDL/Raw/Mixer.hsc @@ -28,10 +28,8 @@ , init , pattern INIT_FLAC , pattern INIT_MOD - , pattern INIT_MODPLUG , pattern INIT_MP3 , pattern INIT_OGG - , pattern INIT_FLUIDSYNTH , quit , Format , pattern DEFAULT_FORMAT @@ -131,9 +129,7 @@ , pattern MUS_MID , pattern MUS_OGG , pattern MUS_MP3 - , pattern MUS_MP3_MAD , pattern MUS_FLAC - , pattern MUS_MODPLUG , playingMusic , pausedMusic , fadingMusic @@ -193,10 +189,8 @@ pattern INIT_FLAC = (#const MIX_INIT_FLAC) pattern INIT_MOD = (#const MIX_INIT_MOD) -pattern INIT_MODPLUG = (#const MIX_INIT_MODPLUG) pattern INIT_MP3 = (#const MIX_INIT_MP3) pattern INIT_OGG = (#const MIX_INIT_OGG) -pattern INIT_FLUIDSYNTH = (#const MIX_INIT_FLUIDSYNTH) liftF "quit" "Mix_Quit" [t|IO ()|] @@ -401,9 +395,7 @@ pattern MUS_MID = (#const MUS_MID) pattern MUS_OGG = (#const MUS_OGG) pattern MUS_MP3 = (#const MUS_MP3) -pattern MUS_MP3_MAD = (#const MUS_MP3_MAD) pattern MUS_FLAC = (#const MUS_FLAC) -pattern MUS_MODPLUG = (#const MUS_MODPLUG) liftF "freeMusic" "Mix_FreeMusic" [t|Ptr Music -> IO ()|]