WIP

Author: Soupstraw

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

@@ -24,6 +24,13 @@ import Codec.CBOR.Cuddle.CDDL (
   OccurrenceIndicator (..),
   Value (..),
   ValueVariant (..),
+  WrappedTerm,
+  flattenWrappedList,
+  pairTermList,
+  singleTermList,
+  pattern G,
+  pattern P,
+  pattern S,
  )
 import Codec.CBOR.Cuddle.CDDL.CTree (CTree, CTreeRoot' (..))
 import Codec.CBOR.Cuddle.CDDL.CTree qualified as CTree
@@ -207,48 +214,6 @@ genPostlude pt = case pt of
   PTNil -> pure TNull
   PTUndefined -> pure $ TSimple 23
 
---------------------------------------------------------------------------------
--- Kinds of terms
---------------------------------------------------------------------------------
-
-data WrappedTerm
-  = SingleTerm Term
-  | PairTerm Term Term
-  | GroupTerm [WrappedTerm]
-  deriving (Eq, Show)
-
--- | Recursively flatten wrapped list. That is, expand any groups out to their
--- individual entries.
-flattenWrappedList :: [WrappedTerm] -> [WrappedTerm]
-flattenWrappedList [] = []
-flattenWrappedList (GroupTerm xxs : xs) =
-  flattenWrappedList xxs <> flattenWrappedList xs
-flattenWrappedList (y : xs) = y : flattenWrappedList xs
-
-pattern S :: Term -> WrappedTerm
-pattern S t = SingleTerm t
-
--- | Convert a list of wrapped terms to a list of terms. If any 'PairTerm's are
--- present, we just take their "value" part.
-singleTermList :: [WrappedTerm] -> Maybe [Term]
-singleTermList [] = Just []
-singleTermList (S x : xs) = (x :) <$> singleTermList xs
-singleTermList (P _ y : xs) = (y :) <$> singleTermList xs
-singleTermList _ = Nothing
-
-pattern P :: Term -> Term -> WrappedTerm
-pattern P t1 t2 = PairTerm t1 t2
-
--- | Convert a list of wrapped terms to a list of pairs of terms, or fail if any
--- 'SingleTerm's are present.
-pairTermList :: [WrappedTerm] -> Maybe [(Term, Term)]
-pairTermList [] = Just []
-pairTermList (P x y : xs) = ((x, y) :) <$> pairTermList xs
-pairTermList _ = Nothing
-
-pattern G :: [WrappedTerm] -> WrappedTerm
-pattern G xs = GroupTerm xs
-
 --------------------------------------------------------------------------------
 -- Generator functions
 --------------------------------------------------------------------------------

src/Codec/CBOR/Cuddle/CDDL.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -37,10 +38,19 @@ module Codec.CBOR.Cuddle.CDDL (
   GrpChoice (..),
   unwrap,
   compareRuleName,
+  flattenWrappedList,
+  singleTermList,
+  pairTermList,
+  CBORGenerator (..),
+  WrappedTerm (..),
+  pattern G,
+  pattern P,
+  pattern S,
 ) where
 
 import Codec.CBOR.Cuddle.CDDL.CtlOp (CtlOp)
 import Codec.CBOR.Cuddle.Comments (CollectComments (..), Comment, HasComment (..))
+import Codec.CBOR.Term (Term)
 import Data.ByteString qualified as B
 import Data.Default.Class (Default (..))
 import Data.Function (on, (&))
@@ -55,6 +65,52 @@ import GHC.Generics (Generic)
 import Optics.Core ((%), (.~))
 import Optics.Getter (view)
 import Optics.Lens (lens)
+import System.Random.Stateful (StatefulGen)
+
+--------------------------------------------------------------------------------
+-- Kinds of terms
+--------------------------------------------------------------------------------
+
+data WrappedTerm
+  = SingleTerm Term
+  | PairTerm Term Term
+  | GroupTerm [WrappedTerm]
+  deriving (Eq, Show)
+
+-- | Recursively flatten wrapped list. That is, expand any groups out to their
+-- individual entries.
+flattenWrappedList :: [WrappedTerm] -> [WrappedTerm]
+flattenWrappedList [] = []
+flattenWrappedList (GroupTerm xxs : xs) =
+  flattenWrappedList xxs <> flattenWrappedList xs
+flattenWrappedList (y : xs) = y : flattenWrappedList xs
+
+pattern S :: Term -> WrappedTerm
+pattern S t = SingleTerm t
+
+-- | Convert a list of wrapped terms to a list of terms. If any 'PairTerm's are
+-- present, we just take their "value" part.
+singleTermList :: [WrappedTerm] -> Maybe [Term]
+singleTermList [] = Just []
+singleTermList (S x : xs) = (x :) <$> singleTermList xs
+singleTermList (P _ y : xs) = (y :) <$> singleTermList xs
+singleTermList _ = Nothing
+
+pattern P :: Term -> Term -> WrappedTerm
+pattern P t1 t2 = PairTerm t1 t2
+
+-- | Convert a list of wrapped terms to a list of pairs of terms, or fail if any
+-- 'SingleTerm's are present.
+pairTermList :: [WrappedTerm] -> Maybe [(Term, Term)]
+pairTermList [] = Just []
+pairTermList (P x y : xs) = ((x, y) :) <$> pairTermList xs
+pairTermList _ = Nothing
+
+pattern G :: [WrappedTerm] -> WrappedTerm
+pattern G xs = GroupTerm xs
+
+newtype CBORGenerator
+  = CBORGenerator (forall g m. StatefulGen g m => g -> m WrappedTerm)
 
 -- | The CDDL constructor takes three arguments:
 --     1. Top level comments that precede the first definition