hedgehog-extras 0.6.0.2 → 0.6.1.0

raw patch · 3 files changed

+26/−30 lines, 3 filesdep ~aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• hedgehog-extras.cabal +2/−2
• src/Hedgehog/Extras/Test/File.hs +18/−16
• src/Hedgehog/Extras/Test/Process.hs +6/−12

@@ -1,7 +1,7 @@ cabal-version: 2.4  name:                   hedgehog-extras-version:                0.6.0.2+version:                0.6.1.0 synopsis:               Supplemental library for hedgehog description:            Supplemental library for hedgehog. category:               Test@@ -16,7 +16,7 @@   type:                 git   location:             https://github.com/input-output-hk/hedgehog-extras -common aeson                        { build-depends: aeson                            >= 2.1.0.0                  }+common aeson                        { build-depends: aeson                            >= 2.0.0.0                  } common aeson-pretty                 { build-depends: aeson-pretty                     >= 0.8.5                    } common async                        { build-depends: async                                                        } common base                         { build-depends: base                             >= 4.12       && < 4.20     }

@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}  module Hedgehog.Extras.Test.File   ( createDirectoryIfMissing@@ -193,60 +194,61 @@   void . H.annotate $ "Reading file: " <> filePath   H.evalIO $ T.readFile filePath --- | Read the 'filePath' file as JSON.-readJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either String Value)+-- | Read the 'filePath' file as JSON. Use @readJsonFile \@'Value'@ to decode into 'Value'.+readJsonFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, HasCallStack) => FilePath -> m (Either String a) readJsonFile filePath = GHC.withFrozenCallStack $ do   void . H.annotate $ "Reading JSON file: " <> filePath-  H.evalIO $ J.eitherDecode @Value <$> LBS.readFile filePath+  H.evalIO $ J.eitherDecode <$> LBS.readFile filePath --- | Read the 'filePath' file as JSON. Same as 'readJsonFile' but fails on error.-readJsonFileOk :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Value+-- | Read the 'filePath' file as JSON. Same as 'readJsonFile' but fails on error.  Use+-- @readJsonFileOk \@'Value'@ to decode into 'Value'.+readJsonFileOk :: forall a m.(MonadTest m, MonadIO m, Y.FromJSON a, HasCallStack) => FilePath -> m a readJsonFileOk filePath = GHC.withFrozenCallStack $   H.leftFailM $ readJsonFile filePath -rewriteLbsJson :: (MonadTest m, HasCallStack) => (Value -> Value) -> LBS.ByteString -> m LBS.ByteString+rewriteLbsJson :: forall a m. (MonadTest m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => (a -> a) -> LBS.ByteString -> m LBS.ByteString rewriteLbsJson f lbs = GHC.withFrozenCallStack $ do   case J.eitherDecode lbs of     Right iv -> return (J.encode (f iv))     Left msg -> H.failMessage GHC.callStack msg  -- | Rewrite the 'filePath' JSON file using the function 'f'.-rewriteJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (Value -> Value) -> m ()+rewriteJsonFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => FilePath -> (a -> a) -> m () rewriteJsonFile filePath f = GHC.withFrozenCallStack $ do   void . H.annotate $ "Rewriting JSON file: " <> filePath   lbsReadFile filePath >>= rewriteLbsJson f >>= lbsWriteFile filePath  -- | Rewrite the 'filePath' JSON file using the function 'f'.-copyRewriteJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> (Value -> Value) -> m ()+copyRewriteJsonFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => FilePath -> FilePath -> (a -> a) -> m () copyRewriteJsonFile src dst f = GHC.withFrozenCallStack $ do   void . H.annotate $ "Rewriting JSON from file: " <> src <> " to file " <> dst   lbsReadFile src >>= rewriteLbsJson f >>= lbsWriteFile dst  -- | Read the 'filePath' file as YAML.-readYamlFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either Y.ParseException Value)+readYamlFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, HasCallStack) => FilePath -> m (Either Y.ParseException a) readYamlFile filePath = GHC.withFrozenCallStack $ do   void . H.annotate $ "Reading YAML file: " <> filePath-  H.evalIO $ Y.decodeEither' @Value . LBS.toStrict <$> LBS.readFile filePath+  H.evalIO $ Y.decodeEither' . LBS.toStrict <$> LBS.readFile filePath  -- | Read the 'filePath' file as YAML.  Same as 'readYamlFile' but fails on error.-readYamlFileOk :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Value+readYamlFileOk :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, HasCallStack) => FilePath -> m a readYamlFileOk filePath = GHC.withFrozenCallStack $   H.leftFailM $ readYamlFile filePath -rewriteLbsYaml :: (MonadTest m, HasCallStack) => (Value -> Value) -> LBS.ByteString -> m LBS.ByteString+rewriteLbsYaml :: forall a m. (MonadTest m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => (a -> a) -> LBS.ByteString -> m LBS.ByteString rewriteLbsYaml f lbs = GHC.withFrozenCallStack $ do   case Y.decodeEither' (LBS.toStrict lbs) of     Right iv -> return (J.encode (f iv))     Left msg -> H.failMessage GHC.callStack (show msg)  -- | Rewrite the 'filePath' YAML file using the function 'f'.-rewriteYamlFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (Value -> Value) -> m ()+rewriteYamlFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => FilePath -> (a -> a) -> m () rewriteYamlFile filePath f = GHC.withFrozenCallStack $ do   void . H.annotate $ "Rewriting YAML file: " <> filePath   lbsReadFile filePath >>= rewriteLbsYaml f >>= lbsWriteFile filePath  -- | Rewrite the 'filePath' YAML file using the function 'f'.-copyRewriteYamlFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> (Value -> Value) -> m ()+copyRewriteYamlFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => FilePath -> FilePath -> (a -> a) -> m () copyRewriteYamlFile src dst f = GHC.withFrozenCallStack $ do   void . H.annotate $ "Rewriting YAML from file: " <> src <> " to file " <> dst   lbsReadFile src >>= rewriteLbsYaml f >>= lbsWriteFile dst@@ -264,7 +266,7 @@ -- | Assert the 'filePath' can be parsed as JSON. assertIsJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () assertIsJsonFile fp = GHC.withFrozenCallStack $ do-  jsonResult <- readJsonFile fp+  jsonResult <- readJsonFile @Value fp   case jsonResult of     Right _ -> return ()     Left msg -> H.failMessage GHC.callStack msg@@ -272,7 +274,7 @@ -- | Assert the 'filePath' can be parsed as YAML. assertIsYamlFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () assertIsYamlFile fp = GHC.withFrozenCallStack $ do-  result <- readJsonFile fp+  result <- readJsonFile @Value fp   case result of     Right _ -> return ()     Left msg -> H.failMessage GHC.callStack msg

@@ -34,7 +34,7 @@ import           Data.Either (Either (..)) import           Data.Eq (Eq (..)) import           Data.Function (($), (&), (.))-import           Data.Functor (Functor (..))+import           Data.Functor ((<$>)) import           Data.Int (Int) import           Data.Maybe (Maybe (..)) import           Data.Monoid (Last (..), mempty, (<>))@@ -170,10 +170,7 @@   case exitResult of     IO.ExitFailure exitCode -> do       H.annotate $ L.unlines $-        [ "Process exited with non-zero exit-code: " ++ show @Int exitCode-        , "━━━━ command ━━━━"-        , pkgBin <> " " <> L.unwords (fmap argQuote arguments)-        ]+        [ "Process exited with non-zero exit-code: " ++ show @Int exitCode ]         ++ (if L.null stdout then [] else ["━━━━ stdout ━━━━" , stdout])         ++ (if L.null stderr then [] else ["━━━━ stderr ━━━━" , stderr])       H.failMessage GHC.callStack "Execute process failed"@@ -191,9 +188,9 @@   -> m (ExitCode, String, String) -- ^ exit code, stdout, stderr execFlexAny' execConfig pkgBin envBin arguments = GHC.withFrozenCallStack $ do   cp <- procFlex' execConfig pkgBin envBin arguments-  H.annotate . ("Command: " <>) $ case IO.cmdspec cp of+  H.annotate . ("━━━━ command ━━━━\n" <>) $ case IO.cmdspec cp of     IO.ShellCommand cmd -> cmd-    IO.RawCommand cmd args -> cmd <> " " <> L.unwords args+    IO.RawCommand cmd args -> cmd <> " " <> L.unwords (argQuote <$> args)   H.evalIO $ IO.readCreateProcessWithExitCode cp ""  -- | Execute a process, returning '()'.@@ -218,10 +215,7 @@   (exitResult, stdout, stderr) <- execAny execConfig bin arguments   case exitResult of     IO.ExitFailure exitCode -> H.failMessage GHC.callStack . L.unlines $-      [ "Process exited with non-zero exit-code: " ++ show @Int exitCode-      , "━━━━ command ━━━━"-      , bin <> " " <> L.unwords (fmap argQuote arguments)-      ]+      [ "Process exited with non-zero exit-code: " ++ show @Int exitCode ]       ++ (if L.null stdout then [] else ["━━━━ stdout ━━━━" , stdout])       ++ (if L.null stderr then [] else ["━━━━ stderr ━━━━" , stderr])     IO.ExitSuccess -> return stdout@@ -238,7 +232,7 @@         { IO.env = getLast $ execConfigEnv execConfig         , IO.cwd = getLast $ execConfigCwd execConfig         }-  H.annotate . ("Command: " <>) $ bin <> " " <> L.unwords arguments+  H.annotate . ( "━━━━ command ━━━━\n" <>) $ bin <> " " <> L.unwords (argQuote <$> arguments)   H.evalIO $ IO.readCreateProcessWithExitCode cp ""  -- | Wait for process to exit.