packages feed

skeletest 0.1.1 → 0.2.0

raw patch · 12 files changed

+154/−30 lines, 12 filesdep +colourdep ~ansi-terminal

Dependencies added: colour

Dependency ranges changed: ansi-terminal

Files

CHANGELOG.md view
@@ -1,3 +1,8 @@+## v0.2.0++* Move setting properties to `Skeletest.Prop`+* Add coverage functions for property tests+ ## v0.1.1  * Support Diff-1.0
README.md view
@@ -277,6 +277,7 @@ Property tests are written with `prop` and run in the `PropertyM` monad (`Property` is an alias for `PropertyM ()`). To write property tests, add the following imports:  ```haskell+import qualified Skeletest.Prop as Prop import qualified Skeletest.Prop.Gen as Gen import qualified Skeletest.Prop.Range as Range ```@@ -309,27 +310,27 @@  Property tests can also be configured with the following functions. These must be called at the very beginning of the test, before any `forAll` calls. Values specified with CLI flags take precedence over the values in the code. -* `setDiscardLimit`+* `Prop.setDiscardLimit`     * The max number of values to discard before reporting a failure     * Default: `100` -* `setShrinkLimit`+* `Prop.setShrinkLimit`     * The max number of shrinks before giving up     * Default: `1000` -* `setShrinkRetries`+* `Prop.setShrinkRetries`     * The number of times to re-run a test during shrinking. This is useful if you are testing something which fails non-deterministically and you want to increase the change of getting a good shrink. e.g. `10` means a test must pass 10 times before trying a different shrink     * Default: `0` -* `setConfidence`+* `Prop.setConfidence`     * The acceptable occurrence of false positives. e.g. `10^9` means accepting a false positive for 1 in 10^9 tests     * Default: don't check confidence -* `setVerifiedTermination`+* `Prop.setVerifiedTermination`     * Validate confidence is reached     * Default: disabled -* `setTestLimit`+* `Prop.setTestLimit`     * The number of tests to run before reporting success     * Default: `100`     * CLI flag: `--prop-test-limit`
skeletest.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0  name: skeletest-version: 0.1.1+version: 0.2.0 synopsis: Batteries-included, opinionated test framework description: Batteries-included, opinionated test framework. See README.md for more details. homepage: https://github.com/brandonchinn178/skeletest#readme@@ -57,6 +57,7 @@     Skeletest.Main     Skeletest.Plugin     Skeletest.Predicate+    Skeletest.Prop     Skeletest.Prop.Gen     Skeletest.Prop.Internal     Skeletest.Prop.Range@@ -73,7 +74,8 @@       base < 5     , aeson     , aeson-pretty-    , ansi-terminal >= 0.4.0+    , ansi-terminal >= 0.7.0+    , colour     , containers     , Diff >= 1.0     , directory
src/Skeletest.hs view
@@ -33,14 +33,6 @@   forAll,   discard, -  -- ** Settings-  setDiscardLimit,-  setShrinkLimit,-  setShrinkRetries,-  setConfidence,-  setVerifiedTermination,-  setTestLimit,-   -- * Fixtures   Fixture (..),   FixtureScope (..),
src/Skeletest/Assertions.hs view
@@ -31,10 +31,15 @@  ) import Skeletest.Internal.Predicate qualified as P import Skeletest.Internal.TestInfo (getTestInfo)-import Skeletest.Internal.TestRunner (AssertionFail (..), FailContext, Testable (..))+import Skeletest.Internal.TestRunner (+  AssertionFail (..),+  FailContext,+  Testable (..),+  testResultPass,+ )  instance Testable IO where-  runTestable = id+  runTestable m = m >> pure testResultPass   context = contextIO   throwFailure = throwIO
src/Skeletest/Internal/Spec.hs view
@@ -62,7 +62,6 @@   TestResultMessage (..),   testResultFromAssertionFail,   testResultFromError,-  testResultPass,  ) import Skeletest.Internal.TestTargets (TestTarget, TestTargets, matchesTest) import Skeletest.Internal.TestTargets qualified as TestTargets@@ -96,7 +95,7 @@       -- will contain       --       -- >>> SpecTest { testMarkers = [MarkerA, MarkerB] }-      , testAction :: IO ()+      , testAction :: IO TestResult       }  -- | Traverse the tree with the given processing function.@@ -190,7 +189,7 @@     runTest info action =       hookRunTest info $ do         try action >>= \case-          Right () -> pure testResultPass+          Right result -> pure result           Left e             | Just e' <- fromException e -> testResultFromAssertionFail e'             | otherwise -> pure $ testResultFromError e
src/Skeletest/Internal/TestRunner.hs view
@@ -40,7 +40,7 @@ {----- Testable -----}  class (MonadIO m) => Testable m where-  runTestable :: m () -> IO ()+  runTestable :: m () -> IO TestResult   context :: String -> m a -> m a   throwFailure :: AssertionFail -> m a
src/Skeletest/Internal/Utils/Color.hs view
@@ -2,8 +2,10 @@   green,   red,   yellow,+  gray, ) where +import Data.Colour.Names qualified as Color import Data.Text (Text) import Data.Text qualified as Text import System.Console.ANSI qualified as ANSI@@ -19,3 +21,6 @@  yellow :: Text -> Text yellow = withANSI [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Yellow]++gray :: Text -> Text+gray = withANSI [ANSI.SetRGBColor ANSI.Foreground Color.gray]
+ src/Skeletest/Prop.hs view
@@ -0,0 +1,17 @@+module Skeletest.Prop (+  -- * Settings+  setDiscardLimit,+  setShrinkLimit,+  setShrinkRetries,+  setConfidence,+  setVerifiedTermination,+  setTestLimit,++  -- * Coverage+  classify,+  cover,+  label,+  collect,+) where++import Skeletest.Prop.Internal
src/Skeletest/Prop/Internal.hs view
@@ -19,6 +19,12 @@   setVerifiedTermination,   setTestLimit, +  -- * Coverage+  classify,+  cover,+  label,+  collect,+   -- * CLI flags   PropSeedFlag,   PropLimitFlag,@@ -29,6 +35,7 @@ import Control.Monad.Trans.Class qualified as Trans import Control.Monad.Trans.Reader qualified as Trans import Data.List qualified as List+import Data.Map qualified as Map import Data.Maybe (catMaybes) import Data.Text qualified as Text import GHC.Stack qualified as GHC@@ -48,11 +55,18 @@  import Skeletest.Internal.CLI (FlagSpec (..), IsFlag (..), getFlag) import Skeletest.Internal.TestInfo (getTestInfo)-import Skeletest.Internal.TestRunner (AssertionFail (..), Testable (..))+import Skeletest.Internal.TestRunner (+  AssertionFail (..),+  TestResult (..),+  TestResultMessage (..),+  Testable (..),+  testResultPass,+ )+import Skeletest.Internal.Utils.Color qualified as Color  -- | A property to run, with optional configuration settings specified up front. ----- Settings should be specified before any 'forAll' or IO calls; any settings+-- Settings should be specified before any other 'Property' calls; any settings -- specified afterwards are ignored. type Property = PropertyM () @@ -146,7 +160,7 @@                 Hedgehog.EarlyTermination c _ -> Hedgehog.EarlyTermination c (Hedgehog.TestLimit x)           } -runProperty :: Property -> IO ()+runProperty :: Property -> IO TestResult runProperty = \case   PropertyPure cfg () -> runProperty $ PropertyIO cfg (pure ())   PropertyIO cfg m -> do@@ -163,12 +177,18 @@     let       Hedgehog.TestCount testCount = Hedgehog.reportTests report       Hedgehog.DiscardCount discards = Hedgehog.reportDiscards report+      Hedgehog.Coverage coverage = Hedgehog.reportCoverage report      case Hedgehog.reportStatus report of       Hedgehog.OK ->-        -- TODO: show details-        -- https://github.com/brandonchinn178/skeletest/issues/19-        pure ()+        pure+          testResultPass+            { testResultMessage =+                TestResultMessageInline . Color.gray . Text.pack . List.intercalate "\n" . concat $+                  [ [show testCount <> " tests, " <> show discards <> " discards"]+                  , renderCoverage coverage testCount+                  ]+            }       Hedgehog.GaveUp -> do         testInfo <- getTestInfo         throwIO@@ -224,7 +244,45 @@                 }   where     reportProgress _ = pure ()-    renderSeed Hedgehog.Report{reportSeed = Hedgehog.Seed value gamma} = show value <> ":" <> show gamma+    renderSeed report =+      let Hedgehog.Seed value gamma = Hedgehog.reportSeed report+       in show value <> ":" <> show gamma+    renderCoverage coverage testCount =+      let columns =+            [ (name, percentStr, percentBar)+            | Hedgehog.MkLabel{..} <- List.sortOn Hedgehog.labelLocation $ Map.elems coverage+            , let+                Hedgehog.LabelName name = labelName+                Hedgehog.CoverCount count = labelAnnotation+                percent = round $ fromIntegral count / fromIntegral testCount * (100 :: Double)+                percentStr = show percent <> "%"+                percentBar = renderPercentBar percent+            ]+          (maxNameLen, maxPercentLen) =+            foldr+              ( \(name, percent, _) (nameAcc, percentAcc) ->+                  (max (length name) nameAcc, max (length percent) percentAcc)+              )+              (0, 0)+              columns+       in [ rjust maxNameLen name <> " " <> rjust maxPercentLen percentStr <> " " <> percentBar+          | (name, percentStr, percentBar) <- columns+          ]+    rjust n s = replicate (n - length s) ' ' <> s+    renderPercentBar percent =+      -- render percentage bar 20 characters wide+      let (n, r) = percent `divMod` 5+       in concat+            [ replicate n '█'+            , case r of+                0 -> ""+                1 -> "▏"+                2 -> "▍"+                3 -> "▌"+                4 -> "▊"+                _ -> "" -- unreachable+            , replicate (20 - n - (if r == 0 then 0 else 1)) '·'+            ]     toCallStack mSpan =       GHC.fromCallSiteList $         case mSpan of@@ -281,6 +339,41 @@  setTestLimit :: Int -> Property setTestLimit = propConfig . SetTestLimit++{----- Coverage -----}++-- | Record the propotion of tests which satisfy a given condition+--+-- @+-- xs <- forAll $ Gen.list (Range.linear 0 100) $ Gen.int (Range.linear 0 100)+-- for_ xs $ \x -> do+--   classify "newborns" $ x == 0+--   classify "children" $ x > 0 && x < 13+--   classify "teens" $ x > 12 && x < 20+-- @+classify :: (GHC.HasCallStack) => String -> Bool -> Property+classify l cond = GHC.withFrozenCallStack $ propM $ Hedgehog.classify (Hedgehog.LabelName l) cond++-- | Require a certain percentage of the tests to be covered by the classifier.+--+-- In the following example, if the condition does not have at least 30%+-- coverage, the test will fail.+-- @+-- match <- forAll Gen.bool+-- cover 30 "True" $ match+-- cover 30 "False" $ not match+-- @+cover :: (GHC.HasCallStack) => Double -> String -> Bool -> Property+cover p l cond = GHC.withFrozenCallStack $ propM $ Hedgehog.cover (Hedgehog.CoverPercentage p) (Hedgehog.LabelName l) cond++-- | Add a label for each test run. It produces a table showing the percentage+-- of test runs that produced each label.+label :: (GHC.HasCallStack) => String -> Property+label l = GHC.withFrozenCallStack $ propM $ Hedgehog.label (Hedgehog.LabelName l)++-- | Like 'label', but uses 'Show' to render its argument for display.+collect :: (Show a, GHC.HasCallStack) => a -> Property+collect a = GHC.withFrozenCallStack $ propM $ Hedgehog.collect a  {----- CLI flags -----}
test/ExampleSpec.hs view
@@ -7,6 +7,7 @@  import Skeletest import Skeletest.Predicate qualified as P+import Skeletest.Prop qualified as Prop import Skeletest.Prop.Gen qualified as Gen import Skeletest.Prop.Range qualified as Range @@ -56,6 +57,9 @@       forAll $         Gen.list (Range.linear 0 10) $           Gen.string (Range.linear 0 100) Gen.unicode+    Prop.label $ show $ length input+    Prop.classify "even" $ even $ length input+    Prop.classify "odd" $ odd $ length input     length (reverse input) `shouldBe` length input    prop "read . show === id" $
test/Skeletest/PropSpec.hs view
@@ -16,9 +16,10 @@         [ "module ExampleSpec (spec) where"         , ""         , "import Skeletest"+        , "import qualified Skeletest.Prop as Prop"         , ""         , "spec = prop \"discards\" $ do"-        , "  setDiscardLimit 10"+        , "  Prop.setDiscardLimit 10"         , "  discard"         ]