{-# LANGUAGE BangPatterns #-} module Main where import Control.Monad (guard) import System.Directory (doesDirectoryExist, listDirectory) import System.FilePath (splitExtension, takeFileName, ()) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (testCase) import Data.SpirV.Reflect.FFI qualified as FFI main :: IO () main = discover >>= defaultMain discover :: IO TestTree discover = do groupDirs <- listDirectory UPSTREAM_PATH >>= traverse \path -> do let groupPath = UPSTREAM_PATH path isDir <- doesDirectoryExist groupPath if not isDir then pure mempty else do groupContents <- listDirectory groupPath let files = do filePath <- groupContents case splitExtension filePath of (name, ".spv") -> pure ( takeFileName name , groupPath filePath ) _skip -> mempty pure (path, files) let groups = do (name, yamls) <- groupDirs guard $ not (null yamls) pure $ testGroup name (map mkTest yamls) pure $ testGroup "upstream" groups mkTest :: (String, FilePath) -> TestTree mkTest (name, file) = testCase name do -- putStrLn $ file <> " >>>>" !_loaded <- FFI.load file -- writeFile (file <> "_ffi.hs") (show _loaded) pure () -- print _loaded -- putStrLn $ file <> " <<<<" pattern UPSTREAM_PATH :: FilePath pattern UPSTREAM_PATH = "../SPIRV-Reflect/tests/"