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

module Main where

import Control.Exception (try)
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.Yaml qualified as Yaml

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
        yamlFiles = do
          filePath <- groupContents
          case splitExtensions filePath of
            (name, ".spv.yaml") ->
              pure
                ( takeFileName name
                , groupPath </> filePath
                )
            _skip ->
              mempty
      pure (path, yamlFiles)

  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
    try (Yaml.load file) >>= \case
      Left err ->
        Yaml.prettyYamlError err >>= fail
      Right _res ->
        pure ()
        -- writeFile (file ++ ".hs") $
        --   show res

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