Added extensions to CDDL AST

Author: Soupstraw

CHANGELOG.md

@@ -2,6 +2,12 @@
 
 ## 1.1.0.0
 
+* Change the order of fields in `GroupEntry`; the extension field is now the last field
+* Add `IndexMappable` to help with traversing `CDDL` trees
+* Add an index type parameter to all `CDDL` terms
+* Remove `Codec.CBOR.Cuddle.CDDL.Prelude`
+* Replace `cddlPrelude` with `cddlPostlude`, `prependPrelude` with `appendPostlude`
+* Move `PTerm` to `Codec.CBOR.Cuddle.CDDL.CTree`
 * Remove `CTreeRoot'`
 * Changed the type in `CTreeRoot` to a map of resolved `CTree`s
 * Changed the type of the first argument for `generateCBORTerm` and 

bin/Main.hs

@@ -4,13 +4,14 @@ module Main (main) where
 
 import Codec.CBOR.Cuddle.CBOR.Gen (generateCBORTerm)
 import Codec.CBOR.Cuddle.CBOR.Validator
-import Codec.CBOR.Cuddle.CDDL (Name (..), sortCDDL)
-import Codec.CBOR.Cuddle.CDDL.Prelude (prependPrelude)
+import Codec.CBOR.Cuddle.CDDL (Name (..), fromRules, sortCDDL)
+import Codec.CBOR.Cuddle.CDDL.Postlude (appendPostlude)
 import Codec.CBOR.Cuddle.CDDL.Resolve (
   fullResolveCDDL,
  )
+import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (..))
 import Codec.CBOR.Cuddle.Parser (pCDDL)
-import Codec.CBOR.Cuddle.Pretty ()
+import Codec.CBOR.Cuddle.Pretty (PrettyStage)
 import Codec.CBOR.FlatTerm (toFlatTerm)
 import Codec.CBOR.Pretty (prettyHexEnc)
 import Codec.CBOR.Term (encodeTerm)
@@ -185,26 +186,26 @@ run (Opts cmd cddlFile) = do
         Format fOpts ->
           let
             defs
-              | sort fOpts = sortCDDL res
+              | sort fOpts = fromRules $ sortCDDL res
               | otherwise = res
            in
-            putDocW 80 $ pretty defs
+            putDocW 80 . pretty $ mapIndex @_ @_ @PrettyStage defs
         Validate vOpts ->
           let
             res'
               | vNoPrelude vOpts = res
-              | otherwise = prependPrelude res
+              | otherwise = appendPostlude res
            in
-            case fullResolveCDDL res' of
+            case fullResolveCDDL $ mapIndex res' of
               Left err -> putStrLnErr (show err) >> exitFailure
               Right _ -> exitSuccess
         (GenerateCBOR gOpts) ->
           let
             res'
               | gNoPrelude gOpts = res
-              | otherwise = prependPrelude res
+              | otherwise = appendPostlude res
            in
-            case fullResolveCDDL res' of
+            case fullResolveCDDL $ mapIndex res' of
               Left err -> putStrLnErr (show err) >> exitFailure
               Right mt -> do
                 stdGen <- getStdGen
@@ -220,9 +221,9 @@ run (Opts cmd cddlFile) = do
           let
             res'
               | vcNoPrelude vcOpts = res
-              | otherwise = prependPrelude res
+              | otherwise = res
            in
-            case fullResolveCDDL res' of
+            case fullResolveCDDL $ mapIndex res' of
               Left err -> putStrLnErr (show err) >> exitFailure
               Right mt -> do
                 cbor <- BSC.readFile (vcInput vcOpts)

cuddle.cabal

@@ -47,12 +47,12 @@ library
     Codec.CBOR.Cuddle.CDDL.CTree
     Codec.CBOR.Cuddle.CDDL.CtlOp
     Codec.CBOR.Cuddle.CDDL.Postlude
-    Codec.CBOR.Cuddle.CDDL.Prelude
     Codec.CBOR.Cuddle.CDDL.Resolve
     Codec.CBOR.Cuddle.Comments
     Codec.CBOR.Cuddle.Huddle
     Codec.CBOR.Cuddle.Huddle.HuddleM
     Codec.CBOR.Cuddle.Huddle.Optics
+    Codec.CBOR.Cuddle.IndexMappable
     Codec.CBOR.Cuddle.Parser
     Codec.CBOR.Cuddle.Parser.Lexer
     Codec.CBOR.Cuddle.Pretty
@@ -149,6 +149,7 @@ test-suite cuddle-test
     bytestring,
     cuddle,
     data-default-class,
+    generic-random,
     hspec >=2.11,
     hspec-megaparsec >=2.2,
     megaparsec,

src/Codec/CBOR/Cuddle/CBOR/Gen.hs

@@ -25,10 +25,9 @@ import Codec.CBOR.Cuddle.CDDL (
   Value (..),
   ValueVariant (..),
  )
-import Codec.CBOR.Cuddle.CDDL.CTree (CTree, CTreeRoot (..))
+import Codec.CBOR.Cuddle.CDDL.CTree (CTree, CTreePhase, CTreeRoot (..), PTerm (..))
 import Codec.CBOR.Cuddle.CDDL.CTree qualified as CTree
 import Codec.CBOR.Cuddle.CDDL.CtlOp qualified as CtlOp
-import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm (..))
 import Codec.CBOR.Cuddle.CDDL.Resolve (MonoRef (..), MonoReferenced)
 import Codec.CBOR.Term (Term (..))
 import Codec.CBOR.Term qualified as CBOR
@@ -380,7 +379,7 @@ resolveRef (MRuleRef n) = do
 -- This will throw an error if the generated item does not correspond to a
 -- single CBOR term (e.g. if the name resolves to a group, which cannot be
 -- generated outside a context).
-genForName :: RandomGen g => Name -> M g Term
+genForName :: RandomGen g => Name CTreePhase -> M g Term
 genForName n = do
   (CTreeRoot cddl) <- ask @"cddl"
   case Map.lookup n cddl of
@@ -434,13 +433,13 @@ genValueVariant (VBool b) = pure $ TBool b
 -- Generator functions
 --------------------------------------------------------------------------------
 
-generateCBORTerm :: RandomGen g => CTreeRoot MonoReferenced -> Name -> g -> Term
+generateCBORTerm :: RandomGen g => CTreeRoot MonoReferenced -> Name CTreePhase -> g -> Term
 generateCBORTerm cddl n stdGen =
   let genEnv = GenEnv {cddl}
       genState = GenState {randomSeed = stdGen, depth = 1}
    in evalGen (genForName n) genEnv genState
 
-generateCBORTerm' :: RandomGen g => CTreeRoot MonoReferenced -> Name -> g -> (Term, g)
+generateCBORTerm' :: RandomGen g => CTreeRoot MonoReferenced -> Name CTreePhase -> g -> (Term, g)
 generateCBORTerm' cddl n stdGen =
   let genEnv = GenEnv {cddl}
       genState = GenState {randomSeed = stdGen, depth = 1}

src/Codec/CBOR/Cuddle/CBOR/Validator.hs

@@ -10,7 +10,6 @@ module Codec.CBOR.Cuddle.CBOR.Validator (
 import Codec.CBOR.Cuddle.CDDL hiding (CDDL, Group, Rule)
 import Codec.CBOR.Cuddle.CDDL.CTree
 import Codec.CBOR.Cuddle.CDDL.CtlOp
-import Codec.CBOR.Cuddle.CDDL.Postlude
 import Codec.CBOR.Cuddle.CDDL.Resolve
 import Codec.CBOR.Read
 import Codec.CBOR.Term
@@ -113,7 +112,7 @@ data AMatchedItem = AMatchedItem
 --------------------------------------------------------------------------------
 -- Main entry point
 
-validateCBOR :: BS.ByteString -> Name -> CDDL -> IO ()
+validateCBOR :: BS.ByteString -> Name CTreePhase -> CDDL -> IO ()
 validateCBOR bs rule cddl =
   ( case validateCBOR' bs rule cddl of
       ok@(CBORTermResult _ (Valid _)) -> do
@@ -130,7 +129,7 @@ validateCBOR bs rule cddl =
             )
 
 validateCBOR' ::
-  BS.ByteString -> Name -> CDDL -> CBORTermResult
+  BS.ByteString -> Name CTreePhase -> CDDL -> CBORTermResult
 validateCBOR' bs rule cddl@(CTreeRoot tree) =
   case deserialiseFromBytes decodeTerm (BSL.fromStrict bs) of
     Left e -> error $ show e