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 :: m (ReleaseKey, Device)
allocate = do
  Device
soundDevice <- m Device
forall env (m :: * -> *).
(MonadReader env m, HasLogFunc env, MonadUnliftIO m) =>
m Device
create
  IO ()
soundDeviceDestroy <- m () -> m (IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (IO a)
toIO (m () -> m (IO ())) -> m () -> m (IO ())
forall a b. (a -> b) -> a -> b
$ Device -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env) =>
Device -> m ()
destroy Device
soundDevice
  ReleaseKey
soundDeviceKey <- IO () -> m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register IO ()
soundDeviceDestroy
  pure (ReleaseKey
soundDeviceKey, Device
soundDevice)

create
  :: ( MonadReader env m
     , HasLogFunc env
     , MonadUnliftIO m
     )
  => m OpenAL.Device
create :: m Device
create = do
  Maybe String -> m (Maybe Device)
forall (m :: * -> *). MonadIO m => Maybe String -> m (Maybe Device)
OpenAL.openDevice Maybe String
forall a. Maybe a
Nothing m (Maybe Device) -> (Maybe Device -> m Device) -> m Device
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Device
Nothing -> do
      Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
"OpenAL: no devices"
      m Device
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
    Just Device
device -> do
      Device -> [ContextAttribute] -> m (Maybe Context)
forall (m :: * -> *).
MonadIO m =>
Device -> [ContextAttribute] -> m (Maybe Context)
OpenAL.createContext Device
device [] m (Maybe Context) -> (Maybe Context -> m Device) -> m Device
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Context
Nothing -> do
          Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
"OpenAL.createContext failed"
          m Device
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
        Just Context
ctx -> do
          StateVar (Maybe Context)
OpenAL.currentContext StateVar (Maybe Context) -> Maybe Context -> m ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
OpenAL.$=! Context -> Maybe Context
forall a. a -> Maybe a
Just Context
ctx
          pure Device
device

destroy
  :: (MonadIO m, MonadReader env m, HasLogFunc env)
  => OpenAL.Device
  -> m ()
destroy :: Device -> m ()
destroy Device
device =
  Device -> m Bool
forall (m :: * -> *). MonadIO m => Device -> m Bool
OpenAL.closeDevice Device
device m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True ->
      () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Bool
False ->
      Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"OpenAL: closeDevice error"