WIP

Author: Soupstraw

src/Codec/CBOR/Cuddle/Huddle.hs

@@ -381,13 +381,13 @@ data LiteralVariant where
   LBytes :: ByteString -> LiteralVariant
   deriving (Show)
 
-int :: Default i => Integer -> Literal i
+int :: Integer -> Literal DHuddle
 int = inferInteger
 
-bstr :: Default i => ByteString -> Literal i
+bstr :: ByteString -> Literal DHuddle
 bstr x = Literal (LBytes x) def
 
-text :: Default i => T.Text -> Literal i
+text :: T.Text -> Literal DHuddle
 text x = Literal (LText x) def
 
 inferInteger :: Default i => Integer -> Literal i
@@ -887,21 +887,21 @@ seal = Seal
 
 -- | This function is used solely to resolve type inference by explicitly
 -- identifying something as an array.
-arr :: ArrayChoice i -> ArrayChoice i
+arr :: ArrayChoice DHuddle -> ArrayChoice DHuddle
 arr = id
 
 -- | Create and seal an array, marking it as accepting no additional choices
-sarr :: ArrayChoice i -> Seal (Array i)
+sarr :: ArrayChoice DHuddle -> Seal (Array DHuddle)
 sarr = seal . NoChoice
 
-mp :: MapChoice i -> MapChoice i
+mp :: MapChoice DHuddle -> MapChoice DHuddle
 mp = id
 
 -- | Create and seal a map, marking it as accepting no additional choices.
-smp :: MapChoice i -> Seal (Map i)
+smp :: MapChoice DHuddle -> Seal (Map DHuddle)
 smp = seal . NoChoice
 
-grp :: Group i -> Group i
+grp :: Group DHuddle -> Group DHuddle
 grp = id
 
 --------------------------------------------------------------------------------
@@ -1103,7 +1103,7 @@ toCDDL' mkPseudoRoot hdl =
     toTopLevelPseudoRoot topRs =
       toCDDLRule $
         comment "Pseudo-rule introduced by Cuddle to collect root elements" $
-          "huddle_root_defs" =:= arr @DHuddle (fromList (fmap a topRs))
+          "huddle_root_defs" =:= arr (fromList (fmap a topRs))
     toCDDLRule :: Rule DHuddle -> C.Rule DHuddle
     toCDDLRule (Named n t0 c) =
       (\x -> C.Rule (C.Name n mempty) Nothing C.AssignEq x c)

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

@@ -4,6 +4,7 @@ import Codec.CBOR.Cuddle.CDDL.Prelude (prependPrelude)
 import Codec.CBOR.Cuddle.CDDL.Resolve (fullResolveCDDL)
 import Codec.CBOR.Cuddle.Parser (pCDDL)
 import Data.Either (isRight)
+import Data.Functor (($>))
 import Data.Text.IO qualified as T
 import Test.Hspec
 import Text.Megaparsec (parse)
@@ -15,7 +16,7 @@ validateFile filePath = it ("Successfully validates " <> filePath) $ do
   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
+  fullResolveCDDL (cddl $> ()) `shouldSatisfy` isRight
 
 spec :: Spec
 spec = do

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

@@ -192,7 +192,7 @@ instance Arbitrary i => Arbitrary (MemberKey i) where
 
   shrink = genericShrink
 
-instance Arbitrary Value where
+instance Arbitrary i => Arbitrary (Value i) where
   arbitrary = Value <$> arbitrary <*> arbitrary
   shrink = genericShrink
 

test/Test/Codec/CBOR/Cuddle/Huddle.hs

@@ -119,10 +119,10 @@ nestedSpec =
 genericSpec :: Spec
 genericSpec =
   describe "Generics" $
-    let set :: IsType0 t0 => t0 -> GRuleCall
+    let set :: IsType0 t0 => t0 -> GRuleCall DHuddle
         set = binding $ \x -> "set" =:= arr [0 <+ a x]
 
-        dict :: (IsType0 t0, IsType0 t1) => t0 -> t1 -> GRuleCall
+        dict :: (IsType0 t0, IsType0 t1) => t0 -> t1 -> GRuleCall DHuddle
         dict = binding2 $ \k v -> "dict" =:= mp [0 <+ asKey k ==> v]
      in do
           it "Should bind a single parameter" $
@@ -162,5 +162,5 @@ shouldMatchParseCDDL ::
   Expectation
 shouldMatchParseCDDL x = shouldMatchParse x pCDDL
 
-toSortedCDDLPretty :: Huddle -> CDDL Comment
-toSortedCDDLPretty = sortCDDL . toCDDLNoRoot
+toSortedCDDLPretty :: Huddle DHuddle -> CDDL Comment
+toSortedCDDLPretty = sortCDDL . fmap dhComment . toCDDLNoRoot