{-# LANGUAGE OverloadedStrings #-} module Test.Codec.CBOR.Cuddle.CDDL.Examples (spec) where import Codec.CBOR.Cuddle.CDDL (Value (..), ValueVariant (..)) import Codec.CBOR.Cuddle.CDDL.CTree (CTree (..), CTreeRoot, PTerm (..)) import Codec.CBOR.Cuddle.CDDL.Postlude (appendPostlude) import Codec.CBOR.Cuddle.CDDL.Resolve ( MonoReferenced, NameResolutionFailure (..), fullResolveCDDL, ) import Codec.CBOR.Cuddle.IndexMappable (mapCDDLDropExt) import Codec.CBOR.Cuddle.Parser (pCDDL) import Data.Text.IO qualified as T import Paths_cuddle (getDataFileName) import Test.HUnit (assertFailure) import Test.Hspec import Text.Megaparsec (parse) import Text.Megaparsec.Error (errorBundlePretty) tryValidateFile :: FilePath -> IO (Either NameResolutionFailure (CTreeRoot MonoReferenced)) tryValidateFile filePath = do absoluteFilePath <- getDataFileName filePath contents <- T.readFile absoluteFilePath cddl <- case parse pCDDL "" contents of Right x -> pure $ appendPostlude x Left x -> fail $ "Failed to parse the file:\n" <> errorBundlePretty x pure . fullResolveCDDL $ mapCDDLDropExt cddl validateExpectSuccess :: FilePath -> Spec validateExpectSuccess filePath = it ("Successfully validates " <> filePath) $ do res <- tryValidateFile filePath case res of Right _ -> pure () Left err -> assertFailure $ "Failed to validate:\n" <> show err validateExpectFailure :: FilePath -> NameResolutionFailure -> Spec validateExpectFailure filePath expectedFailure = it ("Fails to validate " <> filePath) $ do res <- tryValidateFile filePath case res of Right _ -> assertFailure "Expected a failure, but succeeded instead" Left e -> e `shouldBe` expectedFailure spec :: Spec spec = do describe "Validator" $ do describe "Positive" $ do validateExpectSuccess "example/cddl-files/byron.cddl" validateExpectSuccess "example/cddl-files/conway.cddl" validateExpectSuccess "example/cddl-files/shelley.cddl" validateExpectSuccess "example/cddl-files/basic_assign.cddl" validateExpectSuccess "example/cddl-files/issue80-min.cddl" validateExpectSuccess "example/cddl-files/pretty.cddl" describe "Negative" $ do validateExpectFailure "example/cddl-files/validator/negative/unknown-name.cddl" $ UnboundReference "a" validateExpectFailure "example/cddl-files/validator/negative/too-few-args.cddl" $ MismatchingArgs "foo" ["a", "b"] validateExpectFailure "example/cddl-files/validator/negative/too-many-args.cddl" $ MismatchingArgs "foo" ["a"] validateExpectFailure "example/cddl-files/validator/negative/args-to-postlude.cddl" $ ArgsToPostlude PTUInt [Literal (Value (VUInt 3) mempty)]