Skip to content

Commit 510a036

Browse files
author
Mike Solomon
committed
Refactors to use more concise syntax
1 parent d135c3b commit 510a036

75 files changed

Lines changed: 1262 additions & 1580 deletions

File tree

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

‎.tidyrc.json‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
{
2+
"importSort": "source",
3+
"importWrap": "source",
4+
"indent": 2,
5+
"operatorsFile": null,
6+
"ribbon": 1,
7+
"typeArrowPlacement": "first",
8+
"unicode": "source",
9+
"width": 80
10+
}

‎spago.dhall‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,10 +18,12 @@ to generate this file without the comments in this block.
1818
, "foreign-object"
1919
, "integers"
2020
, "maybe"
21+
, "newtype"
2122
, "ordered-collections"
2223
, "prelude"
2324
, "record"
2425
, "unsafe-coerce"
26+
, "web-events"
2527
, "web-html"
2628
, "web-promise"
2729
]

‎src/Web/GPU/GPU.purs‎

Lines changed: 10 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -1,53 +1,29 @@
11
module Web.GPU.GPU
22
( requestAdapter
33
, getPreferredCanvasFormat
4-
, GPURequestAdapter
54
) where
65

76
import Data.Maybe (Maybe(..))
87
import Effect (Effect)
9-
import Web.GPU.GPUPowerPreference (GPUPowerPreference)
8+
import Web.GPU.GPURequestAdapterOptions (GPURequestAdapterOptions)
109
import Web.GPU.GPUTextureFormat (GPUTextureFormat)
11-
import Web.GPU.Internal.ConvertibleOptions (class ConvertOption, class ConvertOptionsWithDefaults, convertOptionsWithDefaults)
1210
import Web.GPU.Internal.Types (GPU, GPUAdapter)
13-
import Web.GPU.Internal.Undefinable (Undefinable, undefined, defined)
1411
import Web.Promise (Promise)
1512

1613
-- requestAdapter
1714

18-
foreign import requestAdapterImpl :: (GPUAdapter -> Maybe GPUAdapter) -> Maybe GPUAdapter -> GPU -> { | GPURequestAdapterOptions } -> Effect (Promise (Maybe GPUAdapter))
19-
20-
type GPURequestAdapterOptionsOptional =
21-
( powerPreference :: Undefinable GPUPowerPreference
22-
, forceFallbackAdapter :: Undefinable Boolean
23-
)
24-
25-
type GPURequestAdapterOptions = (| GPURequestAdapterOptionsOptional)
26-
27-
defaultGPURequestAdapterOptions :: { | GPURequestAdapterOptionsOptional }
28-
defaultGPURequestAdapterOptions =
29-
{ powerPreference: undefined
30-
, forceFallbackAdapter: undefined
31-
}
32-
33-
data GPURequestAdapter = GPURequestAdapter
34-
35-
instance ConvertOption GPURequestAdapter "powerPreference" GPUPowerPreference (Undefinable GPUPowerPreference) where
36-
convertOption _ _ = defined
37-
38-
instance ConvertOption GPURequestAdapter "forceFallbackAdapter" Boolean (Undefinable Boolean) where
39-
convertOption _ _ = defined
15+
foreign import requestAdapterImpl
16+
:: (GPUAdapter -> Maybe GPUAdapter)
17+
-> Maybe GPUAdapter
18+
-> GPU
19+
-> GPURequestAdapterOptions
20+
-> Effect (Promise (Maybe GPUAdapter))
4021

4122
requestAdapter
42-
:: forall provided
43-
. ConvertOptionsWithDefaults GPURequestAdapter { | GPURequestAdapterOptionsOptional } { | provided } { | GPURequestAdapterOptions }
44-
=> GPU
45-
-> { | provided }
23+
:: GPU
24+
-> GPURequestAdapterOptions
4625
-> Effect (Promise (Maybe GPUAdapter))
47-
requestAdapter g provided = requestAdapterImpl Just Nothing g all
48-
where
49-
all :: { | GPURequestAdapterOptions }
50-
all = convertOptionsWithDefaults GPURequestAdapter defaultGPURequestAdapterOptions provided
26+
requestAdapter = requestAdapterImpl Just Nothing
5127

5228
-- getPreferredCanvasFormat
5329

‎src/Web/GPU/GPUAdapter.purs‎

Lines changed: 22 additions & 59 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,5 @@
11
module Web.GPU.GPUAdapter
22
( GPUAdapterInfo
3-
, GPURequestDevice
43
, features
54
, limits
65
, isFallbackAdapter
@@ -11,16 +10,19 @@ module Web.GPU.GPUAdapter
1110
import Data.Maybe (Maybe(..))
1211
import Data.Set as Set
1312
import Effect (Effect)
14-
import Web.GPU.Internal.Types (GPUAdapter, GPUDevice)
13+
import Web.GPU.GPUDeviceDescriptor (GPUDeviceDescriptor)
1514
import Web.GPU.GPUFeatureName (GPUFeatureName)
16-
import Web.GPU.GPUSupportedLimits (GPUSupportedLimits, UndefinableGPUSupportedLimits, defaultGPUSupportedLimits)
17-
import Web.GPU.Internal.ConvertibleOptions (class ConvertOption, class ConvertOptionsWithDefaults, convertOptionsWithDefaults)
18-
import Web.GPU.Internal.Undefinable (Undefinable, undefined, defined)
19-
import Web.Promise (Promise)
15+
import Web.GPU.GPUSupportedLimits (GPUSupportedLimits)
16+
import Web.GPU.Internal.Types (GPUAdapter, GPUDevice)
2017
import Web.GPU.UnmaskHint (UnmaskHint)
18+
import Web.Promise (Promise)
2119

2220
-- features
23-
foreign import featuresImpl :: (GPUFeatureName -> Set.Set GPUFeatureName -> Set.Set GPUFeatureName) -> Set.Set GPUFeatureName -> GPUAdapter -> Effect (Set.Set GPUFeatureName)
21+
foreign import featuresImpl
22+
:: (GPUFeatureName -> Set.Set GPUFeatureName -> Set.Set GPUFeatureName)
23+
-> Set.Set GPUFeatureName
24+
-> GPUAdapter
25+
-> Effect (Set.Set GPUFeatureName)
2426

2527
features :: GPUAdapter -> Effect (Set.Set GPUFeatureName)
2628
features = featuresImpl Set.insert Set.empty
@@ -37,63 +39,23 @@ isFallbackAdapter = isFallbackAdapterImpl
3739

3840
-- requestDevice
3941

40-
foreign import requestDeviceImpl :: (GPUDevice -> Maybe GPUDevice) -> Maybe GPUDevice -> GPUAdapter -> { | GPURequestDeviceOptions } -> Effect (Promise (Maybe GPUDevice))
41-
42-
type GPUQueueDescriptorOptional =
43-
( label :: Undefinable String
44-
)
45-
46-
type GPUQueueDescriptor = (| GPUQueueDescriptorOptional)
47-
48-
defaultGPUQueueDescriptor :: { | GPUQueueDescriptor }
49-
defaultGPUQueueDescriptor = { label: undefined }
50-
51-
type GPURequestDeviceOptionsOptional =
52-
( requiredFeatures :: Undefinable (Array GPUFeatureName)
53-
, requiredLimits :: Undefinable { | UndefinableGPUSupportedLimits }
54-
, defaultQueue :: Undefinable { | GPUQueueDescriptor }
55-
)
56-
57-
type GPURequestDeviceOptions = (| GPURequestDeviceOptionsOptional)
58-
59-
defaultGPURequestDeviceOptions :: { | GPURequestDeviceOptionsOptional }
60-
defaultGPURequestDeviceOptions =
61-
{ requiredFeatures: undefined
62-
, requiredLimits: undefined
63-
, defaultQueue: undefined
64-
}
65-
66-
data GPURequestDevice = GPURequestDevice
67-
68-
instance ConvertOption GPURequestDevice "requiredFeatures" (Array GPUFeatureName) (Undefinable (Array GPUFeatureName)) where
69-
convertOption _ _ = defined
70-
71-
instance ConvertOptionsWithDefaults GPURequestDevice { | UndefinableGPUSupportedLimits } { | provided } { | UndefinableGPUSupportedLimits } => ConvertOption GPURequestDevice "requiredLimits" { | provided } (Undefinable { | UndefinableGPUSupportedLimits }) where
72-
convertOption _ _ provided = defined all
73-
where
74-
all :: { | UndefinableGPUSupportedLimits }
75-
all = convertOptionsWithDefaults GPURequestDevice defaultGPUSupportedLimits provided
76-
77-
instance ConvertOptionsWithDefaults GPURequestDevice { | GPUQueueDescriptorOptional } { | provided } { | GPUQueueDescriptor } => ConvertOption GPURequestDevice "defaultQueue" { | provided } (Undefinable { | GPUQueueDescriptor }) where
78-
convertOption _ _ provided = defined all
79-
where
80-
all :: { | GPUQueueDescriptor }
81-
all = convertOptionsWithDefaults GPURequestDevice defaultGPUQueueDescriptor provided
42+
foreign import requestDeviceImpl
43+
:: (GPUDevice -> Maybe GPUDevice)
44+
-> Maybe GPUDevice
45+
-> GPUAdapter
46+
-> GPUDeviceDescriptor
47+
-> Effect (Promise (Maybe GPUDevice))
8248

8349
requestDevice
84-
:: forall provided
85-
. ConvertOptionsWithDefaults GPURequestDevice { | GPURequestDeviceOptionsOptional } { | provided } { | GPURequestDeviceOptions }
86-
=> GPUAdapter
87-
-> { | provided }
50+
:: GPUAdapter
51+
-> GPUDeviceDescriptor
8852
-> Effect (Promise (Maybe GPUDevice))
89-
requestDevice g provided = requestDeviceImpl Just Nothing g all
90-
where
91-
all :: { | GPURequestDeviceOptions }
92-
all = convertOptionsWithDefaults GPURequestDevice defaultGPURequestDeviceOptions provided
53+
requestDevice = requestDeviceImpl Just Nothing
9354

9455
-- requestAdapterInfo
9556

96-
foreign import requestAdapterInfoImpl :: GPUAdapter -> Array (UnmaskHint) -> Effect (Promise GPUAdapterInfo)
57+
foreign import requestAdapterInfoImpl
58+
:: GPUAdapter -> Array (UnmaskHint) -> Effect (Promise GPUAdapterInfo)
9759

9860
type GPUAdapterInfo =
9961
{ vendor :: String
@@ -102,5 +64,6 @@ type GPUAdapterInfo =
10264
, description :: String
10365
}
10466

105-
requestAdapterInfo :: GPUAdapter -> Array UnmaskHint -> Effect (Promise GPUAdapterInfo)
67+
requestAdapterInfo
68+
:: GPUAdapter -> Array UnmaskHint -> Effect (Promise GPUAdapterInfo)
10669
requestAdapterInfo = requestAdapterInfoImpl

‎src/Web/GPU/GPUBindGroupDescriptor.purs‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
module Web.GPU.GPUBindGroupDescriptor where
2+
3+
import Data.Newtype (class Newtype)
4+
import Web.GPU.Internal.RequiredAndOptional (RequiredAndOptional)
5+
import Web.GPU.Internal.Types (GPUBindGroupEntry, GPUBindGroupLayout)
6+
7+
newtype GPUBindGroupDescriptor = GPUBindGroupDescriptor
8+
( RequiredAndOptional
9+
(layout :: GPUBindGroupLayout, entries :: Array GPUBindGroupEntry)
10+
(label :: String)
11+
)
12+
13+
derive instance Newtype GPUBindGroupDescriptor _

‎src/Web/GPU/GPUBindGroupEntry.purs‎

Lines changed: 23 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -1,65 +1,32 @@
1-
module Web.GPU.GPUBindGroupEntry
2-
( BufferBinding
3-
, GPUBufferBinding
4-
, bindGroupEntryForBufferBinding
5-
, bindGroupEntryForExternalTexture
6-
, bindGroupEntryForSampler
7-
, bindGroupEntryForTextureView
8-
, gpuBufferBinding
9-
) where
1+
module Web.GPU.GPUBindGroupEntry where
102

3+
import Data.Newtype (class Newtype)
114
import Unsafe.Coerce (unsafeCoerce)
12-
import Web.GPU.Internal.ConvertibleOptions (class ConvertOption, class ConvertOptionsWithDefaults, convertOptionsWithDefaults)
13-
import Web.GPU.Internal.Types (GPUBindGroupEntry, GPUBuffer, GPUExternalTexture, GPUSampler, GPUTextureView)
14-
import Web.GPU.Internal.Undefinable (Undefinable, defined, undefined)
15-
import Web.GPU.Internal.Unsigned (GPUSize64)
5+
import Web.GPU.Internal.RequiredAndOptional (RequiredAndOptional)
6+
import Web.GPU.Internal.Types (GPUBindGroupEntry, GPUBuffer, GPUExternalTexture, GPUIndex32, GPUSampler, GPUTextureView, GPUSize64)
167

17-
newtype GPUBufferBinding = GPUBufferBinding
18-
{ buffer :: GPUBuffer
19-
, offset :: Undefinable GPUSize64
20-
, size :: Undefinable GPUSize64
21-
}
22-
23-
type GPUBufferBindingOptional =
24-
( offset :: Undefinable GPUSize64
25-
, size :: Undefinable GPUSize64
26-
)
27-
28-
type GPUBufferBindingAll =
29-
(buffer :: GPUBuffer | GPUBufferBindingOptional)
30-
31-
defaultGPUBufferBinding :: { | GPUBufferBindingOptional }
32-
defaultGPUBufferBinding =
33-
{ offset: undefined
34-
, size: undefined
35-
}
8+
class GPUBindGroupEntry e where
9+
gpuBindGroupEntry :: GPUIndex32 -> e -> GPUBindGroupEntry
3610

37-
data BufferBinding = BufferBinding
11+
instance GPUBindGroupEntry GPUSampler where
12+
gpuBindGroupEntry binding resource = unsafeCoerce
13+
{ binding, resource: unsafeCoerce resource }
3814

39-
instance ConvertOption BufferBinding "offset" GPUSize64 (Undefinable GPUSize64) where
40-
convertOption _ _ = defined
15+
instance GPUBindGroupEntry GPUTextureView where
16+
gpuBindGroupEntry binding resource = unsafeCoerce
17+
{ binding, resource: unsafeCoerce resource }
4118

42-
instance ConvertOption BufferBinding "size" GPUSize64 (Undefinable GPUSize64) where
43-
convertOption _ _ = defined
44-
45-
gpuBufferBinding
46-
:: forall provided
47-
. ConvertOptionsWithDefaults BufferBinding { | GPUBufferBindingOptional } { | provided } { | GPUBufferBindingAll }
48-
=> { | provided }
49-
-> GPUBufferBinding
50-
gpuBufferBinding provided = GPUBufferBinding all
51-
where
52-
all :: { | GPUBufferBindingAll }
53-
all = convertOptionsWithDefaults BufferBinding defaultGPUBufferBinding provided
54-
55-
bindGroupEntryForBufferBinding :: Int -> GPUBufferBinding -> GPUBindGroupEntry
56-
bindGroupEntryForBufferBinding binding resource = unsafeCoerce { binding, resource }
19+
newtype GPUBufferBinding = GPUBufferBinding
20+
( RequiredAndOptional (buffer :: GPUBuffer)
21+
(offset :: GPUSize64, size :: GPUSize64)
22+
)
5723

58-
bindGroupEntryForSampler :: Int -> GPUSampler -> GPUBindGroupEntry
59-
bindGroupEntryForSampler binding resource = unsafeCoerce { binding, resource }
24+
derive instance Newtype GPUBufferBinding _
6025

61-
bindGroupEntryForTextureView :: Int -> GPUTextureView -> GPUBindGroupEntry
62-
bindGroupEntryForTextureView binding resource = unsafeCoerce { binding, resource }
26+
instance GPUBindGroupEntry GPUBufferBinding where
27+
gpuBindGroupEntry binding resource = unsafeCoerce
28+
{ binding, resource: unsafeCoerce resource }
6329

64-
bindGroupEntryForExternalTexture :: Int -> GPUExternalTexture -> GPUBindGroupEntry
65-
bindGroupEntryForExternalTexture binding resource = unsafeCoerce { binding, resource }
30+
instance GPUBindGroupEntry GPUExternalTexture where
31+
gpuBindGroupEntry binding resource = unsafeCoerce
32+
{ binding, resource: unsafeCoerce resource }

‎src/Web/GPU/GPUBindGroupLayoutDescriptor.purs‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
module Web.GPU.GPUBindGroupLayoutDescriptor where
2+
3+
import Data.Newtype (class Newtype)
4+
import Web.GPU.Internal.RequiredAndOptional (RequiredAndOptional)
5+
import Web.GPU.Internal.Types (GPUBindGroupLayoutEntry)
6+
7+
newtype GPUBindGroupLayoutDescriptor = GPUBindGroupLayoutDescriptor
8+
( RequiredAndOptional (entries :: Array GPUBindGroupLayoutEntry)
9+
(label :: String)
10+
)
11+
12+
derive instance Newtype GPUBindGroupLayoutDescriptor _

‎src/Web/GPU/GPUBindGroupLayoutEntry.purs‎

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
module Web.GPU.GPUBindGroupLayoutEntry where
2+
3+
import Unsafe.Coerce (unsafeCoerce)
4+
import Web.GPU.GPUBufferBindingLayout (GPUBufferBindingLayout)
5+
import Web.GPU.GPUExternalTextureBindingLayout (GPUExternalTextureBindingLayout)
6+
import Web.GPU.GPUSamplerBindingLayout (GPUSamplerBindingLayout)
7+
import Web.GPU.GPUShaderStage (GPUShaderStageFlags)
8+
import Web.GPU.GPUStorageTextureBindingLayout (GPUStorageTextureBindingLayout)
9+
import Web.GPU.GPUTextureBindingLayout (GPUTextureBindingLayout)
10+
import Web.GPU.Internal.Types (GPUBindGroupLayoutEntry, GPUIndex32)
11+
12+
gpuBufferBindingLayout
13+
:: GPUIndex32
14+
-> GPUShaderStageFlags
15+
-> GPUBufferBindingLayout
16+
-> GPUBindGroupLayoutEntry
17+
gpuBufferBindingLayout binding visibility buffer = unsafeCoerce
18+
{ binding, visibility, buffer }
19+
20+
gpuSamplerBindingLayout
21+
:: GPUIndex32
22+
-> GPUShaderStageFlags
23+
-> GPUSamplerBindingLayout
24+
-> GPUBindGroupLayoutEntry
25+
gpuSamplerBindingLayout binding visibility sampler = unsafeCoerce
26+
{ binding, visibility, sampler }
27+
28+
gpuTextureBindingLayout
29+
:: GPUIndex32
30+
-> GPUShaderStageFlags
31+
-> GPUTextureBindingLayout
32+
-> GPUBindGroupLayoutEntry
33+
gpuTextureBindingLayout binding visibility texture = unsafeCoerce
34+
{ binding, visibility, texture }
35+
36+
gpuStorageTextureBindingLayout
37+
:: GPUIndex32
38+
-> GPUShaderStageFlags
39+
-> GPUStorageTextureBindingLayout
40+
-> GPUBindGroupLayoutEntry
41+
gpuStorageTextureBindingLayout binding visibility storageTexture = unsafeCoerce
42+
{ binding, visibility, storageTexture }
43+
44+
gpuExternalTextureBindingLayout
45+
:: GPUIndex32
46+
-> GPUShaderStageFlags
47+
-> GPUExternalTextureBindingLayout
48+
-> GPUBindGroupLayoutEntry
49+
gpuExternalTextureBindingLayout binding visibility externalTexture =
50+
unsafeCoerce { binding, visibility, externalTexture }

‎src/Web/GPU/GPUBlendComponent.purs‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
module Web.GPU.GPUBlendComponent where
2+
3+
import Web.GPU.GPUBlendFactor (GPUBlendFactor)
4+
import Web.GPU.GPUBlendOperation (GPUBlendOperation)
5+
import Web.GPU.Internal.RequiredAndOptional (RequiredAndOptional)
6+
7+
newtype GPUBlendComponent = GPUBlendComponent
8+
( RequiredAndOptional ()
9+
( operation :: GPUBlendOperation
10+
, srcFactor :: GPUBlendFactor
11+
, dstFactor :: GPUBlendFactor
12+
)
13+
)

0 commit comments

Comments
 (0)