Simplify usage of random, by removing fakeSeed

Author: lehins

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

@@ -6,6 +6,8 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -70,10 +72,8 @@ import System.Random.Stateful (
 --------------------------------------------------------------------------------
 
 -- | 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)
 
@@ -88,34 +88,28 @@ data GenState g = GenState
   }
   deriving (Generic)
 
-newtype M g a = M {runM :: StateT (GenState g) (Reader (GenEnv g)) a}
+newtype M g a = M {runM :: StateT (GenState g) (Reader GenEnv) a}
   deriving (Functor, Applicative, Monad)
   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)
     )
     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)))))
+          (Lift (StateT (GenState g) (MonadReader (Reader GenEnv))))
 
 -- | Opaque type carrying the type of a pure PRNG inside a capability-style
 -- state monad.
@@ -143,21 +137,18 @@ instance RandomGen r => RandomGenM (CapGenM r) r (M r) where
   applyRandomGenM f _ = state @"randomSeed" f
 #endif
 
-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 (CapGenM @g)
 
 -- | Generate a random number in a given range, biased increasingly towards the
 -- lower end as the depth parameter increases.
@@ -167,9 +158,8 @@ genDepthBiasedRM ::
   (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.
@@ -179,10 +169,10 @@ genDepthBiasedBool = do
   and <$> replicateM d genRandomM
 
 genRandomM :: forall g a. (Random a, RandomGen g) => M g a
-genRandomM = asksM @"fakeSeed" randomM
+genRandomM = randomM (CapGenM @g)
 
 genBytes :: forall g. RandomGen g => Int -> M g ByteString
-genBytes n = asksM @"fakeSeed" $ uniformByteStringM n
+genBytes n = uniformByteStringM n (CapGenM @g)
 
 genText :: forall g. RandomGen g => Int -> M g Text
 genText n = pure $ T.pack . take n . join $ repeat ['a' .. 'z']
@@ -460,12 +450,12 @@ genValueVariant (VBool b) = pure $ TBool b
 
 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