effectful-zoo 0.0.5.2 → 0.0.6.0
raw patch · 4 files changed
+260/−13 lines, 4 filesdep +Diff
Dependencies added: Diff
Files
- components/core/Effectful/Zoo/FileSystem.hs +31/−0
- components/hedgehog/Effectful/Zoo/Hedgehog/Api/Process.hs +10/−12
- components/hedgehog/Effectful/Zoo/Hedgehog/Golden.hs +215/−0
- effectful-zoo.cabal +4/−1
components/core/Effectful/Zoo/FileSystem.hs view
@@ -2,6 +2,9 @@ ( FileSystem, JsonDecodeError(..), YamlDecodeError(..),++ appendStringFile,+ createDirectoryIfMissing, readByteStringFile, readLazyByteStringFile, readStringFile,@@ -123,6 +126,19 @@ unsafeFileSystemEff_ (IO.writeFile filePath contents) & trapIO @IOException throw +appendStringFile :: ()+ => HasCallStack+ => r <: Error IOException+ => r <: FileSystem+ => r <: Log Text+ => FilePath+ -> String+ -> Eff r ()+appendStringFile filePath contents = withFrozenCallStack do+ info $ "Appending string to file: " <> T.pack filePath+ unsafeFileSystemEff_ (IO.appendFile filePath contents)+ & trapIO @IOException throw+ getCanonicalTemporaryDirectory :: () => HasCallStack => r <: Error IOException@@ -218,3 +234,18 @@ unsafeFileSystemEff_ (D.listDirectory fp) & trapIO @IOException throw {-# INLINE listDirectory #-}++createDirectoryIfMissing :: ()+ => HasCallStack+ => r <: Error IOException+ => r <: FileSystem+ => r <: Log Text+ => Bool+ -> FilePath+ -> Eff r ()+createDirectoryIfMissing createParents fp = withFrozenCallStack do+ info $ "Calling: createDirectoryIfMissing " <> tshow fp++ unsafeFileSystemEff_ (D.createDirectoryIfMissing createParents fp)+ & trapIO @IOException throw+{-# INLINE createDirectoryIfMissing #-}
components/hedgehog/Effectful/Zoo/Hedgehog/Api/Process.hs view
@@ -63,8 +63,6 @@ => r <: Concurrent => r <: Environment => r <: Error Failure- => r <: Error GenericError- => r <: Error IOException => r <: FileSystem => r <: Hedgehog => r <: IOE@@ -80,8 +78,6 @@ => r <: Concurrent => r <: Environment => r <: Error Failure- => r <: Error GenericError- => r <: Error IOException => r <: FileSystem => r <: Hedgehog => r <: IOE@@ -111,8 +107,6 @@ => r <: Concurrent => r <: Environment => r <: Error Failure- => r <: Error GenericError- => r <: Error IOException => r <: FileSystem => r <: Hedgehog => r <: IOE@@ -130,14 +124,13 @@ RawCommand cmd args -> cmd <> " " <> L.unwords (argQuote <$> args) readCreateProcessWithExitCode cp ""+ & trapFail @IOException execDetailFlex :: () => HasCallStack => r <: Concurrent => r <: Environment => r <: Error Failure- => r <: Error GenericError- => r <: Error IOException => r <: FileSystem => r <: Hedgehog => r <: IOE@@ -154,6 +147,7 @@ ShellCommand cmd -> cmd RawCommand cmd args -> cmd <> " " <> L.unwords args readCreateProcessWithExitCode cp ""+ & trapFail @IOException -- | Execute a process, returning '()'. execOk_ :: ()@@ -268,10 +262,11 @@ -- configured and the executable has been built. procFlex :: () => HasCallStack+ => r <: Concurrent => r <: Environment- => r <: Error GenericError- => r <: Error IOException+ => r <: Error Failure => r <: FileSystem+ => r <: Hedgehog => r <: IOE => r <: Log Text => String@@ -287,10 +282,11 @@ procFlex' :: () => HasCallStack+ => r <: Concurrent => r <: Environment- => r <: Error GenericError- => r <: Error IOException+ => r <: Error Failure => r <: FileSystem+ => r <: Hedgehog => r <: IOE => r <: Log Text => ExecConfig@@ -305,6 +301,8 @@ procFlex' execConfig pkg binaryEnv arguments = withFrozenCallStack do bin <- binFlex pkg binaryEnv+ & trapFail @GenericError+ & trapFail @IOException return (proc bin arguments) { env = getLast execConfig.execConfigEnv , cwd = getLast execConfig.execConfigCwd
+ components/hedgehog/Effectful/Zoo/Hedgehog/Golden.hs view
@@ -0,0 +1,215 @@+{-# LANGUAGE MultiWayIf #-}++module Effectful.Zoo.Hedgehog.Golden+ ( diffVsGoldenFile,+ diffFileVsGoldenFile,+ diffVsGoldenFileExcludeTrace,+ ) where++import Control.Applicative+import Control.Monad+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 Effectful+import Effectful.Concurrent.QSem+import Effectful.Exception+import Effectful.Zoo.Core+import Effectful.Zoo.Error.Static+import Effectful.Zoo.FileSystem+import Effectful.Zoo.Hedgehog.Api.Assert+import Effectful.Zoo.Hedgehog.Api.Journal+import Effectful.Zoo.Hedgehog.Effect.Hedgehog+import Effectful.Zoo.Log.Static+import GHC.Stack (callStack)+import HaskellWorks.Prelude+import Hedgehog (MonadTest)+import System.FilePath (takeDirectory)+import qualified Control.Concurrent.QSem as IO+import qualified System.Environment as IO+import qualified System.IO.Unsafe as IO++import qualified Data.List as List+import qualified Data.Text as T+import qualified GHC.Stack as GHC+import qualified Hedgehog.Internal.Property as H++sem :: IO.QSem+sem = IO.unsafePerformIO $ IO.newQSem 1+{-# NOINLINE sem #-}++semBracket :: ()+ => r <: Concurrent+ => Eff r a+ -> Eff r a+semBracket = bracket_ (waitQSem sem) (signalQSem sem)++-- | The file to log whenever a golden file is referenced.+mGoldenFileLogFile :: Maybe FilePath+mGoldenFileLogFile = IO.unsafePerformIO $+ IO.lookupEnv "GOLDEN_FILE_LOG_FILE"++-- | Whether the test should create the golden files if the files do not exist.+createGoldenFiles :: Bool+createGoldenFiles = IO.unsafePerformIO $ do+ value <- IO.lookupEnv "CREATE_GOLDEN_FILES"+ return $ value == Just "1"++-- | Whether the test should recreate the golden files if the files already exist.+recreateGoldenFiles :: Bool+recreateGoldenFiles = IO.unsafePerformIO $ do+ value <- IO.lookupEnv "RECREATE_GOLDEN_FILES"+ return $ value == Just "1"++writeGoldenFile :: ()+ => HasCallStack+ => r <: Concurrent+ => r <: Error Failure+ => r <: Error IOException+ => r <: FileSystem+ => r <: Hedgehog+ => r <: Log Text+ => FilePath+ -> String+ -> Eff r ()+writeGoldenFile goldenFile actualContent = GHC.withFrozenCallStack $ do+ jot_ $ "Creating golden file " <> T.pack goldenFile+ void $ createDirectoryIfMissing True (takeDirectory goldenFile)+ writeStringFile goldenFile actualContent++reportGoldenFileMissing :: ()+ => HasCallStack+ => MonadIO m+ => MonadTest m+ => FilePath+ -> m ()+reportGoldenFileMissing goldenFile = GHC.withFrozenCallStack $ do+ jot_ $ T.unlines+ [ "Golden file " <> T.pack goldenFile <> " does not exist."+ , "To create it, run with CREATE_GOLDEN_FILES=1."+ , "To recreate it, run with RECREATE_GOLDEN_FILES=1."+ ]+ H.failure++checkAgainstGoldenFile :: ()+ => HasCallStack+ => r <: Concurrent+ => r <: Error Failure+ => r <: Error IOException+ => r <: FileSystem+ => r <: Hedgehog+ => r <: Log Text+ => FilePath+ -> [String]+ -> Eff r ()+checkAgainstGoldenFile goldenFile actualLines = GHC.withFrozenCallStack $ do+ referenceLines <- List.lines <$> readStringFile goldenFile+ let difference = getGroupedDiff actualLines referenceLines+ case difference of+ [] -> pure ()+ [Both{}] -> pure ()+ _ -> do+ jot_ $ T.unlines+ [ "Golden test failed against the golden file."+ , "To recreate golden file, run with RECREATE_GOLDEN_FILES=1."+ ]+ failMessage callStack $ ppDiff difference++-- | Diff contents against the golden file. If CREATE_GOLDEN_FILES environment is+-- set to "1", then should the golden file not exist it would be created. If+-- RECREATE_GOLDEN_FILES is set to "1", then should the golden file exist it would+-- be recreated. If GOLDEN_FILE_LOG_FILE is set to a filename, then the golden file+-- path will be logged to the specified file.+--+-- 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+ => r <: Concurrent+ => r <: Error Failure+ => r <: FileSystem+ => r <: Log Text+ => r <: Hedgehog+ => r <: IOE+ => String -- ^ Actual content+ -> FilePath -- ^ Reference file+ -> Eff r ()+diffVsGoldenFile actualContent goldenFile =+ GHC.withFrozenCallStack $ trapFail @IOException $ do+ semBracket $ do+ forM_ mGoldenFileLogFile $ \logFile ->+ appendStringFile logFile $ goldenFile <> "\n"++ fileExists <- doesFileExist goldenFile++ if+ | recreateGoldenFiles -> writeGoldenFile goldenFile actualContent+ | fileExists -> checkAgainstGoldenFile goldenFile actualLines+ | createGoldenFiles -> writeGoldenFile goldenFile actualContent+ | otherwise -> reportGoldenFileMissing goldenFile++ 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. If+-- GOLDEN_FILE_LOG_FILE is set to a filename, then the golden file path will be+-- logged to the specified file.+--+-- 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+ => r <: Concurrent+ => r <: Error Failure+ => r <: FileSystem+ => r <: Hedgehog+ => r <: IOE+ => r <: Log Text+ => FilePath -- ^ Actual file+ -> FilePath -- ^ Reference file+ -> Eff r ()+diffFileVsGoldenFile actualFile referenceFile = GHC.withFrozenCallStack $ do+ contents <- readStringFile actualFile+ & trapFail @IOException++ diffVsGoldenFile contents referenceFile++diffVsGoldenFileExcludeTrace :: ()+ => HasCallStack+ => r <: Concurrent+ => r <: Error Failure+ => r <: FileSystem+ => r <: Hedgehog+ => r <: IOE+ => r <: Log Text+ => String+ -> FilePath+ -> Eff r ()+diffVsGoldenFileExcludeTrace inputString refFile =+ GHC.withFrozenCallStack $ do+ case List.uncons $ T.splitOn "CallStack" $ T.pack inputString of+ Just (stackTraceRemoved, _) ->+ diffVsGoldenFile (T.unpack stackTraceRemoved) refFile+ Nothing ->+ H.failWith Nothing $+ List.unlines+ [ "Input string was empty"+ , "Reference file: " <> refFile+ ]
effectful-zoo.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.4 name: effectful-zoo-version: 0.0.5.2+version: 0.0.6.0 synopsis: Effectful effects for testing description: See https://hackage.haskell.org/package/effectful-zoo/docs/effectful-zoo.html category: Development@@ -54,6 +54,7 @@ common blockfrost-api { build-depends: blockfrost-api >= 0.11 && < 0.13 } common blockfrost-client { build-depends: blockfrost-client >= 0.8 && < 0.10 } common bytestring { build-depends: bytestring >= 0.11 && < 1 }+common Diff { build-depends: Diff >= 1.0.2 && < 2 } common directory { build-depends: directory >= 1.2 && < 2 } common effectful { build-depends: effectful >= 2.5 && < 3 } common effectful-core { build-depends: effectful-core >= 2.5 && < 3 }@@ -329,6 +330,7 @@ aeson, binary, bytestring,+ Diff, effectful-core, effectful-plugin, effectful-zoo-core,@@ -380,6 +382,7 @@ Effectful.Zoo.Hedgehog.Effect.Hedgehog Effectful.Zoo.Hedgehog.Effect.HedgehogGen Effectful.Zoo.Hedgehog.Effect.Run+ Effectful.Zoo.Hedgehog.Golden ghc-options: -fplugin=Effectful.Plugin hs-source-dirs: components/hedgehog