module Resource.Gltf.Load
( loadMeshPrimitives
, loadGlb
, loadGlbChunks
, loadGltf
, loadUri
) where
import RIO
import Codec.GLB qualified as GLB
import Codec.GlTF qualified as GlTF
import Codec.GlTF.Accessor qualified as Accessor
import Codec.GlTF.Buffer qualified as Buffer
import Codec.GlTF.BufferView qualified as BufferView
import Codec.GlTF.Material qualified as Material
import Codec.GlTF.Mesh qualified as Mesh
import Codec.GlTF.Root qualified as Root
import Codec.GlTF.URI qualified as URI
import Data.ByteString.Unsafe qualified as ByteString
import Data.Vector qualified as Vector
import Foreign qualified
import Geomancy (Vec2, Vec4, vec3, withVec4)
import Geomancy.Vec3 qualified as Vec3
import RIO.ByteString qualified as ByteString
import RIO.FilePath (takeDirectory, takeExtensions, (</>))
import RIO.HashMap qualified as HashMap
import RIO.List qualified as List
import Resource.Compressed.Zstd qualified as Zstd
import Resource.Gltf.Model (MeshPrimitive, Stuff(..), VertexAttrs(..))
loadGlb :: FilePath -> IO (Either String (ByteString, Root.GlTF))
loadGlb :: String -> IO (Either String (ByteString, GlTF))
loadGlb String
sceneFile =
String -> IO (Either String (Vector Chunk))
loadGlbChunks String
sceneFile IO (Either String (Vector Chunk))
-> (Either String (Vector Chunk)
-> IO (Either String (ByteString, GlTF)))
-> IO (Either String (ByteString, GlTF))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right Vector Chunk
chunks ->
case Vector Chunk -> [Chunk]
forall a. Vector a -> [a]
Vector.toList Vector Chunk
chunks of
[] ->
Either String (ByteString, GlTF)
-> IO (Either String (ByteString, GlTF))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (ByteString, GlTF)
-> IO (Either String (ByteString, GlTF)))
-> (String -> Either String (ByteString, GlTF))
-> String
-> IO (Either String (ByteString, GlTF))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (ByteString, GlTF)
forall a b. a -> Either a b
Left (String -> IO (Either String (ByteString, GlTF)))
-> String -> IO (Either String (ByteString, GlTF))
forall a b. (a -> b) -> a -> b
$ String
"No chunks in GLB file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
sceneFile
[Chunk
_root] ->
Either String (ByteString, GlTF)
-> IO (Either String (ByteString, GlTF))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (ByteString, GlTF)
-> IO (Either String (ByteString, GlTF)))
-> (String -> Either String (ByteString, GlTF))
-> String
-> IO (Either String (ByteString, GlTF))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (ByteString, GlTF)
forall a b. a -> Either a b
Left (String -> IO (Either String (ByteString, GlTF)))
-> String -> IO (Either String (ByteString, GlTF))
forall a b. (a -> b) -> a -> b
$ String
"No data chunk in GLB file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
sceneFile
Chunk
gltf : Chunk
buffer : [Chunk]
_rest ->
Either String (ByteString, GlTF)
-> IO (Either String (ByteString, GlTF))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (ByteString, GlTF)
-> IO (Either String (ByteString, GlTF)))
-> Either String (ByteString, GlTF)
-> IO (Either String (ByteString, GlTF))
forall a b. (a -> b) -> a -> b
$
(GlTF -> (ByteString, GlTF))
-> Either String GlTF -> Either String (ByteString, GlTF)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Chunk -> ByteString
GLB.chunkData Chunk
buffer,) (Either String GlTF -> Either String (ByteString, GlTF))
-> Either String GlTF -> Either String (ByteString, GlTF)
forall a b. (a -> b) -> a -> b
$
Chunk -> Either String GlTF
GlTF.fromChunk Chunk
gltf
Left String
err ->
Either String (ByteString, GlTF)
-> IO (Either String (ByteString, GlTF))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (ByteString, GlTF)
-> IO (Either String (ByteString, GlTF)))
-> Either String (ByteString, GlTF)
-> IO (Either String (ByteString, GlTF))
forall a b. (a -> b) -> a -> b
$ String -> Either String (ByteString, GlTF)
forall a b. a -> Either a b
Left String
err
loadGlbChunks :: FilePath -> IO (Either String (Vector GLB.Chunk))
loadGlbChunks :: String -> IO (Either String (Vector Chunk))
loadGlbChunks String
sceneFile =
(ByteString -> IO (Either (ByteOffset, String) GLB))
-> (String -> IO (Either (ByteOffset, String) GLB))
-> String
-> IO (Either (ByteOffset, String) GLB)
forall (m :: * -> *) b.
MonadIO m =>
(ByteString -> m b) -> (String -> m b) -> String -> m b
Zstd.fromFileWith (Either (ByteOffset, String) GLB
-> IO (Either (ByteOffset, String) GLB)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ByteOffset, String) GLB
-> IO (Either (ByteOffset, String) GLB))
-> (ByteString -> Either (ByteOffset, String) GLB)
-> ByteString
-> IO (Either (ByteOffset, String) GLB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ByteOffset, String) GLB
GLB.fromByteString) String -> IO (Either (ByteOffset, String) GLB)
GLB.fromFile String
sceneFile IO (Either (ByteOffset, String) GLB)
-> (Either (ByteOffset, String) GLB
-> IO (Either String (Vector Chunk)))
-> IO (Either String (Vector Chunk))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right GLB
glb ->
Either String (Vector Chunk) -> IO (Either String (Vector Chunk))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (Vector Chunk) -> IO (Either String (Vector Chunk)))
-> Either String (Vector Chunk)
-> IO (Either String (Vector Chunk))
forall a b. (a -> b) -> a -> b
$ Vector Chunk -> Either String (Vector Chunk)
forall a b. b -> Either a b
Right (GLB -> Vector Chunk
GLB.chunks GLB
glb)
Left (ByteOffset
_offset, String
err) ->
Either String (Vector Chunk) -> IO (Either String (Vector Chunk))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (Vector Chunk) -> IO (Either String (Vector Chunk)))
-> Either String (Vector Chunk)
-> IO (Either String (Vector Chunk))
forall a b. (a -> b) -> a -> b
$ String -> Either String (Vector Chunk)
forall a b. a -> Either a b
Left String
err
loadGltf :: FilePath -> IO (Either String Root.GlTF)
loadGltf :: String -> IO (Either String GlTF)
loadGltf =
(ByteString -> IO (Either String GlTF))
-> (String -> IO (Either String GlTF))
-> String
-> IO (Either String GlTF)
forall (m :: * -> *) b.
MonadIO m =>
(ByteString -> m b) -> (String -> m b) -> String -> m b
Zstd.fromFileWith (Either String GlTF -> IO (Either String GlTF)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String GlTF -> IO (Either String GlTF))
-> (ByteString -> Either String GlTF)
-> ByteString
-> IO (Either String GlTF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String GlTF
GlTF.fromByteString) String -> IO (Either String GlTF)
GlTF.fromFile
loadUri :: FilePath -> FilePath -> IO (Either a ByteString)
loadUri :: forall a. String -> String -> IO (Either a ByteString)
loadUri String
sceneFile String
uri =
(ByteString -> Either a ByteString)
-> IO ByteString -> IO (Either a ByteString)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Either a ByteString
forall a b. b -> Either a b
Right (IO ByteString -> IO (Either a ByteString))
-> (String -> IO ByteString) -> String -> IO (Either a ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> IO ByteString)
-> (String -> IO ByteString) -> String -> IO ByteString
forall (m :: * -> *) b.
MonadIO m =>
(ByteString -> m b) -> (String -> m b) -> String -> m b
Zstd.fromFileWith ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
ByteString.readFile (String -> IO (Either a ByteString))
-> String -> IO (Either a ByteString)
forall a b. (a -> b) -> a -> b
$
String -> String
takeDirectory String
sceneFile String -> String -> String
</> String
uri
loadMeshPrimitives
:: ( MonadReader env m
, HasLogFunc env
, MonadThrow m
, MonadUnliftIO m
)
=> Bool
-> Bool
-> FilePath
-> m
( Root.GlTF
, Vector (Vector MeshPrimitive)
)
loadMeshPrimitives :: forall env (m :: * -> *).
(MonadReader env m, HasLogFunc env, MonadThrow m,
MonadUnliftIO m) =>
Bool -> Bool -> String -> m (GlTF, Vector (Vector MeshPrimitive))
loadMeshPrimitives Bool
reverseIndices Bool
addBacksides String
fp = do
Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> m ()) -> Utf8Builder -> m ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Loading scene from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
fp
(Maybe ByteString
glbData, GlTF
root) <- IO (Maybe ByteString, GlTF) -> m (Maybe ByteString, GlTF)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString, GlTF) -> m (Maybe ByteString, GlTF))
-> IO (Maybe ByteString, GlTF) -> m (Maybe ByteString, GlTF)
forall a b. (a -> b) -> a -> b
$
if String -> String
takeExtensions String
fp String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".glb", String
".glb.zst"] then
String -> IO (Either String (ByteString, GlTF))
loadGlb String
fp IO (Either String (ByteString, GlTF))
-> (Either String (ByteString, GlTF)
-> IO (Maybe ByteString, GlTF))
-> IO (Maybe ByteString, GlTF)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left String
err ->
String -> IO (Maybe ByteString, GlTF)
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> IO (Maybe ByteString, GlTF))
-> String -> IO (Maybe ByteString, GlTF)
forall a b. (a -> b) -> a -> b
$ String
"GLB load error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
Right (ByteString
buffer, GlTF
root) ->
(Maybe ByteString, GlTF) -> IO (Maybe ByteString, GlTF)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
buffer, GlTF
root)
else
String -> IO (Either String GlTF)
loadGltf String
fp IO (Either String GlTF)
-> (Either String GlTF -> IO (Maybe ByteString, GlTF))
-> IO (Maybe ByteString, GlTF)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left String
err ->
String -> IO (Maybe ByteString, GlTF)
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> IO (Maybe ByteString, GlTF))
-> String -> IO (Maybe ByteString, GlTF)
forall a b. (a -> b) -> a -> b
$ String
"glTF load error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
Right GlTF
root ->
(Maybe ByteString, GlTF) -> IO (Maybe ByteString, GlTF)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString
forall a. Maybe a
Nothing, GlTF
root)
Vector ByteString
buffers <- case GlTF -> Maybe (Vector Buffer)
Root.buffers GlTF
root of
Maybe (Vector Buffer)
Nothing ->
Vector ByteString -> m (Vector ByteString)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector ByteString
forall a. Monoid a => a
mempty
Just Vector Buffer
buffers ->
Vector Buffer -> (Buffer -> m ByteString) -> m (Vector ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Vector Buffer
buffers \case
Buffer.Buffer{$sel:uri:Buffer :: Buffer -> Maybe URI
uri=Maybe URI
Nothing} ->
case Maybe ByteString
glbData of
Maybe ByteString
Nothing ->
String -> m ByteString
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m ByteString) -> String -> m ByteString
forall a b. (a -> b) -> a -> b
$ String
"Empty buffer URI in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
fp
Just ByteString
bs ->
ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
Buffer.Buffer{$sel:uri:Buffer :: Buffer -> Maybe URI
uri=Just URI
path} ->
IO (Either String ByteString) -> m (Either String ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HasCallStack =>
(String -> IO (Either String ByteString))
-> URI -> IO (Either String ByteString)
(String -> IO (Either String ByteString))
-> URI -> IO (Either String ByteString)
URI.loadURI (String -> String -> IO (Either String ByteString)
forall a. String -> String -> IO (Either a ByteString)
loadUri String
fp) URI
path) m (Either String ByteString)
-> (Either String ByteString -> m ByteString) -> m ByteString
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left String
err ->
String -> m ByteString
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m ByteString) -> String -> m ByteString
forall a b. (a -> b) -> a -> b
$ String
"Buffer load failed for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> URI -> String
forall a. Show a => a -> String
show URI
path String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
Right ByteString
bs ->
ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
let
getBuffer :: BufferIx -> m ByteString
getBuffer BufferIx
bix =
case Vector ByteString
buffers Vector ByteString -> Int -> Maybe ByteString
forall a. Vector a -> Int -> Maybe a
Vector.!? BufferIx -> Int
Buffer.unBufferIx BufferIx
bix of
Maybe ByteString
Nothing ->
String -> m ByteString
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m ByteString) -> String -> m ByteString
forall a b. (a -> b) -> a -> b
$ BufferIx -> String
forall a. Show a => a -> String
show BufferIx
bix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not present in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
fp
Just ByteString
buffer ->
ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
buffer
AccessorIx -> m Accessor
getAccessor <- case GlTF -> Maybe (Vector Accessor)
Root.accessors GlTF
root of
Maybe (Vector Accessor)
Nothing ->
String -> m (AccessorIx -> m Accessor)
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m (AccessorIx -> m Accessor))
-> String -> m (AccessorIx -> m Accessor)
forall a b. (a -> b) -> a -> b
$ String
"No accessors in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fp
Just Vector Accessor
accessors ->
(AccessorIx -> m Accessor) -> m (AccessorIx -> m Accessor)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure \AccessorIx
aix ->
case Vector Accessor
accessors Vector Accessor -> Int -> Maybe Accessor
forall a. Vector a -> Int -> Maybe a
Vector.!? AccessorIx -> Int
Accessor.unAccessorIx AccessorIx
aix of
Maybe Accessor
Nothing ->
String -> m Accessor
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m Accessor) -> String -> m Accessor
forall a b. (a -> b) -> a -> b
$ AccessorIx -> String
forall a. Show a => a -> String
show AccessorIx
aix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not present in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
fp
Just Accessor
accessor ->
Accessor -> m Accessor
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Accessor
accessor
BufferViewIx -> m BufferView
getBufferView <- case GlTF -> Maybe (Vector BufferView)
Root.bufferViews GlTF
root of
Maybe (Vector BufferView)
Nothing ->
String -> m (BufferViewIx -> m BufferView)
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m (BufferViewIx -> m BufferView))
-> String -> m (BufferViewIx -> m BufferView)
forall a b. (a -> b) -> a -> b
$ String
"No buffer views in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fp
Just Vector BufferView
bufferViews ->
(BufferViewIx -> m BufferView) -> m (BufferViewIx -> m BufferView)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure \BufferViewIx
bvix ->
case Vector BufferView
bufferViews Vector BufferView -> Int -> Maybe BufferView
forall a. Vector a -> Int -> Maybe a
Vector.!? BufferViewIx -> Int
BufferView.unBufferViewIx BufferViewIx
bvix of
Maybe BufferView
Nothing ->
String -> m BufferView
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m BufferView) -> String -> m BufferView
forall a b. (a -> b) -> a -> b
$ BufferViewIx -> String
forall a. Show a => a -> String
show BufferViewIx
bvix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not present in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
fp
Just BufferView
bufferView ->
BufferView -> m BufferView
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BufferView
bufferView
let materials :: Vector Material
materials = Vector Material -> Maybe (Vector Material) -> Vector Material
forall a. a -> Maybe a -> a
fromMaybe Vector Material
forall a. Monoid a => a
mempty (Maybe (Vector Material) -> Vector Material)
-> Maybe (Vector Material) -> Vector Material
forall a b. (a -> b) -> a -> b
$ GlTF -> Maybe (Vector Material)
Root.materials GlTF
root
Vector (Vector MeshPrimitive)
meshPrimitives <- case GlTF -> Maybe (Vector Mesh)
Root.meshes GlTF
root of
Maybe (Vector Mesh)
Nothing ->
String -> m (Vector (Vector MeshPrimitive))
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m (Vector (Vector MeshPrimitive)))
-> String -> m (Vector (Vector MeshPrimitive))
forall a b. (a -> b) -> a -> b
$ String
"No meshes in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fp
Just Vector Mesh
meshes ->
Vector Mesh
-> (Int -> Mesh -> m (Vector MeshPrimitive))
-> m (Vector (Vector MeshPrimitive))
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (Int -> a -> m b) -> m (Vector b)
Vector.iforM Vector Mesh
meshes \Int
_meshIx Mesh
mesh -> do
Vector MeshPrimitive
-> (Int -> MeshPrimitive -> m MeshPrimitive)
-> m (Vector MeshPrimitive)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (Int -> a -> m b) -> m (Vector b)
Vector.iforM (Mesh -> Vector MeshPrimitive
Mesh.primitives Mesh
mesh) \Int
_primIx MeshPrimitive
prim -> do
case MeshPrimitive -> MeshPrimitiveMode
Mesh.mode MeshPrimitive
prim of
MeshPrimitiveMode
Mesh.TRIANGLES ->
() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
MeshPrimitiveMode
mode ->
String -> m ()
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Can't load anything but TRIANGLES, got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> MeshPrimitiveMode -> String
forall a. Show a => a -> String
show MeshPrimitiveMode
mode
[Word32]
indicesCCW <- case MeshPrimitive -> Maybe AccessorIx
Mesh.indices MeshPrimitive
prim of
Maybe AccessorIx
Nothing ->
String -> m [Word32]
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
"No indices for mesh primitive"
Just AccessorIx
aix -> do
Accessor.Accessor{ComponentType
componentType :: ComponentType
$sel:componentType:Accessor :: Accessor -> ComponentType
componentType} <- AccessorIx -> m Accessor
getAccessor AccessorIx
aix
case ComponentType
componentType of
ComponentType
Accessor.UNSIGNED_INT ->
forall a (m :: * -> *).
(MonadThrow m, MonadIO m, Storable a) =>
(AccessorIx -> m Accessor)
-> (BufferViewIx -> m BufferView)
-> (BufferIx -> m ByteString)
-> AttributeType
-> ComponentType
-> AccessorIx
-> m [a]
accessBuffer @Word32 AccessorIx -> m Accessor
getAccessor BufferViewIx -> m BufferView
getBufferView BufferIx -> m ByteString
getBuffer AttributeType
Accessor.SCALAR ComponentType
Accessor.UNSIGNED_INT AccessorIx
aix
ComponentType
Accessor.UNSIGNED_SHORT ->
([Word16] -> [Word32]) -> m [Word16] -> m [Word32]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word16 -> Word32) -> [Word16] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (m [Word16] -> m [Word32]) -> m [Word16] -> m [Word32]
forall a b. (a -> b) -> a -> b
$
forall a (m :: * -> *).
(MonadThrow m, MonadIO m, Storable a) =>
(AccessorIx -> m Accessor)
-> (BufferViewIx -> m BufferView)
-> (BufferIx -> m ByteString)
-> AttributeType
-> ComponentType
-> AccessorIx
-> m [a]
accessBuffer @Word16 AccessorIx -> m Accessor
getAccessor BufferViewIx -> m BufferView
getBufferView BufferIx -> m ByteString
getBuffer AttributeType
Accessor.SCALAR ComponentType
Accessor.UNSIGNED_SHORT AccessorIx
aix
ComponentType
Accessor.UNSIGNED_BYTE ->
([Word8] -> [Word32]) -> m [Word8] -> m [Word32]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word8 -> Word32) -> [Word8] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (m [Word8] -> m [Word32]) -> m [Word8] -> m [Word32]
forall a b. (a -> b) -> a -> b
$
forall a (m :: * -> *).
(MonadThrow m, MonadIO m, Storable a) =>
(AccessorIx -> m Accessor)
-> (BufferViewIx -> m BufferView)
-> (BufferIx -> m ByteString)
-> AttributeType
-> ComponentType
-> AccessorIx
-> m [a]
accessBuffer @Word8 AccessorIx -> m Accessor
getAccessor BufferViewIx -> m BufferView
getBufferView BufferIx -> m ByteString
getBuffer AttributeType
Accessor.SCALAR ComponentType
Accessor.UNSIGNED_BYTE AccessorIx
aix
ComponentType
huh ->
UnexpectedComponentType -> m [Word32]
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnexpectedComponentType -> m [Word32])
-> UnexpectedComponentType -> m [Word32]
forall a b. (a -> b) -> a -> b
$ AccessorIx
-> ComponentType -> ComponentType -> UnexpectedComponentType
UnexpectedComponentType AccessorIx
aix ComponentType
Accessor.UNSIGNED_INT ComponentType
huh
(Maybe (Int, Material)
material, [Word32]
indices) <- case MeshPrimitive -> Maybe MaterialIx
Mesh.material MeshPrimitive
prim of
Maybe MaterialIx
Nothing ->
(Maybe (Int, Material), [Word32])
-> m (Maybe (Int, Material), [Word32])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Int, Material)
forall a. Maybe a
Nothing, [Word32]
indicesCCW)
Just (Material.MaterialIx Int
mix) ->
case Vector Material
materials Vector Material -> Int -> Maybe Material
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
mix of
Maybe Material
Nothing ->
String -> m (Maybe (Int, Material), [Word32])
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
"No material for index"
Just mat :: Material
mat@Material.Material{Bool
doubleSided :: Bool
$sel:doubleSided:Material :: Material -> Bool
doubleSided} -> do
(Maybe (Int, Material), [Word32])
-> m (Maybe (Int, Material), [Word32])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( (Int, Material) -> Maybe (Int, Material)
forall a. a -> Maybe a
Just (Int
mix, Material
mat)
, if Bool
doubleSided Bool -> Bool -> Bool
&& Bool
addBacksides then
[Word32]
indicesCCW [Word32] -> [Word32] -> [Word32]
forall a. Semigroup a => a -> a -> a
<> [Word32] -> [Word32]
forall a. [a] -> [a]
reverse [Word32]
indicesCCW
else
if Bool
reverseIndices then
[Word32] -> [Word32]
forall a. [a] -> [a]
reverse [Word32]
indicesCCW
else
[Word32]
indicesCCW
)
[Packed]
positions <- case Text -> HashMap Text AccessorIx -> Maybe AccessorIx
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"POSITION" (MeshPrimitive -> HashMap Text AccessorIx
Mesh.attributes MeshPrimitive
prim) of
Maybe AccessorIx
Nothing ->
String -> m [Packed]
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m [Packed]) -> String -> m [Packed]
forall a b. (a -> b) -> a -> b
$ String
"Mesh primitive without POSITION attribute"
Just AccessorIx
aix ->
forall a (m :: * -> *).
(MonadThrow m, MonadIO m, Storable a) =>
(AccessorIx -> m Accessor)
-> (BufferViewIx -> m BufferView)
-> (BufferIx -> m ByteString)
-> AttributeType
-> ComponentType
-> AccessorIx
-> m [a]
accessBuffer @Vec3.Packed AccessorIx -> m Accessor
getAccessor BufferViewIx -> m BufferView
getBufferView BufferIx -> m ByteString
getBuffer AttributeType
Accessor.VEC3 ComponentType
Accessor.FLOAT AccessorIx
aix
[Packed]
normals <- case Text -> HashMap Text AccessorIx -> Maybe AccessorIx
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"NORMAL" (MeshPrimitive -> HashMap Text AccessorIx
Mesh.attributes MeshPrimitive
prim) of
Maybe AccessorIx
Nothing -> do
Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"Mesh primitive without NORMAL attribute"
pure $ Int -> [Packed] -> [Packed]
forall a. Int -> [a] -> [a]
take ([Packed] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Packed]
positions) ([Packed] -> [Packed]) -> [Packed] -> [Packed]
forall a b. (a -> b) -> a -> b
$ Packed -> [Packed]
forall a. a -> [a]
List.repeat (Vec3 -> Packed
Vec3.Packed Vec3
0)
Just AccessorIx
aix ->
forall a (m :: * -> *).
(MonadThrow m, MonadIO m, Storable a) =>
(AccessorIx -> m Accessor)
-> (BufferViewIx -> m BufferView)
-> (BufferIx -> m ByteString)
-> AttributeType
-> ComponentType
-> AccessorIx
-> m [a]
accessBuffer @Vec3.Packed AccessorIx -> m Accessor
getAccessor BufferViewIx -> m BufferView
getBufferView BufferIx -> m ByteString
getBuffer AttributeType
Accessor.VEC3 ComponentType
Accessor.FLOAT AccessorIx
aix
[Vec2]
texCoords0 <- case Text -> HashMap Text AccessorIx -> Maybe AccessorIx
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"TEXCOORD_0" (MeshPrimitive -> HashMap Text AccessorIx
Mesh.attributes MeshPrimitive
prim) of
Maybe AccessorIx
Nothing -> do
Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Mesh primitive without TEXCOORD_0 attribute"
pure $ Int -> [Vec2] -> [Vec2]
forall a. Int -> [a] -> [a]
take ([Packed] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Packed]
positions) ([Vec2] -> [Vec2]) -> [Vec2] -> [Vec2]
forall a b. (a -> b) -> a -> b
$ Vec2 -> [Vec2]
forall a. a -> [a]
List.repeat Vec2
0
Just AccessorIx
aix ->
forall a (m :: * -> *).
(MonadThrow m, MonadIO m, Storable a) =>
(AccessorIx -> m Accessor)
-> (BufferViewIx -> m BufferView)
-> (BufferIx -> m ByteString)
-> AttributeType
-> ComponentType
-> AccessorIx
-> m [a]
accessBuffer @Vec2 AccessorIx -> m Accessor
getAccessor BufferViewIx -> m BufferView
getBufferView BufferIx -> m ByteString
getBuffer AttributeType
Accessor.VEC2 ComponentType
Accessor.FLOAT AccessorIx
aix
[Vec4]
tangents <- case Text -> HashMap Text AccessorIx -> Maybe AccessorIx
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"TANGENT" (MeshPrimitive -> HashMap Text AccessorIx
Mesh.attributes MeshPrimitive
prim) of
Just AccessorIx
aix ->
forall a (m :: * -> *).
(MonadThrow m, MonadIO m, Storable a) =>
(AccessorIx -> m Accessor)
-> (BufferViewIx -> m BufferView)
-> (BufferIx -> m ByteString)
-> AttributeType
-> ComponentType
-> AccessorIx
-> m [a]
accessBuffer @Vec4 AccessorIx -> m Accessor
getAccessor BufferViewIx -> m BufferView
getBufferView BufferIx -> m ByteString
getBuffer AttributeType
Accessor.VEC4 ComponentType
Accessor.FLOAT AccessorIx
aix
Maybe AccessorIx
Nothing -> do
[Vec4] -> m [Vec4]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Vec4] -> m [Vec4]) -> [Vec4] -> m [Vec4]
forall a b. (a -> b) -> a -> b
$ Int -> [Vec4] -> [Vec4]
forall a. Int -> [a] -> [a]
take ([Packed] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Packed]
positions) ([Vec4] -> [Vec4]) -> [Vec4] -> [Vec4]
forall a b. (a -> b) -> a -> b
$ Vec4 -> [Vec4]
forall a. a -> [a]
List.repeat Vec4
0
let
attrs :: [VertexAttrs]
attrs = do
(Vec2
tc0, Packed
norm, Vec4
tangent') <- [Vec2] -> [Packed] -> [Vec4] -> [(Vec2, Packed, Vec4)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
List.zip3 [Vec2]
texCoords0 [Packed]
normals [Vec4]
tangents
let
tangent :: Packed
tangent =
Vec4 -> (Float -> Float -> Float -> Float -> Packed) -> Packed
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
tangent' \Float
tx Float
ty Float
tz Float
_handedness ->
Vec3 -> Packed
Vec3.Packed (Vec3 -> Packed) -> Vec3 -> Packed
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Vec3
vec3 Float
tx Float
ty Float
tz
VertexAttrs -> [VertexAttrs]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure VertexAttrs
{ $sel:vaTexCoord:VertexAttrs :: Vec2
vaTexCoord = Vec2
tc0
, $sel:vaNormal:VertexAttrs :: Packed
vaNormal = Packed
norm
, $sel:vaTangent:VertexAttrs :: Packed
vaTangent = Packed
tangent
}
pure
( Maybe (Int, Material)
material
, Stuff
{ $sel:sPositions:Stuff :: Vector Packed
sPositions = [Packed] -> Vector Packed
forall a. [a] -> Vector a
Vector.fromList [Packed]
positions
, $sel:sAttrs:Stuff :: Vector VertexAttrs
sAttrs = [VertexAttrs] -> Vector VertexAttrs
forall a. [a] -> Vector a
Vector.fromList [VertexAttrs]
attrs
, $sel:sIndices:Stuff :: Vector Word32
sIndices = [Word32] -> Vector Word32
forall a. [a] -> Vector a
Vector.fromList [Word32]
indices
}
)
pure (GlTF
root, Vector (Vector MeshPrimitive)
meshPrimitives)
accessBuffer
:: forall a m
. ( MonadThrow m
, MonadIO m
, Storable a
)
=> (Accessor.AccessorIx -> m Accessor.Accessor)
-> (BufferView.BufferViewIx -> m BufferView.BufferView)
-> (Buffer.BufferIx -> m ByteString)
-> Accessor.AttributeType
-> Accessor.ComponentType
-> Accessor.AccessorIx
-> m [a]
accessBuffer :: forall a (m :: * -> *).
(MonadThrow m, MonadIO m, Storable a) =>
(AccessorIx -> m Accessor)
-> (BufferViewIx -> m BufferView)
-> (BufferIx -> m ByteString)
-> AttributeType
-> ComponentType
-> AccessorIx
-> m [a]
accessBuffer AccessorIx -> m Accessor
getAccessor BufferViewIx -> m BufferView
getBufferView BufferIx -> m ByteString
getBuffer AttributeType
expectAttribute ComponentType
expectComponent AccessorIx
aix = do
Accessor.Accessor{Maybe BufferViewIx
bufferView :: Maybe BufferViewIx
$sel:bufferView:Accessor :: Accessor -> Maybe BufferViewIx
bufferView, $sel:byteOffset:Accessor :: Accessor -> Int
byteOffset=Int
accOffset, ComponentType
$sel:componentType:Accessor :: Accessor -> ComponentType
componentType :: ComponentType
componentType, Int
count :: Int
$sel:count:Accessor :: Accessor -> Int
count, AttributeType
type' :: AttributeType
$sel:type':Accessor :: Accessor -> AttributeType
type'} <- AccessorIx -> m Accessor
getAccessor AccessorIx
aix
bv :: BufferView
bv@BufferView.BufferView{$sel:byteOffset:BufferView :: BufferView -> Int
byteOffset=Int
bufOffset, Int
byteLength :: Int
$sel:byteLength:BufferView :: BufferView -> Int
byteLength} <- case Maybe BufferViewIx
bufferView of
Maybe BufferViewIx
Nothing ->
String -> m BufferView
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m BufferView) -> String -> m BufferView
forall a b. (a -> b) -> a -> b
$ String
"No bufferView for index accessor " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> AccessorIx -> String
forall a. Show a => a -> String
show AccessorIx
aix
Just BufferViewIx
bvix ->
BufferViewIx -> m BufferView
getBufferView BufferViewIx
bvix
ByteString
buffer <- BufferIx -> m ByteString
getBuffer (BufferView -> BufferIx
BufferView.buffer BufferView
bv)
(AttributeType -> AttributeType -> UnexpectedAttributeType)
-> AttributeType -> AttributeType -> m ()
forall e exception (m :: * -> *).
(Eq e, Exception exception, MonadThrow m) =>
(e -> e -> exception) -> e -> e -> m ()
unexpected (AccessorIx
-> AttributeType -> AttributeType -> UnexpectedAttributeType
UnexpectedAttributeType AccessorIx
aix) AttributeType
expectAttribute AttributeType
type'
(ComponentType -> ComponentType -> UnexpectedComponentType)
-> ComponentType -> ComponentType -> m ()
forall e exception (m :: * -> *).
(Eq e, Exception exception, MonadThrow m) =>
(e -> e -> exception) -> e -> e -> m ()
unexpected (AccessorIx
-> ComponentType -> ComponentType -> UnexpectedComponentType
UnexpectedComponentType AccessorIx
aix) ComponentType
expectComponent ComponentType
componentType
let strideSize :: Int
strideSize = a -> Int
forall a. Storable a => a -> Int
Foreign.sizeOf (String -> a
forall a. HasCallStack => String -> a
error String
"strideSize.sizeOf" :: a)
case BufferView -> Maybe Int
BufferView.byteStride BufferView
bv of
Maybe Int
Nothing ->
() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Int
stride
| Int
stride Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
strideSize ->
() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Int
stride ->
(Int -> Int -> UnexpectedBufferViewStride) -> Int -> Int -> m ()
forall e exception (m :: * -> *).
(Eq e, Exception exception, MonadThrow m) =>
(e -> e -> exception) -> e -> e -> m ()
unexpected (AccessorIx -> Int -> Int -> UnexpectedBufferViewStride
UnexpectedBufferViewStride AccessorIx
aix) Int
strideSize Int
stride
let bytes :: ByteString
bytes = Int -> ByteString -> ByteString
ByteString.take Int
byteLength (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
ByteString.drop (Int
accOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bufOffset) ByteString
buffer
IO [a] -> m [a]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [a] -> m [a])
-> ((CString -> IO [a]) -> IO [a]) -> (CString -> IO [a]) -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CString -> IO [a]) -> IO [a]
forall a. ByteString -> (CString -> IO a) -> IO a
ByteString.unsafeUseAsCString ByteString
bytes ((CString -> IO [a]) -> m [a]) -> (CString -> IO [a]) -> m [a]
forall a b. (a -> b) -> a -> b
$
Int -> Ptr a -> IO [a]
forall a. Storable a => Int -> Ptr a -> IO [a]
Foreign.peekArray Int
count (Ptr a -> IO [a]) -> (CString -> Ptr a) -> CString -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> Ptr a
forall a b. Ptr a -> Ptr b
Foreign.castPtr
unexpected
:: (Eq e, Exception exception, MonadThrow m)
=> (e -> e -> exception)
-> e
-> e
-> m ()
unexpected :: forall e exception (m :: * -> *).
(Eq e, Exception exception, MonadThrow m) =>
(e -> e -> exception) -> e -> e -> m ()
unexpected e -> e -> exception
cons e
expected e
got =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (e
expected e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
got) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
exception -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (exception -> m ()) -> exception -> m ()
forall a b. (a -> b) -> a -> b
$ e -> e -> exception
cons e
expected e
got
data UnexpectedAttributeType = UnexpectedAttributeType
{ UnexpectedAttributeType -> AccessorIx
uatAccessor :: Accessor.AccessorIx
, UnexpectedAttributeType -> AttributeType
uatExpected :: Accessor.AttributeType
, UnexpectedAttributeType -> AttributeType
uatGot :: Accessor.AttributeType
}
deriving (UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
(UnexpectedAttributeType -> UnexpectedAttributeType -> Bool)
-> (UnexpectedAttributeType -> UnexpectedAttributeType -> Bool)
-> Eq UnexpectedAttributeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
== :: UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
$c/= :: UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
/= :: UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
Eq, Eq UnexpectedAttributeType
Eq UnexpectedAttributeType
-> (UnexpectedAttributeType -> UnexpectedAttributeType -> Ordering)
-> (UnexpectedAttributeType -> UnexpectedAttributeType -> Bool)
-> (UnexpectedAttributeType -> UnexpectedAttributeType -> Bool)
-> (UnexpectedAttributeType -> UnexpectedAttributeType -> Bool)
-> (UnexpectedAttributeType -> UnexpectedAttributeType -> Bool)
-> (UnexpectedAttributeType
-> UnexpectedAttributeType -> UnexpectedAttributeType)
-> (UnexpectedAttributeType
-> UnexpectedAttributeType -> UnexpectedAttributeType)
-> Ord UnexpectedAttributeType
UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
UnexpectedAttributeType -> UnexpectedAttributeType -> Ordering
UnexpectedAttributeType
-> UnexpectedAttributeType -> UnexpectedAttributeType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnexpectedAttributeType -> UnexpectedAttributeType -> Ordering
compare :: UnexpectedAttributeType -> UnexpectedAttributeType -> Ordering
$c< :: UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
< :: UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
$c<= :: UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
<= :: UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
$c> :: UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
> :: UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
$c>= :: UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
>= :: UnexpectedAttributeType -> UnexpectedAttributeType -> Bool
$cmax :: UnexpectedAttributeType
-> UnexpectedAttributeType -> UnexpectedAttributeType
max :: UnexpectedAttributeType
-> UnexpectedAttributeType -> UnexpectedAttributeType
$cmin :: UnexpectedAttributeType
-> UnexpectedAttributeType -> UnexpectedAttributeType
min :: UnexpectedAttributeType
-> UnexpectedAttributeType -> UnexpectedAttributeType
Ord, Int -> UnexpectedAttributeType -> String -> String
[UnexpectedAttributeType] -> String -> String
UnexpectedAttributeType -> String
(Int -> UnexpectedAttributeType -> String -> String)
-> (UnexpectedAttributeType -> String)
-> ([UnexpectedAttributeType] -> String -> String)
-> Show UnexpectedAttributeType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> UnexpectedAttributeType -> String -> String
showsPrec :: Int -> UnexpectedAttributeType -> String -> String
$cshow :: UnexpectedAttributeType -> String
show :: UnexpectedAttributeType -> String
$cshowList :: [UnexpectedAttributeType] -> String -> String
showList :: [UnexpectedAttributeType] -> String -> String
Show)
instance Exception UnexpectedAttributeType
data UnexpectedComponentType = UnexpectedComponentType
{ UnexpectedComponentType -> AccessorIx
uctAccessor :: Accessor.AccessorIx
, UnexpectedComponentType -> ComponentType
uctExpected :: Accessor.ComponentType
, UnexpectedComponentType -> ComponentType
uctGot :: Accessor.ComponentType
}
deriving (UnexpectedComponentType -> UnexpectedComponentType -> Bool
(UnexpectedComponentType -> UnexpectedComponentType -> Bool)
-> (UnexpectedComponentType -> UnexpectedComponentType -> Bool)
-> Eq UnexpectedComponentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnexpectedComponentType -> UnexpectedComponentType -> Bool
== :: UnexpectedComponentType -> UnexpectedComponentType -> Bool
$c/= :: UnexpectedComponentType -> UnexpectedComponentType -> Bool
/= :: UnexpectedComponentType -> UnexpectedComponentType -> Bool
Eq, Eq UnexpectedComponentType
Eq UnexpectedComponentType
-> (UnexpectedComponentType -> UnexpectedComponentType -> Ordering)
-> (UnexpectedComponentType -> UnexpectedComponentType -> Bool)
-> (UnexpectedComponentType -> UnexpectedComponentType -> Bool)
-> (UnexpectedComponentType -> UnexpectedComponentType -> Bool)
-> (UnexpectedComponentType -> UnexpectedComponentType -> Bool)
-> (UnexpectedComponentType
-> UnexpectedComponentType -> UnexpectedComponentType)
-> (UnexpectedComponentType
-> UnexpectedComponentType -> UnexpectedComponentType)
-> Ord UnexpectedComponentType
UnexpectedComponentType -> UnexpectedComponentType -> Bool
UnexpectedComponentType -> UnexpectedComponentType -> Ordering
UnexpectedComponentType
-> UnexpectedComponentType -> UnexpectedComponentType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnexpectedComponentType -> UnexpectedComponentType -> Ordering
compare :: UnexpectedComponentType -> UnexpectedComponentType -> Ordering
$c< :: UnexpectedComponentType -> UnexpectedComponentType -> Bool
< :: UnexpectedComponentType -> UnexpectedComponentType -> Bool
$c<= :: UnexpectedComponentType -> UnexpectedComponentType -> Bool
<= :: UnexpectedComponentType -> UnexpectedComponentType -> Bool
$c> :: UnexpectedComponentType -> UnexpectedComponentType -> Bool
> :: UnexpectedComponentType -> UnexpectedComponentType -> Bool
$c>= :: UnexpectedComponentType -> UnexpectedComponentType -> Bool
>= :: UnexpectedComponentType -> UnexpectedComponentType -> Bool
$cmax :: UnexpectedComponentType
-> UnexpectedComponentType -> UnexpectedComponentType
max :: UnexpectedComponentType
-> UnexpectedComponentType -> UnexpectedComponentType
$cmin :: UnexpectedComponentType
-> UnexpectedComponentType -> UnexpectedComponentType
min :: UnexpectedComponentType
-> UnexpectedComponentType -> UnexpectedComponentType
Ord, Int -> UnexpectedComponentType -> String -> String
[UnexpectedComponentType] -> String -> String
UnexpectedComponentType -> String
(Int -> UnexpectedComponentType -> String -> String)
-> (UnexpectedComponentType -> String)
-> ([UnexpectedComponentType] -> String -> String)
-> Show UnexpectedComponentType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> UnexpectedComponentType -> String -> String
showsPrec :: Int -> UnexpectedComponentType -> String -> String
$cshow :: UnexpectedComponentType -> String
show :: UnexpectedComponentType -> String
$cshowList :: [UnexpectedComponentType] -> String -> String
showList :: [UnexpectedComponentType] -> String -> String
Show)
instance Exception UnexpectedComponentType
data UnexpectedBufferViewStride = UnexpectedBufferViewStride
{ UnexpectedBufferViewStride -> AccessorIx
ubvsAccessor :: Accessor.AccessorIx
, UnexpectedBufferViewStride -> Int
ubvsExpected :: Int
, UnexpectedBufferViewStride -> Int
ubvsGot :: Int
}
deriving (UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
(UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool)
-> (UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> Bool)
-> Eq UnexpectedBufferViewStride
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
== :: UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
$c/= :: UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
/= :: UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
Eq, Eq UnexpectedBufferViewStride
Eq UnexpectedBufferViewStride
-> (UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> Ordering)
-> (UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> Bool)
-> (UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> Bool)
-> (UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> Bool)
-> (UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> Bool)
-> (UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> UnexpectedBufferViewStride)
-> (UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> UnexpectedBufferViewStride)
-> Ord UnexpectedBufferViewStride
UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> Ordering
UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> UnexpectedBufferViewStride
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> Ordering
compare :: UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> Ordering
$c< :: UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
< :: UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
$c<= :: UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
<= :: UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
$c> :: UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
> :: UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
$c>= :: UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
>= :: UnexpectedBufferViewStride -> UnexpectedBufferViewStride -> Bool
$cmax :: UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> UnexpectedBufferViewStride
max :: UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> UnexpectedBufferViewStride
$cmin :: UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> UnexpectedBufferViewStride
min :: UnexpectedBufferViewStride
-> UnexpectedBufferViewStride -> UnexpectedBufferViewStride
Ord, Int -> UnexpectedBufferViewStride -> String -> String
[UnexpectedBufferViewStride] -> String -> String
UnexpectedBufferViewStride -> String
(Int -> UnexpectedBufferViewStride -> String -> String)
-> (UnexpectedBufferViewStride -> String)
-> ([UnexpectedBufferViewStride] -> String -> String)
-> Show UnexpectedBufferViewStride
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> UnexpectedBufferViewStride -> String -> String
showsPrec :: Int -> UnexpectedBufferViewStride -> String -> String
$cshow :: UnexpectedBufferViewStride -> String
show :: UnexpectedBufferViewStride -> String
$cshowList :: [UnexpectedBufferViewStride] -> String -> String
showList :: [UnexpectedBufferViewStride] -> String -> String
Show)
instance Exception UnexpectedBufferViewStride