Add generator overriding

.github/workflows/ci.yml

@@ -72,7 +72,7 @@ jobs:
 
     - name: Install fourmolu
       run: |
-        FOURMOLU_VERSION="0.18.0.0"
+        FOURMOLU_VERSION="0.15.0.0"
         mkdir -p "$HOME/.local/bin"
         curl -sL "https://github.com/fourmolu/fourmolu/releases/download/v${FOURMOLU_VERSION}/fourmolu-${FOURMOLU_VERSION}-linux-x86_64" -o "$HOME/.local/bin/fourmolu"
         chmod a+x "$HOME/.local/bin/fourmolu"

cabal.project

@@ -2,3 +2,4 @@ packages:
   .
 
 test-show-details: streaming
+tests: True

nickel.lock.ncl

@@ -1,3 +1,3 @@
 {
-  organist = import "/nix/store/7zrf2b1ysrgrx7613qlmbz71cfyxgyfb-source/lib/organist.ncl",
+  organist = import "/nix/store/fjxrgrx0s69m5vkss5ff1i5akjcx39ss-source/lib/organist.ncl",
 }

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

@@ -20,12 +20,23 @@ import Capability.Sink (HasSink)
 import Capability.Source (HasSource, MonadState (..))
 import Capability.State (HasState, get, modify)
 import Codec.CBOR.Cuddle.CDDL (
+  CBORGenerator (..),
   Name (..),
   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 (CTree, CTreeRoot' (..))
 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 (..))
@@ -53,6 +64,7 @@ import System.Random.Stateful (
   Random,
   RandomGen (..),
   StateGenM (..),
+  StatefulGen (..),
   UniformRange (uniformRM),
   randomM,
   uniformByteStringM,
@@ -207,53 +219,11 @@ 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
 --------------------------------------------------------------------------------
 
-genForCTree :: RandomGen g => CTree MonoRef -> M g WrappedTerm
+genForCTree :: forall g. RandomGen g => CTree MonoRef -> M g WrappedTerm
 genForCTree (CTree.Literal v) = S <$> genValue v
 genForCTree (CTree.Postlude pt) = S <$> genPostlude pt
 genForCTree (CTree.Map nodes) = do
@@ -362,6 +332,7 @@ genForCTree (CTree.Tag tag node) = do
   case enc of
     S x -> pure $ S $ TTagged tag x
     _ -> error "Tag controller does not correspond to a single term"
+genForCTree (CTree.WithGen (CBORGenerator gen) _) = gen StateGenM
 
 genForNode :: RandomGen g => CTree.Node MonoRef -> M g WrappedTerm
 genForNode = genForCTree <=< resolveIfRef
@@ -446,7 +417,8 @@ generateCBORTerm cddl n stdGen =
       genState = GenState {randomSeed = stdGen, depth = 1}
    in evalGen (genForName n) genEnv genState
 
-generateCBORTerm' :: RandomGen g => CTreeRoot' Identity MonoRef -> Name -> g -> (Term, g)
+generateCBORTerm' ::
+  (RandomGen g, StatefulGen g (M g)) => CTreeRoot' Identity MonoRef -> Name -> g -> (Term, g)
 generateCBORTerm' cddl n stdGen =
   let genEnv = GenEnv {cddl}
       genState = GenState {randomSeed = stdGen, depth = 1}