hedgehog-extras 0.4.2.0 → 0.4.3.0

raw patch · 5 files changed

+128/−7 lines, 5 filesdep +DiffPVP ok

version bump matches the API change (PVP)

Dependencies added: Diff

API changes (from Hackage documentation)

Files

• hedgehog-extras.cabal +5/−2
• src/Hedgehog/Extras/Stock/String.hs +11/−0
• src/Hedgehog/Extras/Test/Base.hs +12/−3
• src/Hedgehog/Extras/Test/File.hs +2/−2
• src/Hedgehog/Extras/Test/Golden.hs +98/−0

@@ -1,7 +1,7 @@ cabal-version: 2.4  name:                   hedgehog-extras-version:                0.4.2.0+version:                0.4.3.0 synopsis:               Supplemental library for hedgehog description:            Supplemental library for hedgehog. category:               Test@@ -16,12 +16,13 @@   type:                 git   location:             https://github.com/input-output-hk/hedgehog-extras -common base                         { build-depends: base                             >= 4.12       && < 4.17     } common aeson                        { build-depends: aeson                            >= 1.5.6.0                  } common aeson-pretty                 { build-depends: aeson-pretty                     >= 0.8.5                    } common async                        { build-depends: async                                                        }+common base                         { build-depends: base                             >= 4.12       && < 4.17     } common bytestring                   { build-depends: bytestring                                                   } common deepseq                      { build-depends: deepseq                                                      }+common Diff                         { build-depends: Diff                                                         } common directory                    { build-depends: directory                                                    } common exceptions                   { build-depends: exceptions                                                   } common filepath                     { build-depends: filepath                                                     }@@ -63,6 +64,7 @@                         async,                         bytestring,                         deepseq,+                        Diff,                         directory,                         exceptions,                         filepath,@@ -108,6 +110,7 @@                         Hedgehog.Extras.Test.Base                         Hedgehog.Extras.Test.Concurrent                         Hedgehog.Extras.Test.File+                        Hedgehog.Extras.Test.Golden                         Hedgehog.Extras.Test.MonadAssertion                         Hedgehog.Extras.Test.Network                         Hedgehog.Extras.Test.Process

@@ -2,13 +2,20 @@   ( strip   , lastLine   , firstLine+  , readM   ) where +import           Control.Monad.Catch (MonadCatch) import           Data.Function import           Data.String+import           GHC.Stack+import           Text.Read+import           Text.Show (Show)  import qualified Data.List as L import qualified Data.Text as T+import qualified Hedgehog as H+import qualified Hedgehog.Extras.Test.Base as H  -- | Strip whitepsace from the beginning and end of the string. strip :: String -> String@@ -21,3 +28,7 @@ -- | Get the first line in the string firstLine :: String -> String firstLine = strip . L.unlines . L.take 1 . L.lines++-- | Trim leading and trailing whitespace and read the string into a value+readM :: (Read a, Show a, H.MonadTest m, MonadCatch m, HasCallStack) => String -> m a+readM = withFrozenCallStack . H.noteShowM . H.evalEither . readEither . strip

@@ -54,6 +54,7 @@   , assertByDeadlineIOFinally   , assertM   , assertIO+  , assertWithinTolerance    , byDeadlineM   , byDeadlineIO@@ -87,13 +88,11 @@ import           Data.Int (Int) import           Data.Maybe (Maybe (..), listToMaybe, maybe) import           Data.Monoid (Monoid (..))-import           Data.Ord (Ord ((<))) import           Data.Semigroup (Semigroup (..)) import           Data.String (String) import           Data.Time.Clock (NominalDiffTime, UTCTime) import           Data.Traversable (Traversable) import           Data.Tuple (snd)-import           GHC.Num (Num ((*), (+))) import           GHC.Stack (CallStack, HasCallStack) import           Hedgehog (MonadTest) import           Hedgehog.Extras.Internal.Test.Integration (Integration, IntegrationState (..))@@ -102,7 +101,7 @@ import           Hedgehog.Extras.Test.MonadAssertion (MonadAssertion) import           Hedgehog.Internal.Property (Diff, liftTest, mkTest) import           Hedgehog.Internal.Source (getCaller)-import           Prelude (floor)+import           Prelude (Num (..), Ord (..), floor) import           System.FilePath ((</>)) import           System.IO (FilePath, IO) import           Text.Show (Show (show))@@ -461,6 +460,16 @@ -- | Run the IO action 'f' and assert the return value is 'True'. assertIO :: (MonadTest m, MonadIO m, HasCallStack) => IO Bool -> m () assertIO f = GHC.withFrozenCallStack $ H.evalIO (forceM f) >>= H.assert++-- | Tests if @|c - v| <= r@+assertWithinTolerance :: (Show a, Ord a, Num a, HasCallStack, H.MonadTest m)+                  => a -- ^ tested value @v@+                  -> a -- ^ expected value @c@+                  -> a -- ^ tolerance range @r@+                  -> m ()+assertWithinTolerance v c r = GHC.withFrozenCallStack $ do+  H.diff v (>=) (c - r)+  H.diff v (<=) (c + r)  -- | Release the given release key. release :: (MonadTest m, MonadIO m) => ReleaseKey -> m ()

@@ -54,6 +54,7 @@ import           Data.Aeson (Value) import           Data.Bool import           Data.Either+import           Data.Foldable (for_) import           Data.Function import           Data.Functor import           Data.Int@@ -66,12 +67,12 @@ import           Hedgehog (MonadTest) import           Hedgehog.Extras.Stock.Monad import           Hedgehog.Extras.Stock.OS+import           System.FilePath ((</>)) import           System.IO (FilePath, Handle, IOMode) import           Text.Show  import qualified Data.Aeson as J import qualified Data.ByteString.Lazy as LBS-import           Data.Foldable (for_) import qualified Data.List as L import qualified Data.Text.IO as T import qualified Data.Time.Clock as DTC@@ -80,7 +81,6 @@ import qualified Hedgehog as H import qualified Hedgehog.Extras.Test.Base as H import qualified System.Directory as IO-import           System.FilePath ((</>)) import qualified System.IO as IO  -- | Create the 'directory' directory if it is missing.

@@ -0,0 +1,98 @@+module Hedgehog.Extras.Test.Golden+  ( diffVsGoldenFile,+    diffFileVsGoldenFile,+  ) where++import           Control.Applicative+import           Control.Monad+import           Control.Monad.IO.Class (MonadIO (liftIO))+import           Data.Algorithm.Diff (PolyDiff (Both), getGroupedDiff)+import           Data.Algorithm.DiffOutput (ppDiff)+import           Data.Bool+import           Data.Eq+import           Data.Function+import           Data.Maybe+import           Data.Monoid+import           Data.String+import           GHC.Stack (HasCallStack, callStack)+import           Hedgehog (MonadTest)+import           Hedgehog.Extras.Test.Base (failMessage)+import           System.FilePath (takeDirectory)+import           System.IO (FilePath)++import qualified Data.List as List+import qualified GHC.Stack as GHC+import qualified Hedgehog.Extras.Test as H+import qualified Hedgehog.Internal.Property as H+import qualified System.Directory as IO+import qualified System.Environment as IO+import qualified System.IO.Unsafe as IO++-- | Whether the test should create the golden files if the file does ont exist.+createFiles :: Bool+createFiles = IO.unsafePerformIO $ do+  value <- IO.lookupEnv "CREATE_GOLDEN_FILES"+  return $ value == Just "1"++-- | Diff contents against the golden file.  If CREATE_GOLDEN_FILES environment is+-- set to "1", then should the gold file not exist it would be created.+--+-- Set the environment variable when you intend to generate or re-generate the golden+-- file for example when running the test for the first time or if the golden file+-- genuinely needs to change.+--+-- To re-generate a golden file you must also delete the golden file because golden+-- files are never overwritten.+--+-- TODO: Improve the help output by saying the difference of+-- each input.+diffVsGoldenFile+  :: HasCallStack+  => (MonadIO m, MonadTest m)+  => String   -- ^ Actual content+  -> FilePath -- ^ Reference file+  -> m ()+diffVsGoldenFile actualContent referenceFile = GHC.withFrozenCallStack $ do+  fileExists <- liftIO $ IO.doesFileExist referenceFile++  if fileExists+    then do+      referenceLines <- List.lines <$> H.readFile referenceFile+      let difference = getGroupedDiff actualLines referenceLines+      case difference of+        [Both{}] -> pure ()+        _        -> failMessage callStack $ ppDiff difference+    else if createFiles+      then do+        -- CREATE_GOLDEN_FILES is set, so we create any golden files that don't+        -- already exist.+        H.note_ $ "Creating golden file " <> referenceFile+        H.createDirectoryIfMissing_ (takeDirectory referenceFile)+        H.writeFile referenceFile actualContent+      else do+        H.note_ $ mconcat+          [ "Golden file " <> referenceFile+          , " does not exist.  To create, run with CREATE_GOLDEN_FILES=1"+          ]+        H.failure+  where+    actualLines = List.lines actualContent++-- | Diff file against the golden file.  If CREATE_GOLDEN_FILES environment is+-- set to "1", then should the gold file not exist it would be created.+--+-- Set the environment variable when you intend to generate or re-generate the golden+-- file for example when running the test for the first time or if the golden file+-- genuinely needs to change.+--+-- To re-generate a golden file you must also delete the golden file because golden+-- files are never overwritten.+diffFileVsGoldenFile+  :: HasCallStack+  => (MonadIO m, MonadTest m)+  => FilePath -- ^ Actual file+  -> FilePath -- ^ Reference file+  -> m ()+diffFileVsGoldenFile actualFile referenceFile = GHC.withFrozenCallStack $ do+  contents <- H.readFile actualFile+  diffVsGoldenFile contents referenceFile