From 16adfefbb77fdca3ab59b61220a9b98c8b02a0ee Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 16 Nov 2024 03:36:55 +1100 Subject: [PATCH 1/2] Add json and yaml golden file support --- core/HaskellWorks/Polysemy/Data/ByteString.hs | 1 + .../HaskellWorks/Polysemy/Hedgehog/Golden.hs | 120 ++++++++++++++++++ 2 files changed, 121 insertions(+) diff --git a/core/HaskellWorks/Polysemy/Data/ByteString.hs b/core/HaskellWorks/Polysemy/Data/ByteString.hs index 72fca9d..9fcc7d1 100644 --- a/core/HaskellWorks/Polysemy/Data/ByteString.hs +++ b/core/HaskellWorks/Polysemy/Data/ByteString.hs @@ -1,5 +1,6 @@ module HaskellWorks.Polysemy.Data.ByteString ( readFile + , writeFile ) where import HaskellWorks.Polysemy.Data.ByteString.Strict diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs index b99d5d3..2fc2542 100644 --- a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs +++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs @@ -1,10 +1,13 @@ module HaskellWorks.Polysemy.Hedgehog.Golden ( diffVsGoldenFile, diffFileVsGoldenFile, + diffJsonVsGoldenFile, + diffYamlVsGoldenFile, ) where import Control.Applicative import Control.Monad +import qualified Data.Aeson as J import Data.Algorithm.Diff (PolyDiff (Both), getGroupedDiff) import Data.Algorithm.DiffOutput (ppDiff) @@ -14,14 +17,19 @@ import Data.Function import Data.Maybe import Data.Monoid import Data.String +import qualified Data.Text as T +import qualified Data.Text.Encoding as T import GHC.Stack (callStack) import HaskellWorks.Polysemy.Hedgehog.Assert import HaskellWorks.Polysemy.Hedgehog.Jot import System.FilePath (takeDirectory) import qualified Control.Concurrent.QSem as IO +import qualified Data.ByteString.Lazy as LBS import qualified Data.List as List +import Data.Yaml as Y import qualified HaskellWorks.Polysemy.Control.Concurrent.QSem as PIO +import HaskellWorks.Polysemy.Data.ByteString as PBS import HaskellWorks.Polysemy.Prelude import HaskellWorks.Polysemy.System.Directory as PIO import HaskellWorks.Polysemy.System.IO as PIO @@ -67,6 +75,20 @@ writeGoldenFile goldenFile actualContent = withFrozenCallStack $ do PIO.createDirectoryIfMissing True (takeDirectory goldenFile) PIO.writeFile goldenFile actualContent +writeByteStringGoldenFile :: () + => HasCallStack + => Member Hedgehog r + => Member (Embed IO) r + => Member (Error IOException) r + => Member Log r + => FilePath + -> ByteString + -> Sem r () +writeByteStringGoldenFile goldenFile bs = withFrozenCallStack $ do + jot_ $ "Creating golden file " <> goldenFile + PIO.createDirectoryIfMissing True (takeDirectory goldenFile) + PBS.writeFile goldenFile bs + reportGoldenFileMissing :: () => HasCallStack => Member Hedgehog r @@ -147,6 +169,104 @@ diffVsGoldenFile actualContent goldenFile = withFrozenCallStack $ do where actualLines = List.lines actualContent +-- | Diff utf8 bytestring 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. +diffByteStringVsGoldenFile :: () + => HasCallStack + => Member Hedgehog r + => Member (Embed IO) r + => Member Resource r + => Member Log r + => ByteString -- ^ Actual content + -> FilePath -- ^ Reference file + -> Sem r () +diffByteStringVsGoldenFile bs goldenFile = withFrozenCallStack $ do + forM_ mGoldenFileLogFile $ \logFile -> + PIO.bracketQSem sem $ + PIO.appendFile logFile (goldenFile <> "\n") + & trapFail @IOException + + fileExists <- PIO.doesFileExist goldenFile + & trapFail @IOException + + if + | recreateGoldenFiles -> writeByteStringGoldenFile goldenFile bs & trapFail @IOException + | fileExists -> checkAgainstGoldenFile goldenFile actualLines & trapFail @IOException + | createGoldenFiles -> writeByteStringGoldenFile goldenFile bs & trapFail @IOException + | otherwise -> reportGoldenFileMissing goldenFile & trapFail @IOException + + where + actualLines = List.lines $ T.unpack $ T.decodeUtf8 bs + +-- | Diff JSON 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. +diffJsonVsGoldenFile :: () + => HasCallStack + => Member Hedgehog r + => Member (Embed IO) r + => Member Resource r + => Member Log r + => ToJSON a + => a -- ^ Actual content + -> FilePath -- ^ Reference file + -> Sem r () +diffJsonVsGoldenFile a goldenFile = withFrozenCallStack $ + diffByteStringVsGoldenFile (LBS.toStrict (J.encode a)) goldenFile + +-- | Diff YAML 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. +diffYamlVsGoldenFile :: () + => HasCallStack + => Member Hedgehog r + => Member (Embed IO) r + => Member Resource r + => Member Log r + => ToJSON a + => a -- ^ Actual content + -> FilePath -- ^ Reference file + -> Sem r () +diffYamlVsGoldenFile a goldenFile = withFrozenCallStack $ + diffByteStringVsGoldenFile (Y.encode a) goldenFile + -- | 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 From 860a9634156ae601dceff90405519f6ee2d8d70d Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 16 Nov 2024 11:21:14 +1100 Subject: [PATCH 2/2] Dedup comments in Golden module --- .../HaskellWorks/Polysemy/Hedgehog/Golden.hs | 86 ++++--------------- 1 file changed, 18 insertions(+), 68 deletions(-) diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs index 2fc2542..218e79d 100644 --- a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs +++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs @@ -1,3 +1,16 @@ +-- | For the diff functions in this module: 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 + module HaskellWorks.Polysemy.Hedgehog.Golden ( diffVsGoldenFile, diffFileVsGoldenFile, @@ -127,18 +140,7 @@ checkAgainstGoldenFile goldenFile actualLines = withFrozenCallStack $ do ] 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. +-- | Diff contents against the golden file. -- -- TODO: Improve the help output by saying the difference of -- each input. @@ -169,21 +171,7 @@ diffVsGoldenFile actualContent goldenFile = withFrozenCallStack $ do where actualLines = List.lines actualContent --- | Diff utf8 bytestring 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. +-- | Diff utf8 bytestring contents against the golden file. diffByteStringVsGoldenFile :: () => HasCallStack => Member Hedgehog r @@ -211,21 +199,7 @@ diffByteStringVsGoldenFile bs goldenFile = withFrozenCallStack $ do where actualLines = List.lines $ T.unpack $ T.decodeUtf8 bs --- | Diff JSON 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. +-- | Diff JSON against the golden file. diffJsonVsGoldenFile :: () => HasCallStack => Member Hedgehog r @@ -239,21 +213,7 @@ diffJsonVsGoldenFile :: () diffJsonVsGoldenFile a goldenFile = withFrozenCallStack $ diffByteStringVsGoldenFile (LBS.toStrict (J.encode a)) goldenFile --- | Diff YAML 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. +-- | Diff YAML against the golden file. diffYamlVsGoldenFile :: () => HasCallStack => Member Hedgehog r @@ -267,17 +227,7 @@ diffYamlVsGoldenFile :: () diffYamlVsGoldenFile a goldenFile = withFrozenCallStack $ diffByteStringVsGoldenFile (Y.encode a) goldenFile --- | 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. +-- | Diff file against the golden file. diffFileVsGoldenFile :: () => HasCallStack => Member (Embed IO) r