{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : WGPU.Internal.Instance
-- Description : Instance.
--
-- Instance of the WGPU API Haskell bindings.
module WGPU.Internal.Instance
  ( -- * Instance
    Instance,
    wgpuHsInstance,
    withPlatformInstance,
    withInstance,

    -- * Logging
    LogLevel (..),
    setLogLevel,
    connectLog,
    disconnectLog,

    -- * Version
    Version (..),
    getVersion,
    versionToText,
  )
where

import Control.Monad.IO.Class (MonadIO)
import Data.Bits (shiftR, (.&.))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Word (Word32, Word8)
import qualified System.Info
import WGPU.Internal.Memory (ToRaw, raw)
import WGPU.Raw.Dynamic (InstanceHandle, instanceHandleInstance, withWGPU)
import WGPU.Raw.Generated.Enum.WGPULogLevel (WGPULogLevel)
import qualified WGPU.Raw.Generated.Enum.WGPULogLevel as WGPULogLevel
import WGPU.Raw.Generated.Fun (WGPUHsInstance)
import qualified WGPU.Raw.Generated.Fun as RawFun
import qualified WGPU.Raw.Log as RawLog

-------------------------------------------------------------------------------

-- | Instance of the WGPU API.
--
-- An instance is loaded from a dynamic library using the 'withInstance'
-- function.
newtype Instance = Instance {Instance -> InstanceHandle
instanceHandle :: InstanceHandle}

wgpuHsInstance :: Instance -> WGPUHsInstance
wgpuHsInstance :: Instance -> WGPUHsInstance
wgpuHsInstance = InstanceHandle -> WGPUHsInstance
instanceHandleInstance (InstanceHandle -> WGPUHsInstance)
-> (Instance -> InstanceHandle) -> Instance -> WGPUHsInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instance -> InstanceHandle
instanceHandle

instance Show Instance where show :: Instance -> String
show Instance
_ = String
"<Instance>"

instance ToRaw Instance WGPUHsInstance where
  raw :: Instance -> ContT r IO WGPUHsInstance
raw = WGPUHsInstance -> ContT r IO WGPUHsInstance
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUHsInstance -> ContT r IO WGPUHsInstance)
-> (Instance -> WGPUHsInstance)
-> Instance
-> ContT r IO WGPUHsInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instance -> WGPUHsInstance
wgpuHsInstance

-------------------------------------------------------------------------------

-- | Load the WGPU API from a dynamic library and supply an 'Instance' to a
-- program.
--
-- This is the same as 'withInstance', except that it uses a default,
-- per-platform name for the library, based on the value returned by
-- 'System.Info.os'.
withPlatformInstance ::
  MonadIO m =>
  -- | Bracketing function.
  -- This can (for example) be something like 'Control.Exception.Safe.bracket'.
  (m Instance -> (Instance -> m ()) -> r) ->
  -- | Usage or action component of the bracketing function.
  r
withPlatformInstance :: (m Instance -> (Instance -> m ()) -> r) -> r
withPlatformInstance = String -> (m Instance -> (Instance -> m ()) -> r) -> r
forall (m :: * -> *) r.
MonadIO m =>
String -> (m Instance -> (Instance -> m ()) -> r) -> r
withInstance String
platformDylibName

-- | Load the WGPU API from a dynamic library and supply an 'Instance' to a
-- program.
withInstance ::
  forall m r.
  MonadIO m =>
  -- | Name of the @wgpu-native@ dynamic library, or a complete path to it.
  FilePath ->
  -- | Bracketing function.
  -- This can (for example) be something like 'Control.Exception.Safe.bracket'.
  (m Instance -> (Instance -> m ()) -> r) ->
  -- | Usage or action component of the bracketing function.
  r
withInstance :: String -> (m Instance -> (Instance -> m ()) -> r) -> r
withInstance String
dylibPath m Instance -> (Instance -> m ()) -> r
bkt = String -> (m InstanceHandle -> (InstanceHandle -> m ()) -> r) -> r
forall (m :: * -> *) r.
MonadIO m =>
String -> (m InstanceHandle -> (InstanceHandle -> m ()) -> r) -> r
withWGPU String
dylibPath m InstanceHandle -> (InstanceHandle -> m ()) -> r
bkt'
  where
    bkt' :: m InstanceHandle -> (InstanceHandle -> m ()) -> r
    bkt' :: m InstanceHandle -> (InstanceHandle -> m ()) -> r
bkt' m InstanceHandle
create InstanceHandle -> m ()
release =
      m Instance -> (Instance -> m ()) -> r
bkt
        (InstanceHandle -> Instance
Instance (InstanceHandle -> Instance) -> m InstanceHandle -> m Instance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m InstanceHandle
create)
        (InstanceHandle -> m ()
release (InstanceHandle -> m ())
-> (Instance -> InstanceHandle) -> Instance -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instance -> InstanceHandle
instanceHandle)

-- | Return the dynamic library name for a given platform.
--
-- This is the dynamic library name that should be passed to the 'withInstance'
-- function to load the dynamic library.
platformDylibName :: FilePath
platformDylibName :: String
platformDylibName =
  case String
System.Info.os of
    String
"darwin" -> String
"libwgpu_native.dylib"
    String
"mingw32" -> String
"wgpu_native.dll"
    String
"linux" -> String
"libwgpu_native.so"
    String
other ->
      ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"platformDylibName: unknown / unhandled platform: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
other

-------------------------------------------------------------------------------

-- | Logging level.
data LogLevel
  = Trace
  | Debug
  | Info
  | Warn
  | Error
  deriving (LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show)

-- | Set the current logging level for the instance.
setLogLevel :: MonadIO m => Instance -> LogLevel -> m ()
setLogLevel :: Instance -> LogLevel -> m ()
setLogLevel Instance
inst LogLevel
lvl =
  WGPUHsInstance -> WGPULogLevel -> m ()
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance -> WGPULogLevel -> m ()
RawFun.wgpuSetLogLevel (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst) (LogLevel -> WGPULogLevel
logLevelToWLogLevel LogLevel
lvl)

-- | Convert a 'LogLevel' value into the type required by the raw API.
logLevelToWLogLevel :: LogLevel -> WGPULogLevel
logLevelToWLogLevel :: LogLevel -> WGPULogLevel
logLevelToWLogLevel LogLevel
lvl =
  case LogLevel
lvl of
    LogLevel
Trace -> WGPULogLevel
forall a. (Eq a, Num a) => a
WGPULogLevel.Trace
    LogLevel
Debug -> WGPULogLevel
forall a. (Eq a, Num a) => a
WGPULogLevel.Debug
    LogLevel
Info -> WGPULogLevel
forall a. (Eq a, Num a) => a
WGPULogLevel.Info
    LogLevel
Warn -> WGPULogLevel
forall a. (Eq a, Num a) => a
WGPULogLevel.Warn
    LogLevel
Error -> WGPULogLevel
forall a. (Eq a, Num a) => a
WGPULogLevel.Error

-- | Connect a stdout logger to the instance.
connectLog :: MonadIO m => Instance -> m ()
connectLog :: Instance -> m ()
connectLog Instance
inst = WGPUHsInstance -> m ()
forall (m :: * -> *). MonadIO m => WGPUHsInstance -> m ()
RawLog.connectLog (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)

-- | Disconnect a stdout logger from the instance.
disconnectLog :: MonadIO m => Instance -> m ()
disconnectLog :: Instance -> m ()
disconnectLog Instance
inst = WGPUHsInstance -> m ()
forall (m :: * -> *). MonadIO m => WGPUHsInstance -> m ()
RawLog.disconnectLog (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)

-------------------------------------------------------------------------------

-- | Version of WGPU native.
data Version = Version
  { Version -> Word8
major :: !Word8,
    Version -> Word8
minor :: !Word8,
    Version -> Word8
patch :: !Word8,
    Version -> Word8
subPatch :: !Word8
  }
  deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show)

-- | Return the exact version of the WGPU native instance.
getVersion :: MonadIO m => Instance -> m Version
getVersion :: Instance -> m Version
getVersion Instance
inst = Word32 -> Version
w32ToVersion (Word32 -> Version) -> m Word32 -> m Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WGPUHsInstance -> m Word32
forall (m :: * -> *). MonadIO m => WGPUHsInstance -> m Word32
RawFun.wgpuGetVersion (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
  where
    w32ToVersion :: Word32 -> Version
    w32ToVersion :: Word32 -> Version
w32ToVersion Word32
w =
      let major :: Word8
major = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF
          minor :: Word8
minor = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF
          patch :: Word8
patch = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF
          subPatch :: Word8
subPatch = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF
       in Version :: Word8 -> Word8 -> Word8 -> Word8 -> Version
Version {Word8
subPatch :: Word8
patch :: Word8
minor :: Word8
major :: Word8
subPatch :: Word8
patch :: Word8
minor :: Word8
major :: Word8
..}

-- | Convert a 'Version' value to a text string.
--
-- >>> versionToText (Version 0 9 2 2)
-- "v0.9.2.2"
versionToText :: Version -> Text
versionToText :: Version -> Text
versionToText Version
ver =
  Text
"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word8 -> Text
forall a. Show a => a -> Text
showt (Version -> Word8
major Version
ver)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word8 -> Text
forall a. Show a => a -> Text
showt (Version -> Word8
minor Version
ver)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word8 -> Text
forall a. Show a => a -> Text
showt (Version -> Word8
patch Version
ver)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word8 -> Text
forall a. Show a => a -> Text
showt (Version -> Word8
subPatch Version
ver)

-- | Show a value as a 'Text' string.
showt :: Show a => a -> Text
showt :: a -> Text
showt = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show