spirv-reflect-ffi-0.1: test/Main.hs

{-# LANGUAGE BangPatterns #-}

module Main where

import Control.Monad (guard)
import System.Directory (doesDirectoryExist, listDirectory)
import System.FilePath (splitExtensions, 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 splitExtensions 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
    pure ()
    -- print loaded
    -- putStrLn $ file <> " <<<<"

pattern UPSTREAM_PATH :: FilePath
pattern UPSTREAM_PATH = "../SPIRV-Reflect/tests/"