hedgehog-extras 0.4.0.1 → 0.4.1.0

raw patch · 5 files changed

+85/−27 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hedgehog-extras.cabal +1/−1
• src/Hedgehog/Extras/Stock/IO/Network/Sprocket.hs +6/−5
• src/Hedgehog/Extras/Test/Base.hs +5/−4
• src/Hedgehog/Extras/Test/File.hs +52/−5
• src/Hedgehog/Extras/Test/Process.hs +21/−12

@@ -1,7 +1,7 @@ cabal-version: 2.4  name:                   hedgehog-extras-version:                0.4.0.1+version:                0.4.1.0 synopsis:               Supplemental library for hedgehog description:            Supplemental library for hedgehog. category:               Test

@@ -10,15 +10,16 @@  import           Data.Bool (Bool) import           Data.Char (Char)-import           Data.Eq (Eq((==)))-import           Data.Functor (Functor(fmap))+import           Data.Eq (Eq ((==)))+import           Data.Functor (Functor (fmap)) import           Data.Int (Int)-import           Data.Semigroup (Semigroup((<>)))+import           Data.Semigroup (Semigroup ((<>))) import           Data.String (String)+import           GHC.Generics (Generic) import           Hedgehog.Extras.Stock.OS (isWin32)+import           System.FilePath ((</>)) import           System.IO (FilePath, IO) import           Text.Show (Show)-import           GHC.Generics (Generic)  import qualified Hedgehog.Extras.Stock.IO.Network.NamedPipe as IO import qualified Hedgehog.Extras.Stock.IO.Network.Socket as IO@@ -39,7 +40,7 @@ sprocketSystemName :: Sprocket -> FilePath sprocketSystemName sprocket@(Sprocket base name) = if isWin32   then sprocketNamedPipeName sprocket-  else base <> "/" <> name+  else base </> name  -- | Use this when needing to pass a sprocket into a command line argument. sprocketArgumentName :: Sprocket -> FilePath

@@ -75,7 +75,7 @@ import           Control.Monad (Functor (fmap), Monad (return, (>>=)), mapM_, unless, void, when) import           Control.Monad.Catch (MonadCatch) import           Control.Monad.Morph (hoist)-import           Control.Monad.Reader (MonadIO (..), MonadReader (..))+import           Control.Monad.Reader (MonadIO (..), MonadReader (ask)) import           Control.Monad.Trans.Resource (ReleaseKey, runResourceT) import           Data.Aeson (Result (..)) import           Data.Bool (Bool, (&&))@@ -87,7 +87,7 @@ import           Data.Int (Int) import           Data.Maybe (Maybe (..), listToMaybe, maybe) import           Data.Monoid (Monoid (..))-import           Data.Ord (Ord (..))+import           Data.Ord (Ord ((<))) import           Data.Semigroup (Semigroup (..)) import           Data.String (String) import           Data.Time.Clock (NominalDiffTime, UTCTime)@@ -103,6 +103,7 @@ import           Hedgehog.Internal.Property (Diff, liftTest, mkTest) import           Hedgehog.Internal.Source (getCaller) import           Prelude (floor)+import           System.FilePath ((</>)) import           System.IO (FilePath, IO) import           Text.Show (Show (show)) @@ -150,7 +151,7 @@   maybeKeepWorkspace <- H.evalIO $ IO.lookupEnv "KEEP_WORKSPACE"   ws <- H.evalIO $ IO.createTempDirectory systemTemp $ prefixPath <> "-test"   H.annotate $ "Workspace: " <> ws-  liftIO $ IO.writeFile (ws <> "/module") callerModuleName+  liftIO $ IO.writeFile (ws </> "module") callerModuleName   f ws   when (IO.os /= "mingw32" && maybeKeepWorkspace /= Just "1") $ do     H.evalIO $ IO.removeDirectoryRecursive ws@@ -291,7 +292,7 @@ -- | Return the test file path after annotating it relative to the project root directory noteTempFile :: (MonadTest m, HasCallStack) => FilePath -> FilePath -> m FilePath noteTempFile tempDir filePath = GHC.withFrozenCallStack $ do-  let relPath = tempDir <> "/" <> filePath+  let relPath = tempDir </> filePath   H.annotate relPath   return relPath 

@@ -3,6 +3,9 @@  module Hedgehog.Extras.Test.File   ( createDirectoryIfMissing+  , createDirectoryIfMissing_+  , createSubdirectoryIfMissing+  , createSubdirectoryIfMissing_   , copyFile   , renameFile   , createFileLink@@ -19,11 +22,13 @@    , copyRewriteJsonFile   , readJsonFile+  , readJsonFileOk   , rewriteJsonFile   , rewriteLbsJson    , copyRewriteYamlFile   , readYamlFile+  , readYamlFileOk   , rewriteYamlFile   , rewriteLbsYaml @@ -40,6 +45,7 @@   , appendFileTimeDelta   ) where +import           Control.Applicative (Applicative (..)) import           Control.Monad import           Control.Monad.IO.Class import           Data.Aeson (Value)@@ -70,14 +76,45 @@ 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 'filePath' directory if it is missing.-createDirectoryIfMissing :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()-createDirectoryIfMissing filePath = GHC.withFrozenCallStack $ do-  H.annotate $ "Creating directory if missing: " <> filePath-  H.evalIO $ IO.createDirectoryIfMissing True filePath+-- | Create the 'directory' directory if it is missing.+createDirectoryIfMissing :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m FilePath+createDirectoryIfMissing directory = GHC.withFrozenCallStack $ do+  H.annotate $ "Creating directory if missing: " <> directory+  H.evalIO $ IO.createDirectoryIfMissing True directory+  pure directory +-- | Create the 'directory' directory if it is missing.+createDirectoryIfMissing_ :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()+createDirectoryIfMissing_ directory = GHC.withFrozenCallStack $+  void $ createDirectoryIfMissing directory++-- | Create the 'subdirectory' subdirectory if it is missing.  The subdirectory is returned.+createSubdirectoryIfMissing :: ()+  => HasCallStack+  => MonadTest m+  => MonadIO m+  => FilePath+  -> FilePath+  -> m FilePath+createSubdirectoryIfMissing parent subdirectory = GHC.withFrozenCallStack $ do+  H.annotate $ "Creating subdirectory if missing: " <> subdirectory+  H.evalIO $ IO.createDirectoryIfMissing True $ parent </> subdirectory+  pure subdirectory++-- | Create the 'subdirectory' subdirectory if it is missing.  The subdirectory is returned.+createSubdirectoryIfMissing_ :: ()+  => HasCallStack+  => MonadTest m+  => MonadIO m+  => FilePath+  -> FilePath+  -> m ()+createSubdirectoryIfMissing_ parent subdirectory = GHC.withFrozenCallStack $+  void $ createSubdirectoryIfMissing parent subdirectory+ -- | Copy the contents of the 'src' file to the 'dst' file. copyFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () copyFile src dst = GHC.withFrozenCallStack $ do@@ -158,6 +195,11 @@   void . H.annotate $ "Reading JSON file: " <> filePath   H.evalIO $ J.eitherDecode @Value <$> 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+readJsonFileOk filePath = GHC.withFrozenCallStack $+  H.leftFailM $ readJsonFile filePath+ rewriteLbsJson :: (MonadTest m, HasCallStack) => (Value -> Value) -> LBS.ByteString -> m LBS.ByteString rewriteLbsJson f lbs = GHC.withFrozenCallStack $ do   case J.eitherDecode lbs of@@ -181,6 +223,11 @@ readYamlFile filePath = GHC.withFrozenCallStack $ do   void . H.annotate $ "Reading YAML file: " <> filePath   H.evalIO $ Y.decodeEither' @Value . 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 filePath = GHC.withFrozenCallStack $+  H.leftFailM $ readYamlFile filePath  rewriteLbsYaml :: (MonadTest m, HasCallStack) => (Value -> Value) -> LBS.ByteString -> m LBS.ByteString rewriteLbsYaml f lbs = GHC.withFrozenCallStack $ do

@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveGeneric       #-}-{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}+{-# LANGUAGE TypeApplications #-}  module Hedgehog.Extras.Test.Process   ( createProcess@@ -16,22 +16,23 @@   , waitForProcess   , maybeWaitForProcess   , getPid+  , getPidOk   , waitSecondsForProcess    , ExecConfig(..)   , defaultExecConfig   ) where -import           Control.Monad (Monad(..),  MonadFail(fail), void)+import           Control.Monad (Monad (..), MonadFail (fail), void) import           Control.Monad.Catch (MonadCatch) import           Control.Monad.IO.Class (MonadIO, liftIO) import           Control.Monad.Trans.Resource (MonadResource, ReleaseKey, register) import           Data.Aeson (eitherDecode)-import           Data.Bool (Bool(..))-import           Data.Either (Either(..))-import           Data.Eq (Eq(..))+import           Data.Bool (Bool (..))+import           Data.Either (Either (..))+import           Data.Eq (Eq (..)) import           Data.Function (($), (&), (.))-import           Data.Functor (Functor(..))+import           Data.Functor (Functor (..)) import           Data.Int (Int) import           Data.Maybe (Maybe (..)) import           Data.Monoid (Last (..), mempty, (<>))@@ -40,7 +41,7 @@ import           GHC.Stack (HasCallStack) import           Hedgehog (MonadTest) import           Hedgehog.Extras.Internal.Cli (argQuote)-import           Hedgehog.Extras.Internal.Plan (Component(..), Plan(..))+import           Hedgehog.Extras.Internal.Plan (Component (..), Plan (..)) import           Hedgehog.Extras.Stock.IO.Process (TimedOut (..)) import           Prelude (error) import           System.Exit (ExitCode)@@ -48,7 +49,7 @@ import           System.FilePath.Posix ((</>)) import           System.IO (FilePath, Handle, IO) import           System.Process (CmdSpec (..), CreateProcess (..), Pid, ProcessHandle)-import           Text.Show (Show(show))+import           Text.Show (Show (show))  import qualified Data.ByteString.Lazy as LBS import qualified Data.List as L@@ -130,6 +131,14 @@   -> m (Maybe Pid) getPid hProcess = GHC.withFrozenCallStack . H.evalIO $ IO.getPid hProcess +-- | Get the process ID.+getPidOk+  :: (MonadTest m, MonadIO m, HasCallStack)+  => ProcessHandle+  -> m Pid+getPidOk hProcess = GHC.withFrozenCallStack $+  H.nothingFailM $ getPid hProcess+ -- | Create a process returning its stdout. -- -- Being a 'flex' function means that the environment determines how the process is launched.@@ -334,11 +343,11 @@ getProjectBase = do   let     findUp dir = do-      atBase <- liftIO $ IO.doesFileExist (dir <> "/cabal.project")+      atBase <- liftIO $ IO.doesFileExist (dir </> "cabal.project")       if atBase         then return dir         else do-          let up = dir <> "/.."+          let up = dir </> ".."           upExist <- liftIO $ IO.doesDirectoryExist up           if upExist             then findUp up