diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,7 @@ +# Changelog for spirv-reflect-yaml + +## [0.1] - 2022-06-11 + +* Initial release. + +[0.1]: https://gitlab.com/dpwiz/spirv-reflect/-/tree/v0.1-yaml diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright IC Rainbow (c) 2022 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/lib/Data/SpirV/Reflect/Yaml.hs b/lib/Data/SpirV/Reflect/Yaml.hs new file mode 100644 --- /dev/null +++ b/lib/Data/SpirV/Reflect/Yaml.hs @@ -0,0 +1,46 @@ +module Data.SpirV.Reflect.Yaml + ( load + , loadBytes + + , YamlError(..) + , prettyYamlError + , prettyYamlErrorBytes + ) where + +import Control.Exception (Exception, throwIO) +import Control.Monad.IO.Class (MonadIO(..)) +import Data.ByteString.Lazy qualified as BSL +import Data.YAML qualified as YAML + +import Data.SpirV.Reflect.Module (Module) +import Data.SpirV.Reflect.Yaml.Parsers (rootP) + +data YamlError = YamlError + { source :: FilePath + , position :: YAML.Pos + , message :: String + } + deriving (Show) + +instance Exception YamlError + +load :: MonadIO io => FilePath -> io Module +load file = + liftIO (BSL.readFile file) >>= loadBytes file + +loadBytes :: MonadIO io => FilePath -> BSL.ByteString -> io Module +loadBytes source bytes = + case YAML.decode1 bytes >>= YAML.parseEither . rootP of + Left (position, message) -> + liftIO $ throwIO YamlError{..} + Right res -> + pure res + +prettyYamlError :: MonadIO io => YamlError -> io String +prettyYamlError err = do + bytes <- liftIO (BSL.readFile $ source err) + pure $ prettyYamlErrorBytes err bytes + +prettyYamlErrorBytes :: YamlError -> BSL.ByteString -> String +prettyYamlErrorBytes YamlError{..} bytes = + YAML.prettyPosWithSource position bytes source ++ message diff --git a/lib/Data/SpirV/Reflect/Yaml/Parsers.hs b/lib/Data/SpirV/Reflect/Yaml/Parsers.hs new file mode 100644 --- /dev/null +++ b/lib/Data/SpirV/Reflect/Yaml/Parsers.hs @@ -0,0 +1,202 @@ +module Data.SpirV.Reflect.Yaml.Parsers where + +import Prelude hiding (id) + +import Data.Functor ((<&>)) +import Data.Text (Text) +import Data.Vector (Vector) +import Data.Vector qualified as Vector +import Data.Vector.Storable qualified as Storable +import Data.YAML ((.:)) +import Data.YAML qualified as YAML + +import Data.SpirV.Reflect.BlockVariable (BlockVariable) +import Data.SpirV.Reflect.BlockVariable qualified as BlockVariable +import Data.SpirV.Reflect.DescriptorBinding (DescriptorBinding) +import Data.SpirV.Reflect.DescriptorBinding qualified as DescriptorBinding +import Data.SpirV.Reflect.DescriptorSet (DescriptorSet) +import Data.SpirV.Reflect.DescriptorSet qualified as DescriptorSet +import Data.SpirV.Reflect.Enums qualified as Enums +import Data.SpirV.Reflect.InterfaceVariable (InterfaceVariable) +import Data.SpirV.Reflect.InterfaceVariable qualified as InterfaceVariable +import Data.SpirV.Reflect.Module (Module) +import Data.SpirV.Reflect.Module qualified as Module +import Data.SpirV.Reflect.Traits qualified as Traits +import Data.SpirV.Reflect.TypeDescription (TypeDescription) +import Data.SpirV.Reflect.TypeDescription qualified as TypeDescription + +rootP :: NodeParser Module +rootP = YAML.withMap "Root" \m -> + -- XXX: Discarding all_XXX fields, assuming they got unrolled by YAML decoder. + m .: "module" >>= moduleP + +moduleP :: NodeParser Module +moduleP = YAML.withMap "Module" \m -> do + generator <- m .: "generator" <&> Enums.Generator + entry_point_name <- m .: "entry_point_name" + entry_point_id <- m .: "entry_point_id" + source_language <- m .: "source_language" + source_language_version <- m .: "source_language_version" + spirv_execution_model <- m .: "spirv_execution_model" + shader_stage <- m .: "shader_stage" + descriptor_bindings <- m .? "descriptor_bindings" `seqOf` descriptorBindingP + descriptor_sets <- m .? "descriptor_sets" `seqOf` descriptorSetP + input_variables <- m .? "input_variables" `seqOf` interfaceVariableP + output_variables <- m .? "output_variables" `seqOf` interfaceVariableP + push_constants <- m .? "push_constants" `seqOf` blockVariableP + pure Module.Module{..} + +descriptorBindingP :: NodeParser DescriptorBinding +descriptorBindingP = YAML.withMap "DescriptorBinding" \m -> do + spirv_id <- m .? "spirv_id" + name <- m .: "name" + binding <- m .: "binding" + input_attachment_index <- m .: "input_attachment_index" + set <- m .: "set" + descriptor_type <- m .: "descriptor_type" <&> Enums.DescriptorType + resource_type <- m .: "resource_type" <&> Enums.ResourceFlagBits + image <- m .: "image" >>= traitsImageP + block <- m .: "block" >>= blockVariableP + array <- m .: "array" >>= traitsArrayP + count <- m .? "count" + accessed <- m .: "accessed" + uav_counter_id <- m .: "uav_counter_id" + uav_counter_binding <- m .? "uav_counter_binding" >>= traverse descriptorBindingP + type_description <- m .? "type_description" >>= traverse typeDescriptionP + word_offset <- m .: "word_offset" >>= descriptorBindingWordOffsetP + decoration_flags <- m .? "decoration_flags" <&> maybe Enums.DECORATION_NONE Enums.DecorationFlagBits + pure DescriptorBinding.DescriptorBinding{..} + +descriptorBindingWordOffsetP :: NodeParser DescriptorBinding.WordOffset +descriptorBindingWordOffsetP = YAML.withMap "DescriptorBinding.WordOffset" \m -> do + binding <- m .: "binding" + set <- m .: "set" + pure DescriptorBinding.WordOffset{..} + +typeDescriptionP :: NodeParser TypeDescription +typeDescriptionP = YAML.withMap "TypeDescription" \m -> do + id <- m .? "id" + op <- m .? "op" <&> fmap Enums.Op + type_name <- m .? "type_name" + struct_member_name <- m .? "struct_member_name" + storage_class <- m .: "storage_class" <&> Enums.StorageClass + type_flags <- m .? "type_flags" <&> maybe Enums.TYPE_FLAG_UNDEFINED Enums.TypeFlagBits + traits <- m .? "traits" >>= traverse typeDescriptionTraitsP + members <- m .? "members" `seqOf` typeDescriptionP + pure TypeDescription.TypeDescription{..} + +typeDescriptionTraitsP :: NodeParser TypeDescription.Traits +typeDescriptionTraitsP = YAML.withMap "TypeDescription.Traits" \m -> do + numeric <- m .: "numeric" >>= traitsNumericP + image <- m .: "image" >>= traitsImageP + array <- m .: "array" >>= traitsArrayP + pure TypeDescription.Traits{..} + +descriptorSetP :: NodeParser DescriptorSet +descriptorSetP = YAML.withMap "DescriptorSet" \m -> do + set <- m .: "set" + bindings <- m .? "bindings" `seqOf` descriptorBindingP + pure DescriptorSet.DescriptorSet{..} + +interfaceVariableP :: NodeParser InterfaceVariable +interfaceVariableP = YAML.withMap "InterfaceVariable" \m -> do + spirv_id <- m .? "spirv_id" + name <- m .? "name" + location <- m .: "location" + storage_class <- m .: "storage_class" <&> Enums.StorageClass + semantic <- m .: "semantic" + decoration_flags <- m .: "decoration_flags" <&> Enums.DecorationFlagBits + built_in <- m .: "built_in" <&> Enums.BuiltIn + numeric <- m .: "numeric" >>= traitsNumericP + array <- m .: "array" >>= traitsArrayP + members <- m .? "members" `seqOf` typeDescriptionP + format <- m .: "format" <&> Enums.Format + type_description <- m .? "type_description" >>= traverse typeDescriptionP + word_offset <- m .: "word_offset" >>= interfaceVariableWordOffsetP + pure InterfaceVariable.InterfaceVariable{..} + +interfaceVariableWordOffsetP :: NodeParser InterfaceVariable.WordOffset +interfaceVariableWordOffsetP = YAML.withMap "InterfaceVariable.WordOffset" \m -> do + location <- m .: "location" + pure InterfaceVariable.WordOffset{..} + +blockVariableP :: NodeParser BlockVariable +blockVariableP = YAML.withMap "BlockVariable" \m -> do + spirv_id <- m .? "spirv_id" + name <- m .? "name" + offset <- m .: "offset" + absolute_offset <- m .: "absolute_offset" + size <- m .: "size" + padded_size <- m .: "padded_size" + decorations <- m .: "decorations" <&> Enums.DecorationFlagBits + numeric <- m .: "numeric" >>= traitsNumericP + array <- m .: "array" >>= traitsArrayP + members <- m .? "members" `seqOf` blockVariableP + type_description <- m .? "type_description" >>= traverse typeDescriptionP + pure BlockVariable.BlockVariable{..} + +-------------- + +traitsNumericP :: NodeParser Traits.Numeric +traitsNumericP = YAML.withMap "Numeric" \m -> do + scalar <- m .: "scalar" >>= traitsScalarP + vector <- m .: "vector" >>= traitsVectorP + matrix <- m .: "matrix" >>= traitsMatrixP + pure Traits.Numeric{..} + +traitsScalarP :: NodeParser Traits.Scalar +traitsScalarP = YAML.withMap "Scalar" \m -> do + width <- m .: "width" + signedness <- m .: "signedness" + pure Traits.Scalar{..} + +traitsVectorP :: NodeParser Traits.Vector +traitsVectorP = YAML.withMap "Vector" \m -> do + component_count <- m .: "component_count" + pure Traits.Vector{..} + +traitsMatrixP :: NodeParser Traits.Matrix +traitsMatrixP = YAML.withMap "Matrix" \m -> do + column_count <- m .: "column_count" + row_count <- m .: "row_count" + stride <- m .: "stride" + pure Traits.Matrix{..} + +traitsArrayP :: NodeParser Traits.Array +traitsArrayP = YAML.withMap "Array" \m -> do + dims_count <- m .: "dims_count" + dims <- m .: "dims" <&> Storable.fromList + stride <- m .? "stride" + pure Traits.Array{..} + +traitsImageP :: NodeParser Traits.Image +traitsImageP = YAML.withMap "Image" \m -> do + dim <- m .: "dim" <&> Enums.Dim + depth <- m .: "depth" + arrayed <- m .: "arrayed" + ms <- m .: "ms" + sampled <- m .: "sampled" + image_format <- m .: "image_format" <&> Enums.ImageFormat + pure Traits.Image{..} + +type NodeParser a = + YAML.Node YAML.Pos -> + YAML.Parser a + +(.?) + :: YAML.FromYAML a + => YAML.Mapping YAML.Pos + -> Text + -> YAML.Parser (Maybe a) +o .? v = o YAML..:? v + +seqOf + :: YAML.Parser (Maybe (YAML.Node YAML.Pos)) + -> NodeParser a + -> YAML.Parser (Vector a) +seqOf mappingP nodeP = + mappingP >>= \case + Nothing -> + pure mempty + Just items -> + YAML.withSeq "seqOf" (traverse nodeP . Vector.fromList) items diff --git a/spirv-reflect-yaml.cabal b/spirv-reflect-yaml.cabal new file mode 100644 --- /dev/null +++ b/spirv-reflect-yaml.cabal @@ -0,0 +1,91 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- see: https://github.com/sol/hpack + +name: spirv-reflect-yaml +version: 0.1 +synopsis: YAML loader for spirv-reflect tool. +category: Graphics +author: IC Rainbow +maintainer: ic.rbow@gmail.com +copyright: 2022 IC Rainbow +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + ChangeLog.md + +source-repository head + type: git + location: https://gitlab.com/dpwiz/spirv-reflect + +flag tests + manual: True + default: False + +library + exposed-modules: + Data.SpirV.Reflect.Yaml + Data.SpirV.Reflect.Yaml.Parsers + other-modules: + Paths_spirv_reflect_yaml + hs-source-dirs: + lib + default-extensions: + ApplicativeDo + BlockArguments + DeriveGeneric + DerivingStrategies + DuplicateRecordFields + FlexibleContexts + GeneralizedNewtypeDeriving + ImportQualifiedPost + LambdaCase + OverloadedStrings + PatternSynonyms + RecordWildCards + StrictData + TypeApplications + build-depends: + HsYAML + , base >=4.7 && <5 + , bytestring + , spirv-reflect-types + , text + , vector + default-language: Haskell2010 + +test-suite spirv-reflect-yaml-test + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Paths_spirv_reflect_yaml + hs-source-dirs: + test + default-extensions: + ApplicativeDo + BlockArguments + DeriveGeneric + DerivingStrategies + DuplicateRecordFields + FlexibleContexts + GeneralizedNewtypeDeriving + ImportQualifiedPost + LambdaCase + OverloadedStrings + PatternSynonyms + RecordWildCards + StrictData + TypeApplications + build-depends: + base >=4.7 && <5 + , directory + , filepath + , spirv-reflect-yaml + , tasty + , tasty-hunit + if !flag(tests) + buildable: False + default-language: Haskell2010 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,57 @@ +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/"