cuddle 0.5.0.0 → 1.0.0.0

raw patch · 3 files changed

+128/−114 lines, 3 filesdep ~HUnitdep ~QuickCheckdep ~basenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: HUnit, QuickCheck, base, base16-bytestring, boxes, bytestring, capability, cborg, containers, data-default-class, foldable1-classes-compat, generic-optics, hashable, hspec, hspec-megaparsec, megaparsec, mtl, mutable-containers, optics-core, optparse-applicative, ordered-containers, parser-combinators, prettyprinter, random, regex-tdfa, scientific, string-qq, text, tree-diff

API changes (from Hackage documentation)

Files

• CHANGELOG.md +47/−39
• cuddle.cabal +31/−31
• src/Codec/CBOR/Cuddle/CBOR/Gen.hs +50/−44

@@ -1,62 +1,70 @@-# Revision history for cuddle+# Changelog for `cuddle` -## 0.1.0.0 -- YYYY-mm-dd+## 1.0.0.0 -* First version. Released on an unsuspecting world.+* First official release to Hackage+* Added one more parameter to `BindingEnv` -## 0.3.0.0 --2024-07-25+## 0.5.0.0 -* Rationalise the choice operators. Drop (//) and provide detailed comments-  explaining the use of (/).+* Implement a validator for CBOR terms. -## 0.3.0.1 -- 2024-07-31+## 0.4.0.0 -* Improvements in the pretty printer - various groups should be formatted more-  cleanly+* Rewrote the prettyprinter to make the output more human-readable.+* Added `collectFromInit` to make it possible to specify the order of+  definitions manually. `collectFrom` and `collectFromInit` now expect+  `HuddleItem`s in their arguments+* More Huddle terms now accept comments (e.g. `ArrayEntry`, `ArrayChoice`)+* Parser now preserves most comments. -## 0.3.1.0 -- 2024-08-15+## 0.3.6.0 -* `collectFrom` now adds a first definition in the generated Huddle referencing-  the top level elements, to be compatible with the CDDL spec.+* 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. -## 0.3.2.0 -- 2024-09-11+  Note that it is not yet supported to use a group inside a map, where the+  issue of merging keys arises. -* Leading rather than trailing commas in the pretty printer.+## O.3.5.0 -## 0.3.3.0 -- 2024-11-13+* Add support for constraints on references and generic references.+* Add support for using references as range bounds. Note that this breaks+  backwards compatibility - because the range arguments are now more generic,+  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.3.0+ * Introduce HuddleM, another way to define a Huddle spec. This allows total   control over the order that items are presented in the CDDL, at the cost   of making it somewhat harder to re-use items (they need to be returned from   the monad). -## O.3.5.0 -- 2024-11-25+## 0.3.2.0 -* Add support for constraints on references and generic references.-* Add support for using references as range bounds. Note that this breaks-  backwards compatibility - because the range arguments are now more generic,-  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`+* Leading rather than trailing commas in the pretty printer. -## 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.+## 0.3.1.0 -  Note that it is not yet supported to use a group inside a map, where the-  issue of merging keys arises.+* `collectFrom` now adds a first definition in the generated Huddle referencing+  the top level elements, to be compatible with the CDDL spec. -## 0.4.0.0 -- 2025-05-02-* Rewrote the prettyprinter to make the output more human-readable.-* Added `collectFromInit` to make it possible to specify the order of-  definitions manually. `collectFrom` and `collectFromInit` now expect-  `HuddleItem`s in their arguments-* More Huddle terms now accept comments (e.g. `ArrayEntry`, `ArrayChoice`)-* Parser now preserves most comments.+## 0.3.0.1 -## 0.5.0.0 -- 2025-06-03+* Improvements in the pretty printer - various groups should be formatted more+  cleanly -* Implement a validator for CBOR terms.+## 0.3.0.0++* Rationalise the choice operators. Drop (//) and provide detailed comments+  explaining the use of (/).++## 0.1.0.0++* First version. Released on an unsuspecting world.+

@@ -1,6 +1,6 @@ cabal-version: 3.4 name: cuddle-version: 0.5.0.0+version: 1.0.0.0 synopsis: CDDL Generator and test utilities description:   Cuddle is a library for generating and manipulating [CDDL](https://datatracker.ietf.org/doc/html/rfc8610).@@ -16,7 +16,7 @@ license: Apache-2.0 license-file: LICENSE author: IOG Ledger Team-maintainer: nicholas.clarke@iohk.io, hackage@iohk.io+maintainer: hackage@iohk.io copyright: 2025 Input Output Global Inc (IOG) category: Codec build-type: Simple@@ -63,29 +63,29 @@     Codec.CBOR.Cuddle.Pretty.Utils    build-depends:-    base >=4.18 && <4.22,-    base16-bytestring ^>=1.0.2,-    boxes ^>=0.1.5,-    bytestring >=0.11.4 && <0.13,-    capability ^>=0.5,-    cborg ^>=0.2.10,-    containers >=0.6.7 && <0.8,-    data-default-class ^>=0.2,-    foldable1-classes-compat ^>=0.1.1,-    generic-optics ^>=2.2.1,-    hashable ^>=1.5,-    megaparsec ^>=9.7,-    mtl ^>=2.3.1,-    mutable-containers ^>=0.3.4,-    optics-core ^>=0.4.1,-    ordered-containers ^>=0.2.4,-    parser-combinators ^>=1.3,-    prettyprinter ^>=1.7.1,-    random <1.3,-    regex-tdfa ^>=1.3.2,-    scientific ^>=0.3.8,-    text >=2.0.2 && <2.2,-    tree-diff ^>=0.3.4,+    base >=4.18 && <5,+    base16-bytestring >=1.0.2,+    boxes >=0.1.5,+    bytestring >=0.11.4,+    capability >=0.5,+    cborg >=0.2.10,+    containers >=0.6.7,+    data-default-class >=0.2,+    foldable1-classes-compat >=0.1.1,+    generic-optics >=2.2.1,+    hashable >=1.4,+    megaparsec >=9.5,+    mtl >=2.3.1,+    mutable-containers >=0.3.4,+    optics-core >=0.4.1,+    ordered-containers >=0.2.4,+    parser-combinators >=1.3,+    prettyprinter >=1.7.1,+    random >=1.2,+    regex-tdfa >=1.3.2,+    scientific >=0.3.7,+    text >=2.0.2,+    tree-diff >=0.3,    hs-source-dirs: src   default-language: GHC2021@@ -126,7 +126,7 @@     cuddle,     megaparsec,     mtl,-    optparse-applicative ^>=0.19,+    optparse-applicative >=0.18,     prettyprinter,     random,     text,@@ -145,16 +145,16 @@   hs-source-dirs: test   main-is: Main.hs   build-depends:-    HUnit ^>=1.6.2,-    QuickCheck ^>=2.15,+    HUnit >=1.6.2,+    QuickCheck >=2.14,     base,     bytestring,     cuddle,     data-default-class,-    hspec ^>=2.11,-    hspec-megaparsec ^>=2.2,+    hspec >=2.11,+    hspec-megaparsec >=2.2,     megaparsec,     prettyprinter,-    string-qq ^>=0.0.6,+    string-qq >=0.0.6,     text,     tree-diff,

@@ -1,19 +1,24 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} +#if MIN_VERSION_random(1,3,0)+{-# OPTIONS_GHC -Wno-deprecations #-} -- Due to usage of `split`+#endif -- | Generate example CBOR given a CDDL specification module Codec.CBOR.Cuddle.CBOR.Gen (generateCBORTerm, generateCBORTerm') where  import Capability.Reader import Capability.Sink (HasSink) import Capability.Source (HasSource, MonadState (..))-import Capability.State (HasState, get, modify, state)+import Capability.State (HasState, get, modify) import Codec.CBOR.Cuddle.CDDL (   Name (..),   OccurrenceIndicator (..),@@ -31,6 +36,7 @@ import Control.Monad (join, replicateM, (<=<)) import Control.Monad.Reader (Reader, runReader) import Control.Monad.State.Strict (StateT, runStateT)+import Control.Monad.State.Strict qualified as MTL import Data.Bifunctor (second) import Data.ByteString (ByteString) import Data.ByteString.Base16 qualified as Base16@@ -45,24 +51,25 @@ import GHC.Generics (Generic) import System.Random.Stateful (   Random,-  RandomGen (genShortByteString, genWord32, genWord64),-  RandomGenM,-  StatefulGen (..),+  RandomGen (..),+  StateGenM (..),   UniformRange (uniformRM),-  applyRandomGenM,   randomM,   uniformByteStringM,  )+#if MIN_VERSION_random(1,3,0)+import System.Random.Stateful (+  SplitGen (..)+  )+#endif  -------------------------------------------------------------------------------- -- Generator infrastructure --------------------------------------------------------------------------------  -- | Generator context, parametrised over the type of the random seed-data GenEnv g = GenEnv+newtype GenEnv = GenEnv   { cddl :: CTreeRoot' Identity MonoRef-  , fakeSeed :: CapGenM g-  -- ^ Access the "fake" seed, necessary to recursively call generators   }   deriving (Generic) @@ -77,20 +84,42 @@   }   deriving (Generic) -newtype M g a = M {runM :: StateT (GenState g) (Reader (GenEnv g)) a}-  deriving (Functor, Applicative, Monad)+instance RandomGen g => RandomGen (GenState g) where+  genWord8 = withRandomSeed genWord8+  genWord16 = withRandomSeed genWord16+  genWord32 = withRandomSeed genWord32+  genWord64 = withRandomSeed genWord64+  split = splitGenStateWith split++#if MIN_VERSION_random(1,3,0)+instance SplitGen g => SplitGen (GenState g) where+  splitGen = splitGenStateWith splitGen+#endif++splitGenStateWith :: (g -> (g, g)) -> GenState g -> (GenState g, GenState g)+splitGenStateWith f s =+  case f (randomSeed s) of+    (gen', gen) -> (s {randomSeed = gen'}, s {randomSeed = gen})++withRandomSeed :: (t -> (a, g)) -> GenState t -> (a, GenState g)+withRandomSeed f s =+  case f (randomSeed s) of+    (r, gen) -> (r, s {randomSeed = gen})++newtype M g a = M {runM :: StateT (GenState g) (Reader GenEnv) a}+  deriving (Functor, Applicative, Monad, MTL.MonadState (GenState g))   deriving     (HasSource "randomSeed" g, HasSink "randomSeed" g, HasState "randomSeed" g)     via Field           "randomSeed"           ()-          (MonadState (StateT (GenState g) (Reader (GenEnv g))))+          (MonadState (StateT (GenState g) (Reader GenEnv)))   deriving     (HasSource "depth" Int, HasSink "depth" Int, HasState "depth" Int)     via Field           "depth"           ()-          (MonadState (StateT (GenState g) (Reader (GenEnv g))))+          (MonadState (StateT (GenState g) (Reader GenEnv)))   deriving     ( HasSource "cddl" (CTreeRoot' Identity MonoRef)     , HasReader "cddl" (CTreeRoot' Identity MonoRef)@@ -98,42 +127,20 @@     via Field           "cddl"           ()-          (Lift (StateT (GenState g) (MonadReader (Reader (GenEnv g)))))-  deriving-    (HasSource "fakeSeed" (CapGenM g), HasReader "fakeSeed" (CapGenM g))-    via Field-          "fakeSeed"-          ()-          (Lift (StateT (GenState g) (MonadReader (Reader (GenEnv g)))))---- | Opaque type carrying the type of a pure PRNG inside a capability-style--- state monad.-data CapGenM g = CapGenM--instance RandomGen g => StatefulGen (CapGenM g) (M g) where-  uniformWord64 _ = state @"randomSeed" genWord64-  uniformWord32 _ = state @"randomSeed" genWord32--  uniformShortByteString n _ = state @"randomSeed" (genShortByteString n)--instance RandomGen r => RandomGenM (CapGenM r) r (M r) where-  applyRandomGenM f _ = state @"randomSeed" f+          (Lift (StateT (GenState g) (MonadReader (Reader GenEnv)))) -runGen :: M g a -> GenEnv g -> GenState g -> (a, GenState g)+runGen :: M g a -> GenEnv -> GenState g -> (a, GenState g) runGen m env st = runReader (runStateT (runM m) st) env -evalGen :: M g a -> GenEnv g -> GenState g -> a+evalGen :: M g a -> GenEnv -> GenState g -> a evalGen m env = fst . runGen m env -asksM :: forall tag r m a. HasReader tag r m => (r -> m a) -> m a-asksM f = f =<< ask @tag- -------------------------------------------------------------------------------- -- Wrappers around some Random function in Gen --------------------------------------------------------------------------------  genUniformRM :: forall a g. (UniformRange a, RandomGen g) => (a, a) -> M g a-genUniformRM = asksM @"fakeSeed" . uniformRM+genUniformRM r = uniformRM r (StateGenM @(GenState g))  -- | Generate a random number in a given range, biased increasingly towards the -- lower end as the depth parameter increases.@@ -143,9 +150,8 @@   (a, a) ->   M g a genDepthBiasedRM bounds = do-  fs <- ask @"fakeSeed"   d <- get @"depth"-  samples <- replicateM d (uniformRM bounds fs)+  samples <- replicateM d (genUniformRM bounds)   pure $ minimum samples  -- | Generates a bool, increasingly likely to be 'False' as the depth increases.@@ -155,10 +161,10 @@   and <$> replicateM d genRandomM  genRandomM :: forall g a. (Random a, RandomGen g) => M g a-genRandomM = asksM @"fakeSeed" randomM+genRandomM = randomM (StateGenM @(GenState g))  genBytes :: forall g. RandomGen g => Int -> M g ByteString-genBytes n = asksM @"fakeSeed" $ uniformByteStringM n+genBytes n = uniformByteStringM n (StateGenM @(GenState g))  genText :: forall g. RandomGen g => Int -> M g Text genText n = pure $ T.pack . take n . join $ repeat ['a' .. 'z']@@ -436,12 +442,12 @@  generateCBORTerm :: RandomGen g => CTreeRoot' Identity MonoRef -> Name -> g -> Term generateCBORTerm cddl n stdGen =-  let genEnv = GenEnv {cddl, fakeSeed = CapGenM}+  let genEnv = GenEnv {cddl}       genState = GenState {randomSeed = stdGen, depth = 1}    in evalGen (genForName n) genEnv genState  generateCBORTerm' :: RandomGen g => CTreeRoot' Identity MonoRef -> Name -> g -> (Term, g) generateCBORTerm' cddl n stdGen =-  let genEnv = GenEnv {cddl, fakeSeed = CapGenM}+  let genEnv = GenEnv {cddl}       genState = GenState {randomSeed = stdGen, depth = 1}    in second randomSeed $ runGen (genForName n) genEnv genState