module Main where import Control.Monad (guard) import Data.Foldable (toList) import Data.List (isSuffixOf) import Debug.Trace (traceM) import Shower (printer) import System.Directory (listDirectory) import System.FilePath (()) import qualified Data.ByteString as ByteString import qualified Codec.GLB as GLB import qualified Codec.GlTF as GlTF import qualified Codec.GlTF.Buffer as Buffer import qualified Codec.GlTF.Image as Image import qualified Codec.GlTF.Root as Root import qualified Codec.GlTF.URI as URI assetsPath :: FilePath assetsPath = ".." "assets" main :: IO () main = do assets <- listDirectory assetsPath mapM_ testGltf do fp <- assets guard $ ".gltf" `isSuffixOf` fp pure $ assetsPath fp mapM_ testGlb do fp <- assets guard $ ".glb" `isSuffixOf` fp pure $ assetsPath fp testGltf :: FilePath -> IO () testGltf source = GlTF.fromFile source >>= \case Left err -> do traceM err fail $ "gltf load error in " <> source Right gltf -> do printer gltf testBuffers source gltf testGlb :: FilePath -> IO () testGlb source = GLB.fromFile source >>= \case Left (offset, err) -> do traceM err fail $ "glb error at " <> show offset Right glb -> do printer ( GLB.header glb , fmap (\GLB.Chunk{..} -> (chunkLength, chunkType)) (GLB.chunks glb) ) case GlTF.fromChunk (head . toList $ GLB.chunks glb) of Left err -> do traceM err fail $ "glb json error inside " <> source Right gltf -> printer gltf testBuffers :: FilePath -> Root.GlTF -> IO () testBuffers source gltf = do case Root.buffers gltf of Nothing -> pure () Just buffers -> mapM_ (testURI source) $ concatMap (toList . Buffer.uri) buffers case Root.images gltf of Nothing -> pure () Just images -> mapM_ (testURI source) $ concatMap (toList . Image.uri) images testURI :: FilePath -> URI.URI -> IO () testURI _source uri = do URI.loadURI testLoader uri >>= \case Left err -> fail err Right bs -> printer (uri, ByteString.length bs) where testLoader path = fmap Right $ ByteString.readFile (assetsPath path)