Support keys in group entries

This addresses #32, at least for the function of adding keys for
descriptive purposes to arrays. Maps still require additional support to
handle including groups, since currently map entries are required to
have keys.

CHANGELOG.md

@@ -38,3 +38,13 @@
   additional hints are required to type literal numerics correctly. Typically 
   this is most easily fixed by adding a call `int` for any numeric literals in 
   ranges. An example is shown in `example/Conway.hs` 
+
+## 0.3.6.0 -- 2024-12-02
+* Support having keys in group entries. This is needed when using a group to
+  define a map, or when wishing to include keys in for-use-in-array groups for
+  documentation purposes. This may introduce problems with existing specifications
+  where some type hints (using 'a') are needed to properly type entries in groups,
+  where previously they were unambiguous.
+
+  Note that it is not yet supported to use a group inside a map, where the 
+  issue of merging keys arises.

cuddle.cabal

@@ -1,6 +1,6 @@
 cabal-version:   3.4
 name:            cuddle
-version:         0.3.5.0
+version:         0.3.6.0
 synopsis:        CDDL Generator and test utilities
 
 -- description:

example/Conway.hs

@@ -159,30 +159,30 @@ parameter_change_action =
   "parameter_change_action"
     =:~ grp
       [ 0,
-        gov_action_id / VNil,
+        a (gov_action_id / VNil),
         a protocol_param_update,
-        policy_hash / VNil
+        a (policy_hash / VNil)
       ]
 
 hard_fork_initiation_action :: Named Group
 hard_fork_initiation_action =
   "hard_fork_initiation_action"
-    =:~ grp [1, gov_action_id / VNil, a (arr [a protocol_version])]
+    =:~ grp [1, a (gov_action_id / VNil), a (arr [a protocol_version])]
 
 treasury_withdrawals_action :: Named Group
 treasury_withdrawals_action =
   "treasury_withdrawals_action"
-    =:~ grp [2, a (arr [asKey reward_account ==> coin / VInt]), policy_hash / VNil]
+    =:~ grp [2, a (arr [asKey reward_account ==> coin / VInt]), a (policy_hash / VNil)]
 
 no_confidence :: Named Group
-no_confidence = "no_confidence" =:~ grp [3, gov_action_id / VNil]
+no_confidence = "no_confidence" =:~ grp [3, a (gov_action_id / VNil)]
 
 update_committee :: Named Group
 update_committee =
   "update_committee"
     =:~ grp
       [ 4,
-        gov_action_id / VNil,
+        a (gov_action_id / VNil),
         a (set committee_cold_credential),
         a (arr [asKey committee_cold_credential ==> epoch]),
         a unit_interval
@@ -191,7 +191,7 @@ update_committee =
 new_constitution :: Named Group
 new_constitution =
   "new_constitution"
-    =:~ grp [5, gov_action_id / VNil, a constitution]
+    =:~ grp [5, a (gov_action_id / VNil), a constitution]
 
 constitution :: Rule
 constitution =
@@ -356,16 +356,16 @@ auth_committee_hot_cert =
 resign_committee_cold_cert :: Named Group
 resign_committee_cold_cert =
   "resign_committee_cold_cert"
-    =:~ grp [15, a committee_cold_credential, anchor / VNil]
+    =:~ grp [15, a committee_cold_credential, a (anchor / VNil)]
 
 reg_drep_cert :: Named Group
-reg_drep_cert = "reg_drep_cert" =:~ grp [16, a drep_credential, a coin, anchor / VNil]
+reg_drep_cert = "reg_drep_cert" =:~ grp [16, a drep_credential, a coin, a (anchor / VNil)]
 
 unreg_drep_cert :: Named Group
 unreg_drep_cert = "unreg_drep_cert" =:~ grp [17, a drep_credential, a coin]
 
 update_drep_cert :: Named Group
-update_drep_cert = "update_drep_cert" =:~ grp [18, a drep_credential, anchor / VNil]
+update_drep_cert = "update_drep_cert" =:~ grp [18, a drep_credential, a (anchor / VNil)]
 
 delta_coin :: Rule
 delta_coin = "delta_coin" =:= VUInt
@@ -429,17 +429,17 @@ single_host_addr =
   "single_host_addr"
     =:~ grp
       [ 0,
-        port / VNil,
-        ipv4 / VNil,
-        ipv6 / VNil
+        a (port / VNil),
+        a (ipv4 / VNil),
+        a (ipv6 / VNil)
       ]
 
 single_host_name :: Named Group
 single_host_name =
   "single_host_name"
     =:~ grp
       [ 1,
-        port / VNil,
+        a (port / VNil),
         a dns_name -- An A or AAAA DNS record
       ]
 

src/Codec/CBOR/Cuddle/Huddle.hs

@@ -254,11 +254,11 @@ instance IsList ArrayChoice where
 
 type Array = Choice ArrayChoice
 
-newtype Group = Group {unGroup :: [Type0]}
+newtype Group = Group {unGroup :: [ArrayEntry]}
   deriving (Show, Monoid, Semigroup)
 
 instance IsList Group where
-  type Item Group = Type0
+  type Item Group = ArrayEntry
 
   fromList = Group
   toList (Group l) = l
@@ -991,7 +991,7 @@ collectFrom topRs =
     goMapEntry (MapEntry k t0 _ _) = goKey k >> goT0 t0
     goKey (TypeKey k) = goT2 k
     goKey _ = pure ()
-    goGroup (Group g) = mapM_ goT0 g
+    goGroup (Group g) = mapM_ goArrayEntry g
     goRanged (Unranged _) = pure ()
     goRanged (Ranged lb ub _) = goRangeBound lb >> goRangeBound ub 
     goRangeBound (RangeBoundLiteral _) = pure ()
@@ -1148,7 +1148,7 @@ toCDDL' mkPseudoRoot hdl =
             . C.GEGroup Nothing
             . C.Group
             . (NE.:| [])
-            $ fmap (C.noComment . C.GEType Nothing Nothing . toCDDLType0) t0s
+            $ fmap arrayEntryToCDDL t0s
         )
         (fmap C.Comment c)
 

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

@@ -20,6 +20,7 @@ huddleSpec = describe "huddle" $ do
   basicAssign
   arraySpec
   mapSpec
+  grpSpec
   nestedSpec
   genericSpec
   constraintSpec
@@ -85,6 +86,21 @@ mapSpec = describe "Maps" $ do
     toSortedCDDL ["mir" =:= arr [a (int 0 / int 1), a $ mp [0 <+ "test" ==> VUInt]]]
       `shouldMatchParseCDDL` "mir = [ 0 / 1, { * test : uint }]"
 
+grpSpec :: Spec 
+grpSpec = describe "Groups" $ do 
+  it "Can handle a choice in a group entry" $ 
+    let g1 = "g1" =:~ grp [a (VUInt / VBytes), a VUInt]
+    in toSortedCDDL (collectFrom ["a1" =:= arr [a g1]])
+      `shouldMatchParseCDDL` "a1 = [g1]\n g1 = ( uint / bytes, uint )"
+  it "Can handle keys in a group entry" $ 
+    let g1 = "g1" =:~ grp ["bytes"==> VBytes]
+    in toSortedCDDL (collectFrom ["a1" =:= arr [a g1]])
+      `shouldMatchParseCDDL` "a1 = [g1]\n g1 = (bytes : bytes)"
+  -- it "Can handle a group in a map" $ 
+  --   let g1 = "g1" =:~ grp ["bytes"==> VBytes]
+  --   in toSortedCDDL (collectFrom ["a1" =:= mp [g1]])
+  --     `shouldMatchParseCDDL` "a1 = [g1]\n g1 = (bytes : bytes)"
+
 nestedSpec :: Spec
 nestedSpec =
   describe "Nesting" $