CBOR Generators

cuddle.cabal

@@ -1,16 +1,19 @@
-cabal-version:      3.4
-name:               cuddle
-version:            0.1.0.0
-synopsis:           CDDL Generator and test utilities
+cabal-version:   3.4
+name:            cuddle
+version:         0.1.0.0
+synopsis:        CDDL Generator and test utilities
+
 -- description:
-license:            Apache-2.0
-license-file:       LICENSE
-author:             IOG Ledger Team
-maintainer:         nicholas.clarke@iohk.io
+license:         Apache-2.0
+license-file:    LICENSE
+author:          IOG Ledger Team
+maintainer:      nicholas.clarke@iohk.io
+
 -- copyright:
-category:           Codec
-build-type:         Simple
-extra-doc-files:    CHANGELOG.md
+category:        Codec
+build-type:      Simple
+extra-doc-files: CHANGELOG.md
+
 -- extra-source-files:
 
 common warnings
@@ -20,50 +23,68 @@ library
     import:           warnings
     exposed-modules:
         Codec.CBOR.Cuddle.Builder
+        Codec.CBOR.Cuddle.CBOR.Gen
         Codec.CBOR.Cuddle.CDDL
         Codec.CBOR.Cuddle.CDDL.CtlOp
+        Codec.CBOR.Cuddle.CDDL.CTree
+        Codec.CBOR.Cuddle.CDDL.Postlude
+        Codec.CBOR.Cuddle.CDDL.Resolve
         Codec.CBOR.Cuddle.Parser
         Codec.CBOR.Cuddle.Pretty
+
     other-modules:
+
     -- other-extensions:
     build-depends:
-        base ^>=4.16.3.0,
-        bytestring,
-        cborg,
-        megaparsec,
-        parser-combinators,
-        prettyprinter,
-        text
+        , base                ^>=4.16.3.0 || ^>=4.18.1.0
+        , bytestring
+        , capability
+        , cborg
+        , containers
+        , generic-optics
+        , hashable
+        , megaparsec
+        , mtl
+        , mutable-containers
+        , optics-core
+        , parser-combinators
+        , prettyprinter
+        , random
+        , text
+
     hs-source-dirs:   src
     default-language: GHC2021
 
 executable example
     import:           warnings
     default-language: GHC2021
+
     -- other-modules:
     -- other-extensions:
     hs-source-dirs:   example
     main-is:          Main.hs
     build-depends:
-        base ^>=4.16.3.0,
-        cuddle,
-        megaparsec,
-        prettyprinter,
-        text
+        , base           ^>=4.16.3.0 || ^>=4.18.1.0
+        , cuddle
+        , megaparsec
+        , prettyprinter
+        , random
+        , text
 
 test-suite cuddle-test
     import:           warnings
     default-language: GHC2021
+
     -- other-modules:
     -- other-extensions:
     type:             exitcode-stdio-1.0
     hs-source-dirs:   test
     main-is:          Main.hs
     build-depends:
-        base ^>=4.16.3.0,
-        cuddle,
-        hspec,
-        hspec-megaparsec,
-        megaparsec,
-        prettyprinter,
-        text
+        , base              ^>=4.16.3.0 || ^>=4.18.1.0
+        , cuddle
+        , hspec
+        , hspec-megaparsec
+        , megaparsec
+        , prettyprinter
+        , text

example/Main.hs

@@ -3,13 +3,17 @@
 
 module Main (main) where
 
+import Codec.CBOR.Cuddle.CBOR.Gen (generateCBORTerm)
+import Codec.CBOR.Cuddle.CDDL (Name (..))
+import Codec.CBOR.Cuddle.CDDL.Resolve (asMap, buildMonoCTree, buildRefCTree, buildResolvedCTree)
 import Codec.CBOR.Cuddle.Parser (pCDDL)
 import Codec.CBOR.Cuddle.Pretty ()
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
 import Prettyprinter (Pretty (pretty))
 import Prettyprinter.Util (putDocW)
 import System.Environment (getArgs)
+import System.Random (getStdGen)
 import Text.Megaparsec (ParseErrorBundle, Parsec, errorBundlePretty, runParser)
 
 main :: IO ()
@@ -22,6 +26,35 @@ main = do
         Right res -> do
           print res
           putDocW 80 $ pretty res
+          putStrLn "\n"
+          putStrLn "--------------------------------------------------------------------------------"
+          putStrLn " As a CTree"
+          putStrLn "--------------------------------------------------------------------------------"
+          let refCTree = buildRefCTree (asMap res)
+          print refCTree
+          putStrLn "--------------------------------------------------------------------------------"
+          putStrLn " After name resolution"
+          putStrLn "--------------------------------------------------------------------------------"
+          let resolvedCTree = buildResolvedCTree refCTree
+          print resolvedCTree
+          putStrLn "--------------------------------------------------------------------------------"
+          putStrLn " After monomorphisation"
+          putStrLn "--------------------------------------------------------------------------------"
+          let monoCTree = buildMonoCTree <$> resolvedCTree
+          print monoCTree
+    [fn, name] -> do
+      putStrLn "--------------------------------------------------------------------------------"
+      putStrLn " Generating a term"
+      putStrLn "--------------------------------------------------------------------------------"
+      parseFromFile pCDDL fn >>= \case
+        Left err -> putStrLn $ errorBundlePretty err
+        Right res -> do
+          stdGen <- getStdGen
+          case buildMonoCTree =<< buildResolvedCTree (buildRefCTree (asMap res)) of
+            Left nre -> error $ show nre
+            Right mt ->
+              let term = generateCBORTerm mt (Name $ T.pack name) stdGen
+               in print term
     _ -> putStrLn "Expected filename"
 
 parseFromFile ::

example/cddl-files/basic_assign.cddl

@@ -7,3 +7,9 @@ header =
   , test : coin / null
   , withComment : null ; This is a comment
   ]
+
+header_body = [
+  issuer : text
+]
+
+$kes_signature = bytes .size 32

example/cddl-files/shelley.cddl

@@ -256,3 +256,33 @@ metadata_hash         = $hash32
 scripthash            = $hash28
 
 $nonce /= [ 0 // 1, bytes .size 32 ]
+
+$hash28 /= bytes .size 28
+$hash32 /= bytes .size 32
+
+$vkey /= bytes .size 32
+
+$vrf_vkey /= bytes .size 32
+$vrf_cert /= [bytes, bytes .size 80]
+
+$kes_vkey /= bytes .size 32
+$kes_signature /= bytes .size 448
+signkeyKES = bytes .size 64
+
+$signature /= bytes .size 64
+
+finite_set<a> = [* a]
+
+;unit_interval = #6.30([uint, uint])
+unit_interval = #6.30([1, 2])
+  ; real unit_interval is: #6.30([uint, uint])
+  ; but this produces numbers outside the unit interval
+  ; and can also produce a zero in the denominator
+
+rational = #6.30([uint, uint])
+
+set<a> = [* a]
+
+address = bytes
+
+reward_account = bytes

flake.nix

@@ -32,6 +32,7 @@
                       ormolu
                       pkgs.haskell.compiler.${ghcver}
                       cabal-install
+                      cabal-fmt
                     ];
 
                   enterShell = ''