fewer binds = faster code

Author: MaximilianAlgehed

src/Constrained/GenT.hs

@@ -28,6 +28,7 @@ module Constrained.GenT (
   tryGenT,
   chooseT,
   sizeT,
+  sizedT,
   withMode,
   frequencyT,
   oneofT,
@@ -388,7 +389,11 @@ chooseT (a, b)
 
 -- | Get the size provided to the generator
 sizeT :: Monad m => GenT m Int
-sizeT = GenT $ \mode msgs -> sized $ \n -> runGenT (pure n) mode msgs
+sizeT = sizedT pure
+
+-- | Get the size provided to the generator
+sizedT :: (Int -> GenT m a) -> GenT m a
+sizedT c = GenT $ \mode msgs -> sized $ \n -> runGenT (c n) mode msgs
 
 -- ==================================================================
 -- Reflective analysis of the internal GE structure of (GenT GE x)
@@ -397,27 +402,23 @@ sizeT = GenT $ \mode msgs -> sized $ \n -> runGenT (pure n) mode msgs
 
 -- | Always succeeds, but returns the internal GE structure for analysis
 inspect :: forall m x. MonadGenError m => GenT GE x -> GenT m (GE x)
-inspect (GenT f) = GenT g
-  where
-    g mode msgs = do geThing <- f mode msgs; pure @Gen (pure @m geThing)
+inspect (GenT f) = GenT (\ mode msgs -> pure <$> f mode msgs)
 
 -- | Ignore all kinds of Errors, by squashing them into Nothing
 tryGenT :: MonadGenError m => GenT GE a -> GenT m (Maybe a)
-tryGenT g = do
-  r <- inspect g
-  case r of
-    FatalError _ -> pure Nothing
-    GenError _ -> pure Nothing
-    Result a -> pure $ Just a
+tryGenT g = cont <$> inspect g
+  where cont r = case r of
+          FatalError _ -> Nothing
+          GenError _ -> Nothing
+          Result a -> Just a
 
 -- Pass on the error messages of both kinds of Errors, by squashing and combining both of them into Left constructor
 catchGenT :: MonadGenError m => GenT GE a -> GenT m (Either (NonEmpty (NonEmpty String)) a)
-catchGenT g = do
-  r <- inspect g
-  case r of
-    FatalError es -> pure $ Left es
-    GenError es -> pure $ Left es
-    Result a -> pure $ Right a
+catchGenT g = cont <$> inspect g
+  where cont r = case r of
+          FatalError es -> Left es
+          GenError es -> Left es
+          Result a -> Right a
 
 -- | Pass on the error messages of both kinds of Errors in the Gen (not the GenT) monad
 catchGen :: GenT GE a -> Gen (Either (NonEmpty (NonEmpty String)) a)

src/Constrained/NumOrd.hs

@@ -311,11 +311,11 @@ genFromNumSpec ::
   (MonadGenError m, Show n, Random n, Ord n, Num n, MaybeBounded n) =>
   NumSpec n ->
   GenT m n
-genFromNumSpec (NumSpecInterval ml mu) = do
-  n <- sizeT
-  case constrainInterval (ml <|> lowerBound) (mu <|> upperBound) (fromIntegral n) of
-    Just interval -> pureGen $ choose interval
-    Nothing -> genError $ "bad interval: " ++ show ml ++ " " ++ show mu
+genFromNumSpec (NumSpecInterval ml mu) =
+  sizedT $ \ n ->
+    case constrainInterval (ml <|> lowerBound) (mu <|> upperBound) (fromIntegral n) of
+      Just interval -> pureGen $ choose interval
+      Nothing -> genError $ "bad interval: " ++ show ml ++ " " ++ show mu
 
 -- TODO: fixme