test(lib): Add scenes tests

sgillespie · Feb 25, 2024 · 3ac7d55 · 3ac7d55
1 parent 6f8881c
commit 3ac7d55
Show file tree

Hide file tree

Showing 3 changed files with 38 additions and 6 deletions.
diff --git a/src/Text/GLTF/Loader/Internal/Adapter.hs b/src/Text/GLTF/Loader/Internal/Adapter.hs
@@ -11,11 +11,13 @@ module Text.GLTF.Loader.Internal.Adapter
     adaptMaterials,
     adaptMeshes,
     adaptNodes,
+    adaptScenes,
     adaptTextures,
     adaptImage,
     adaptMaterial,
     adaptMesh,
     adaptNode,
+    adaptScene,
     adaptTexture,
     adaptAlphaMode,
     adaptPbrMetallicRoughness,

diff --git a/test/Text/GLTF/Loader/Internal/AdapterSpec.hs b/test/Text/GLTF/Loader/Internal/AdapterSpec.hs
@@ -12,6 +12,7 @@ import qualified Codec.GlTF.Image as Image
 import qualified Codec.GlTF.Material as Material
 import qualified Codec.GlTF.Mesh as Mesh
 import qualified Codec.GlTF.Node as Node
+import qualified Codec.GlTF.Scene as Scene
 import qualified Codec.GlTF.Texture as Texture
 import qualified Codec.GlTF.URI as URI
 import qualified Data.HashMap.Strict as HashMap
@@ -88,6 +89,18 @@ spec = do
       adaptNodes (Just []) `shouldBe` []
       adaptNodes Nothing `shouldBe` []
 
+  describe "adaptScenes" $ do
+    let scene = mkCodecScene
+        scene' = scene{Scene.name = Just "Other Scene"}
+
+    it "Adapts a list of scenes" $ do
+      adaptScenes (Just [scene, scene'])
+        `shouldBe` [loaderScene, set _sceneName (Just "Other Scene") loaderScene]
+
+    it "Adapts empty scenes" $ do
+      adaptScenes (Just []) `shouldBe` []
+      adaptScenes Nothing `shouldBe` []
+
   describe "adaptImage" $ do
     let codecImage =
           Image.Image
@@ -172,6 +185,18 @@ spec = do
       adaptNode codecNodeNothing `shouldBe` nodeEmptyChildren
       adaptNode codecNodeEmpty `shouldBe` nodeEmptyChildren
 
+  describe "adaptScene" $ do
+    it "Adapts a basic node" $ do
+      adaptScene mkCodecScene `shouldBe` loaderScene
+
+    it "Adapts empty nodes" $ do
+      let sceneEmptyNode = set _sceneNodes [] loaderScene
+          codecSceneEmpty = mkCodecScene{Scene.nodes = Nothing}
+          codecSceneNothing = mkCodecScene{Scene.nodes = Just []}
+
+      adaptScene codecSceneEmpty `shouldBe` sceneEmptyNode
+      adaptScene codecSceneNothing `shouldBe` sceneEmptyNode
+
   describe "adaptTexture" $ do
     it "Adapts simple textures" $ do
       adaptTexture mkCodecTexture `shouldBe` loaderTexture

diff --git a/test/Text/GLTF/LoaderSpec.hs b/test/Text/GLTF/LoaderSpec.hs
@@ -59,16 +59,13 @@ fromFileTests file fromFile = do
 
     gltf' ^? _asset `shouldBe` Just expectedAsset
     gltf' ^?! _images `shouldSatisfy` \images ->
-      images
-        ^? _head
-          . _imageMimeType
-          == Just "image/png"
-          && images
-        ^? _head . _imageName == Just (Just "Untitled")
+      (images ^? _head . _imageMimeType == Just "image/png")
+        && (images ^? _head . _imageName == Just (Just "Untitled"))
     gltf' ^? _materials `shouldBe` Just expectedMaterials
     gltf' ^? _meshes `shouldBe` Just expectedMeshes
     gltf' ^? _nodes `shouldBe` Just expectedNodes
     gltf' ^? _samplers `shouldBe` Just expectedSamplers
+    gltf' ^? _scenes `shouldBe` Just expectedScenes
     gltf' ^? _textures `shouldBe` Just expectedTextures
 
 expectedAsset :: Asset
@@ -259,6 +256,14 @@ expectedSamplers =
       }
   ]
 
+expectedScenes :: Vector Scene
+expectedScenes =
+  [ Scene
+      { sceneName = Just "Scene",
+        sceneNodes = [0]
+      }
+  ]
+
 expectedTextures :: Vector Texture
 expectedTextures =
   [ Texture