Added more validator tests

Author: Soupstraw

example/cddl-files/basic_assign.cddl

@@ -44,9 +44,3 @@ big_group = (
   5 ...10,
   h'11aaff3351bc'
 )
-
-test = ~ aaaa .. "j" / 
-# /
-{xco, lhXH // // } .cborseq # /
-& (* kkhw // // ) /
-"b"

example/cddl-files/pretty.cddl

@@ -1,3 +1,5 @@
+set<a > = [* a]
+
 a = [ 2*30 2 : uint
   , ? 33 : bytes
   , 4444 : set<uint>
@@ -6,6 +8,6 @@ a = [ 2*30 2 : uint
 
 b = [1,uint,(3,4)]
 
-c = { x 
-, y ; hello
+c = { a 
+, b ; hello
 }

example/cddl-files/validator/negative/args-to-postlude.cddl

@@ -0,0 +1 @@
+x = uint<3>

example/cddl-files/validator/negative/mismatching-args.cddl

@@ -0,0 +1,3 @@
+foo<a, b> = [a, b]
+
+x = foo<uint>

example/cddl-files/validator/negative/unknown-name.cddl

@@ -0,0 +1 @@
+x = a

src/Codec/CBOR/Cuddle/CDDL/CTree.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Codec.CBOR.Cuddle.CDDL.CTree where
 
@@ -46,6 +47,8 @@ data CTree f
   | Tag Word64 (Node f)
   deriving (Generic)
 
+deriving instance Eq (Node f) => Eq (CTree f)
+
 -- | Traverse the CTree, carrying out the given operation at each node
 traverseCTree :: Monad m => (Node f -> m (Node g)) -> CTree f -> m (CTree g)
 traverseCTree _ (Literal a) = pure $ Literal a

src/Codec/CBOR/Cuddle/CDDL/Resolve.hs

@@ -30,6 +30,7 @@ module Codec.CBOR.Cuddle.CDDL.Resolve (
   buildMonoCTree,
   fullResolveCDDL,
   MonoRef (..),
+  OrRef (..),
   NameResolutionFailure (..),
 )
 where
@@ -128,7 +129,7 @@ data OrRef a
     It a
   | -- | Reference to another node with possible generic arguments supplied
     Ref Name [CTree.Node OrRef]
-  deriving (Show, Functor)
+  deriving (Eq, Show, Functor)
 
 type RefCTree = CTreeRoot OrRef
 
@@ -303,6 +304,8 @@ data NameResolutionFailure
   | ArgsToPostlude PTerm [CTree.Node OrRef]
   deriving (Show)
 
+deriving instance Eq (OrRef (CTree OrRef)) => Eq NameResolutionFailure
+
 postludeBinding :: Map.Map Name PTerm
 postludeBinding =
   Map.fromList
@@ -342,8 +345,6 @@ instance Hashable a => Hashable (DistRef a)
 
 deriving instance Show (CTree DistRef)
 
-deriving instance Eq (CTree DistRef)
-
 instance Hashable (CTree DistRef)
 
 deriving instance Show (CTreeRoot DistRef)

test/Test/Codec/CBOR/Cuddle/CDDL/Examples.hs

@@ -1,27 +1,61 @@
+{-# 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')
+import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm (..))
 import Codec.CBOR.Cuddle.CDDL.Prelude (prependPrelude)
-import Codec.CBOR.Cuddle.CDDL.Resolve (fullResolveCDDL)
+import Codec.CBOR.Cuddle.CDDL.Resolve (
+  MonoRef,
+  NameResolutionFailure (..),
+  OrRef (..),
+  fullResolveCDDL,
+ )
 import Codec.CBOR.Cuddle.Parser (pCDDL)
-import Data.Either (isRight)
+import Data.Functor.Identity (Identity)
 import Data.Text.IO qualified as T
+import Test.HUnit (assertFailure)
 import Test.Hspec
 import Text.Megaparsec (parse)
 import Text.Megaparsec.Error (errorBundlePretty)
 
-validateFile :: FilePath -> Spec
-validateFile filePath = it ("Successfully validates " <> filePath) $ do
+tryValidateFile :: FilePath -> IO (Either NameResolutionFailure (CTreeRoot' Identity MonoRef))
+tryValidateFile filePath = do
   contents <- T.readFile filePath
   cddl <- case parse pCDDL "" contents of
     Right x -> pure $ prependPrelude x
     Left x -> fail $ "Failed to parse the file:\n" <> errorBundlePretty x
-  fullResolveCDDL cddl `shouldSatisfy` isRight
+  pure $ fullResolveCDDL 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
-  validateFile "example/cddl-files/byron.cddl"
-  validateFile "example/cddl-files/conway.cddl"
-  validateFile "example/cddl-files/shelley.cddl"
-
--- TODO this one does not seem to terminate
--- validateFile "example/cddl-files/basic_assign.cddl"
+  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/mismatching-args.cddl" $
+        MismatchingArgs "foo" ["a", "b"]
+      validateExpectFailure "example/cddl-files/validator/negative/args-to-postlude.cddl" $
+        ArgsToPostlude PTUInt [It (Literal (Value (VUInt 3) mempty))]