diff --git a/core/HaskellWorks/Polysemy/Cabal.hs b/core/HaskellWorks/Polysemy/Cabal.hs --- a/core/HaskellWorks/Polysemy/Cabal.hs +++ b/core/HaskellWorks/Polysemy/Cabal.hs @@ -10,7 +10,8 @@ import HaskellWorks.Polysemy.Prelude import HaskellWorks.Polysemy.System.Directory import HaskellWorks.Polysemy.System.Environment -import System.FilePath (takeDirectory) +import System.FilePath (takeDirectory, + ()) import Data.Aeson import qualified Data.List as L diff --git a/core/HaskellWorks/Polysemy/Data/ByteString.hs b/core/HaskellWorks/Polysemy/Data/ByteString.hs --- 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/core/HaskellWorks/Polysemy/Data/ByteString/Strict.hs b/core/HaskellWorks/Polysemy/Data/ByteString/Strict.hs --- a/core/HaskellWorks/Polysemy/Data/ByteString/Strict.hs +++ b/core/HaskellWorks/Polysemy/Data/ByteString/Strict.hs @@ -172,8 +172,7 @@ import qualified Data.ByteString as BS import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import GHC.Foreign (CString, CStringLen) -import GHC.IO.Handle (Handle) +import Foreign.C.String (CString, CStringLen) import HaskellWorks.Polysemy.Prelude import Polysemy diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs --- a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs +++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs @@ -1,10 +1,26 @@ +-- | 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, + 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 +30,19 @@ 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 +88,20 @@ 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 @@ -105,18 +140,7 @@ ] 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. @@ -147,17 +171,63 @@ 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. +-- | Diff utf8 bytestring contents against the golden file. +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. +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. +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. diffFileVsGoldenFile :: () => HasCallStack => Member (Embed IO) r diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Workspace.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Workspace.hs --- a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Workspace.hs +++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Workspace.hs @@ -19,6 +19,7 @@ import Polysemy import Polysemy.Log import Polysemy.Reader +import System.FilePath (()) import System.Info import qualified HaskellWorks.Polysemy.System.IO as PIO diff --git a/hw-polysemy.cabal b/hw-polysemy.cabal --- a/hw-polysemy.cabal +++ b/hw-polysemy.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: hw-polysemy -version: 0.3.1.0 +version: 0.3.1.1 synopsis: Opinionated polysemy library description: Opinionated polysemy library. license: Apache-2.0 @@ -10,6 +10,7 @@ copyright: 2024 John Ky category: Development build-type: Simple +tested-with: GHC == 9.10.1, GHC == 9.8.4, GHC == 9.6.6, GHC == 9.4.8 extra-doc-files: CHANGELOG.md extra-source-files: README.md @@ -27,18 +28,18 @@ common binary { build-depends: binary >= 0.8.9 && < 0.9 } common bytestring { build-depends: bytestring < 0.13 } common contravariant { build-depends: contravariant < 1.6 } -common Diff { build-depends: Diff < 0.6 } +common Diff { build-depends: Diff < 2 } common directory { build-depends: directory < 1.4 } common exceptions { build-depends: exceptions < 0.11 } common filepath { build-depends: filepath < 1.6 } common generic-lens { build-depends: generic-lens < 2.3 } -common ghc-prim { build-depends: ghc-prim < 0.12 } +common ghc-prim { build-depends: ghc-prim < 0.14 } common hedgehog { build-depends: hedgehog < 1.6 } common http-conduit { build-depends: http-conduit >= 2.3 && < 2.4 } common hw-prelude { build-depends: hw-prelude >= 0.0.1.0 && < 0.1 } common microlens { build-depends: microlens < 5 } common lens { build-depends: lens < 5.4 } -common mtl { build-depends: mtl < 2.4 } +common mtl { build-depends: mtl < 2.6 } common network { build-depends: network < 3.3 } common polysemy { build-depends: polysemy < 2 } common polysemy-log { build-depends: polysemy-log >= 0.11 && < 1 } diff --git a/test/HaskellWorks/Polysemy/HedgehogSpec.hs b/test/HaskellWorks/Polysemy/HedgehogSpec.hs --- a/test/HaskellWorks/Polysemy/HedgehogSpec.hs +++ b/test/HaskellWorks/Polysemy/HedgehogSpec.hs @@ -9,6 +9,7 @@ import qualified HaskellWorks.Polysemy.Data.Text as T import HaskellWorks.Polysemy.Hedgehog import HaskellWorks.Polysemy.Hedgehog.Test +import System.FilePath (()) default (String) diff --git a/test/HaskellWorks/Polysemy/TestContainers/LocalStackSpec.hs b/test/HaskellWorks/Polysemy/TestContainers/LocalStackSpec.hs --- a/test/HaskellWorks/Polysemy/TestContainers/LocalStackSpec.hs +++ b/test/HaskellWorks/Polysemy/TestContainers/LocalStackSpec.hs @@ -25,10 +25,13 @@ isWindows :: Bool isWindows = OS.os == "mingw32" +isMacos :: Bool +isMacos = OS.os == "darwin" + tasty_local_stack :: Tasty.TestTree tasty_local_stack = - if isWindows - then Tasty.testGroup "LocalStackSpec skipped on Windows" [] + if isWindows || isMacos + then Tasty.testGroup "LocalStackSpec skipped on Windows and MacOS" [] else TC.withContainers (setupContainers' "localstack/localstack-pro:3.7.2") $ \getContainer -> H.testProperty "Local stack test" $ propertyOnce $ runLocalTestEnv getContainer $ do