diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,21 +1,37 @@ Hedgehog Golden =============== +![](https://github.com/felixmulder/hedgehog-golden/workflows/Haskell%20CI/badge.svg) +![](https://img.shields.io/badge/Hackage-v1.0.0-blue.svg) + A golden file extension to hedgehog +Hedgehog support +---------------- +[Hedgehog](http://hackage.haskell.org/package/hedgehog-1.0) v1.x series is +supported by +[hedgehog-golden](https://hackage.haskell.org/package/hedgehog-golden-1.0.0) +v1.x series + +[Hedgehog](http://hackage.haskell.org/package/hedgehog-0.6.1) v0.6.x series is +supported by +[hedgehog-golden](https://hackage.haskell.org/package/hedgehog-golden-0.6.0) +v0.6.x series + Example ------- - ```haskell {-# LANGUAGE TemplateHaskell #-} -import Hedeghog -import qualified Hedeghog.Gen as Gen -import qualified Hedeghog.Golden.Aeson as Aeson +import Hedgehog +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Golden.Aeson as Aeson -- | A golden test for characters in the hex range prop_char_golden :: Property -prop_char_golden = Aeson.goldenProperty Gen.hexit +prop_char_golden = + Aeson.goldenProperty Gen.hexit tests :: IO Bool -tests = checkParallel $$discover +tests = + checkParallel $$discover ``` diff --git a/hedgehog-golden.cabal b/hedgehog-golden.cabal --- a/hedgehog-golden.cabal +++ b/hedgehog-golden.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 version: - 1.0.0 + 1.0.1 name: hedgehog-golden author: @@ -56,19 +56,20 @@ src exposed-modules: Hedgehog.Golden.Aeson + other-modules: Hedgehog.Golden.Types Hedgehog.Golden.Sample Hedgehog.Golden.Internal.Source build-depends: , aeson ^>= 1.4.2.0 , aeson-pretty ^>= 0.8.7 - , base ^>=4.12.0.0 + , base >=4.12.0.0 && < 5 , bytestring ^>=0.10.8.0 , containers ^>=0.6.0.1 , Diff ^>=0.3.4 - , directory ^>=1.3.3.2 - , extra ^>= 1.6.0 - , hedgehog ^>= 1.0 + , directory ^>=1.3.3.0 + , extra ^>= 1.7.0 + , hedgehog ^>= 1.0.2 , text ^>=1.2.3.1 test-suite test @@ -82,6 +83,7 @@ Main.hs other-modules: build-depends: - , base ^>=4.12.0.0 - , hedgehog ^>= 1.0 + , aeson ^>= 1.4.2.0 + , base >=4.12.0.0 && < 5 + , hedgehog ^>= 1.0.2 , hedgehog-golden diff --git a/src/Hedgehog/Golden/Aeson.hs b/src/Hedgehog/Golden/Aeson.hs --- a/src/Hedgehog/Golden/Aeson.hs +++ b/src/Hedgehog/Golden/Aeson.hs @@ -4,9 +4,9 @@ -- @ -- {-\# LANGUAGE TemplateHaskell \#-} -- --- import Hedeghog --- import qualified Hedeghog.Gen as Gen --- import qualified Hedeghog.Golden.Aeson as Aeson +-- import Hedgehog +-- import qualified Hedgehog.Gen as Gen +-- import qualified Hedgehog.Golden.Aeson as Aeson -- -- -- | A golden test for characters in the hex range -- prop_char_golden :: Property @@ -34,7 +34,7 @@ import Data.Proxy (Proxy(..)) import Data.Sequence (Seq) import Data.Text (Text) -import qualified Data.Text as Text (intercalate, lines, pack, unpack) +import qualified Data.Text as Text (intercalate, lines, pack, replace, unpack) import qualified Data.Text.Encoding as Text (decodeUtf8, encodeUtf8) import qualified Data.Text.IO as Text (readFile, writeFile) import Data.Typeable (Typeable, typeRep) @@ -43,11 +43,12 @@ import qualified Hedgehog.Internal.Seed as Seed import Hedgehog.Internal.Source import Hedgehog.Internal.Property (Log(..), Property(..), PropertyConfig(..)) +import Hedgehog.Internal.Property (TerminationCriteria(..)) import Hedgehog.Internal.Property (defaultConfig, evalM, failWith, writeLog) import Hedgehog.Golden.Sample (genSamples) import Hedgehog.Golden.Types (GoldenTest(..), ValueGenerator, ValueReader) import qualified Hedgehog.Golden.Internal.Source as Source -import System.Directory (createDirectoryIfMissing, doesFileExist) +import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory) -- | Run a golden test on the given generator -- @@ -71,23 +72,29 @@ => ToJSON a => FilePath -> Gen a -> Property goldenProperty' baseDir gen = withFrozenCallStack $ - Property defaultConfig { propertyTestLimit = 1, propertyShrinkLimit = 0 } . evalM $ + Property config . evalM $ goldenTest baseDir gen >>= \case NewFile fileName valGen -> do newGoldenFile baseDir fileName valGen ExistingFile fileName valGen readerM -> existingGoldenFile baseDir fileName valGen readerM + where + config = defaultConfig + { propertyTerminationCriteria = NoConfidenceTermination 1 + , propertyShrinkLimit = 0 + } newGoldenFile :: HasCallStack => FilePath -> FilePath -> ValueGenerator -> PropertyT IO () newGoldenFile basePath fileName gen = do seed <- Seed.random -- Create new file liftIO $ do - createDirectoryIfMissing False basePath + createDirectoryIfMissing True basePath Text.writeFile (fileName <> ".new") . Text.intercalate "\n" . gen $ seed -- Annotate output - writeLog . Footnote $ "New golden file generated in: " <> fileName + currentDir <- liftIO $ getCurrentDirectory + writeLog . Footnote $ "New golden file generated in: " <> currentDir <> "/" <> fileName <> ".new" failWith Nothing "No previous golden file exists" existingGoldenFile :: @@ -163,20 +170,19 @@ => ToJSON a => MonadIO m => FilePath -> Gen a -> m GoldenTest -goldenTest prefix gen = +goldenTest prefix gen = do let - typeName = show . typeRep $ Proxy @a - fileName = prefix <> typeName <> ".json" + typeName = Text.replace " " "_" (Text.pack . show . typeRep $ Proxy @a) + fileName = prefix <> Text.unpack typeName <> ".json" aesonValueGenerator seed = Text.lines . encodeGolden seed $ genSamples seed gen aesonValueReader t = either (Left . Text.pack) (const $ Right ()) $ Aeson.eitherDecodeStrict (Text.encodeUtf8 t) >>= decodeGolden @a - in liftIO $ do - fileExists <- doesFileExist fileName - pure $ if fileExists then - ExistingFile fileName aesonValueGenerator (Just aesonValueReader) - else - NewFile fileName aesonValueGenerator + fileExists <- liftIO $ doesFileExist fileName + pure $ if fileExists then + ExistingFile fileName aesonValueGenerator (Just aesonValueReader) + else + NewFile fileName aesonValueGenerator encodeGolden :: ToJSON a => Seed -> Seq a -> Text encodeGolden seed samples = @@ -211,4 +217,3 @@ gamma <- obj .: "seed" >>= (.: "gamma") samples <- obj .: "samples" pure (Seed value gamma, samples) - diff --git a/src/Hedgehog/Golden/Sample.hs b/src/Hedgehog/Golden/Sample.hs --- a/src/Hedgehog/Golden/Sample.hs +++ b/src/Hedgehog/Golden/Sample.hs @@ -10,7 +10,7 @@ import qualified Hedgehog.Internal.Tree as Tree import qualified Hedgehog.Range as Range --- | Generate a fixed Seq of @a@ from the given gnerator +-- | Generate a fixed Seq of @a@ from the given generator genSamples :: Seed -> Gen a -> Seq a genSamples seed gen = let diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,19 +1,36 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE TemplateHaskell #-} module Main (main) where import Prelude -import Hedgehog (Property) +import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Hedgehog (Gen, Property) import Hedgehog (checkParallel, discover) import Hedgehog.Main (defaultMain) +import Hedgehog.Range (singleton) import qualified Hedgehog.Golden.Aeson as Aeson import qualified Hedgehog.Gen as Gen +data HigherKinded a = HigherKinded { wrapped :: a } + deriving stock (Generic) + deriving anyclass FromJSON + deriving anyclass ToJSON + +higherKinded :: Gen (HigherKinded Int) +higherKinded = fmap HigherKinded (Gen.int $ singleton 7) + prop_hexit :: Property prop_hexit = Aeson.goldenProperty Gen.hexit prop_bool :: Property prop_bool = Aeson.goldenProperty Gen.bool + +prop_higher_kinded :: Property +prop_higher_kinded = Aeson.goldenProperty higherKinded tests :: IO Bool tests = checkParallel $$discover