Device.hs

module Engine.Sound.Device
  ( OpenAL.Device
  , allocate
  , create
  , destroy
  ) where

import RIO

import Sound.OpenAL qualified as OpenAL
import UnliftIO.Resource qualified as Resource

allocate
  :: ( Resource.MonadResource m
     , MonadUnliftIO m
     , MonadReader env m
     , HasLogFunc env
     )
  => m (Resource.ReleaseKey, OpenAL.Device)
allocate = do
  soundDevice <- create
  soundDeviceDestroy <- toIO $ destroy soundDevice
  soundDeviceKey <- Resource.register soundDeviceDestroy
  pure (soundDeviceKey, soundDevice)

create
  :: ( MonadReader env m
     , HasLogFunc env
     , MonadUnliftIO m
     )
  => m OpenAL.Device
create = do
  OpenAL.openDevice Nothing >>= \case
    Nothing -> do
      logError "OpenAL: no devices"
      exitFailure
    Just device -> do
      OpenAL.createContext device [] >>= \case
        Nothing -> do
          logError "OpenAL.createContext failed"
          exitFailure
        Just ctx -> do
          OpenAL.currentContext OpenAL.$=! Just ctx
          pure device

destroy
  :: (MonadIO m, MonadReader env m, HasLogFunc env)
  => OpenAL.Device
  -> m ()
destroy device =
  OpenAL.closeDevice device >>= \case
    True ->
      pure ()
    False ->
      logWarn "OpenAL: closeDevice error"