-- | This module can be used in order to create golden tests for Aeson
--   serializers and deserializers
--
--   @
--   {-\# LANGUAGE TemplateHaskell \#-}
--
--   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
--
--   tests :: IO Bool
--   tests = checkParallel $$discover
--   @
module Hedgehog.Golden.Aeson
  ( -- * Golden tests for generators
    goldenProperty
  , goldenProperty'
  ) where

import           Prelude

import           Control.Monad (forM_)
import           Control.Monad.IO.Class (MonadIO(..))
import           Data.Algorithm.Diff (Diff(..), getDiff)
import           Data.Aeson (FromJSON, ToJSON, (.=), (.:))
import qualified Data.Aeson as Aeson (eitherDecodeStrict)
import qualified Data.Aeson.Types as Aeson
import           Data.Aeson.Encode.Pretty (Config(..), Indent(..), encodePretty', defConfig)
import qualified Data.ByteString.Lazy as ByteString (toStrict)
import           Data.Proxy (Proxy(..))
import           Data.Sequence (Seq)
import           Data.Text (Text)
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)
import           Hedgehog (Gen, Property, PropertyT, Seed(..))
import           Hedgehog (success)
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, getCurrentDirectory)

-- | Run a golden test on the given generator
--
--   This will create a file in @golden/<TypeName>.json.new@ in case it does not
--   exist. If it does exist - the golden tests will be run against it
--
goldenProperty :: forall a
   . HasCallStack
  => Typeable a
  => FromJSON a
  => ToJSON a
  => Gen a -> Property
goldenProperty :: Gen a -> Property
goldenProperty = (HasCallStack => Gen a -> Property) -> Gen a -> Property
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Gen a -> Property) -> Gen a -> Property)
-> (HasCallStack => Gen a -> Property) -> Gen a -> Property
forall a b. (a -> b) -> a -> b
$ FilePath -> Gen a -> Property
forall a.
(HasCallStack, Typeable a, FromJSON a, ToJSON a) =>
FilePath -> Gen a -> Property
goldenProperty' FilePath
"golden/"

-- | Same as 'goldenProperty' but allows specifying the directory
--
goldenProperty' :: forall a
   . HasCallStack
  => Typeable a
  => FromJSON a
  => ToJSON a
  => FilePath -> Gen a -> Property
goldenProperty' :: FilePath -> Gen a -> Property
goldenProperty' FilePath
baseDir Gen a
gen = (HasCallStack => Property) -> Property
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Property) -> Property)
-> (HasCallStack => Property) -> Property
forall a b. (a -> b) -> a -> b
$
  PropertyConfig -> PropertyT IO () -> Property
Property PropertyConfig
config (PropertyT IO () -> Property)
-> (PropertyT IO () -> PropertyT IO ())
-> PropertyT IO ()
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropertyT IO () -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, MonadCatch m, HasCallStack) =>
m a -> m a
evalM (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$
    FilePath -> Gen a -> PropertyT IO GoldenTest
forall a (m :: * -> *).
(Typeable a, FromJSON a, ToJSON a, MonadIO m) =>
FilePath -> Gen a -> m GoldenTest
goldenTest FilePath
baseDir Gen a
gen PropertyT IO GoldenTest
-> (GoldenTest -> PropertyT IO ()) -> PropertyT IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      NewFile FilePath
fileName ValueGenerator
valGen -> do
        HasCallStack =>
FilePath -> FilePath -> ValueGenerator -> PropertyT IO ()
FilePath -> FilePath -> ValueGenerator -> PropertyT IO ()
newGoldenFile FilePath
baseDir FilePath
fileName ValueGenerator
valGen
      ExistingFile FilePath
fileName ValueGenerator
valGen Maybe ValueReader
readerM ->
        HasCallStack =>
FilePath
-> FilePath
-> ValueGenerator
-> Maybe ValueReader
-> PropertyT IO ()
FilePath
-> FilePath
-> ValueGenerator
-> Maybe ValueReader
-> PropertyT IO ()
existingGoldenFile FilePath
baseDir FilePath
fileName ValueGenerator
valGen Maybe ValueReader
readerM
  where
    config :: PropertyConfig
config = PropertyConfig
defaultConfig
      { propertyTerminationCriteria :: TerminationCriteria
propertyTerminationCriteria = TestLimit -> TerminationCriteria
NoConfidenceTermination TestLimit
1
      , propertyShrinkLimit :: ShrinkLimit
propertyShrinkLimit         = ShrinkLimit
0
      }

newGoldenFile :: HasCallStack => FilePath -> FilePath -> ValueGenerator -> PropertyT IO ()
newGoldenFile :: FilePath -> FilePath -> ValueGenerator -> PropertyT IO ()
newGoldenFile FilePath
basePath FilePath
fileName ValueGenerator
gen = do
  Seed
seed <- PropertyT IO Seed
forall (m :: * -> *). MonadIO m => m Seed
Seed.random
  -- Create new file
  IO () -> PropertyT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PropertyT IO ()) -> IO () -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
basePath
    FilePath -> Text -> IO ()
Text.writeFile (FilePath
fileName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".new") (Text -> IO ()) -> (Seed -> Text) -> Seed -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Text) -> ValueGenerator -> Seed -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueGenerator
gen (Seed -> IO ()) -> Seed -> IO ()
forall a b. (a -> b) -> a -> b
$ Seed
seed

  -- Annotate output
  FilePath
currentDir <- IO FilePath -> PropertyT IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> PropertyT IO FilePath)
-> IO FilePath -> PropertyT IO FilePath
forall a b. (a -> b) -> a -> b
$ IO FilePath
getCurrentDirectory
  Log -> PropertyT IO ()
forall (m :: * -> *). MonadTest m => Log -> m ()
writeLog (Log -> PropertyT IO ())
-> (FilePath -> Log) -> FilePath -> PropertyT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Log
Footnote (FilePath -> PropertyT IO ()) -> FilePath -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"New golden file generated in: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
currentDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fileName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".new"
  Maybe Diff -> FilePath -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> FilePath -> m a
failWith Maybe Diff
forall a. Maybe a
Nothing FilePath
"No previous golden file exists"

existingGoldenFile ::
     HasCallStack
  => FilePath -> FilePath -> ValueGenerator -> Maybe ValueReader -> PropertyT IO ()
existingGoldenFile :: FilePath
-> FilePath
-> ValueGenerator
-> Maybe ValueReader
-> PropertyT IO ()
existingGoldenFile FilePath
basePath FilePath
fp ValueGenerator
gen Maybe ValueReader
reader = PropertyT IO (Either FilePath (Seed, [Text]))
getSeedAndLines PropertyT IO (Either FilePath (Seed, [Text]))
-> (Either FilePath (Seed, [Text]) -> PropertyT IO ())
-> PropertyT IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Right (Seed
seed, [Text]
existingLines) ->
    let
      comparison :: [Diff Text]
comparison =
        [Text] -> [Text] -> [Diff Text]
forall t. Eq t => [t] -> [t] -> [Diff t]
getDiff [Text]
existingLines ([Text] -> [Diff Text]) -> [Text] -> [Diff Text]
forall a b. (a -> b) -> a -> b
$ ValueGenerator
gen Seed
seed

      hasDifference :: [Diff a] -> Bool
hasDifference = (Diff a -> Bool) -> [Diff a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Diff a -> Bool) -> [Diff a] -> Bool)
-> (Diff a -> Bool) -> [Diff a] -> Bool
forall a b. (a -> b) -> a -> b
$ \case
        Both a
_ a
_ -> Bool
False
        First a
_  -> Bool
True
        Second a
_ -> Bool
True

      runDecodeTest :: PropertyT IO ()
runDecodeTest = Maybe ValueReader
-> (ValueReader -> PropertyT IO ()) -> PropertyT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ValueReader
reader ((ValueReader -> PropertyT IO ()) -> PropertyT IO ())
-> (ValueReader -> PropertyT IO ()) -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ \ValueReader
r ->
        (Text -> PropertyT IO ())
-> (() -> PropertyT IO ()) -> Either Text () -> PropertyT IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
          (Maybe Diff -> FilePath -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> FilePath -> m a
failWith Maybe Diff
forall a. Maybe a
Nothing (FilePath -> PropertyT IO ())
-> (Text -> FilePath) -> Text -> PropertyT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
(<>) FilePath
"Failed to deserialize with error: " (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
Text.unpack)
          (PropertyT IO () -> () -> PropertyT IO ()
forall a b. a -> b -> a
const PropertyT IO ()
forall (m :: * -> *). MonadTest m => m ()
success)
          (ValueReader
r ValueReader -> ([Text] -> Text) -> [Text] -> Either Text ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Either Text ()) -> [Text] -> Either Text ()
forall a b. (a -> b) -> a -> b
$ [Text]
existingLines)
    in
      if [Diff Text] -> Bool
forall a. [Diff a] -> Bool
hasDifference [Diff Text]
comparison then do
        IO () -> PropertyT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PropertyT IO ()) -> IO () -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ do
          Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
False FilePath
basePath
          FilePath -> Text -> IO ()
Text.writeFile (FilePath
fp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".gen") (Text -> IO ()) -> (Seed -> Text) -> Seed -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Text) -> ValueGenerator -> Seed -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueGenerator
gen (Seed -> IO ()) -> Seed -> IO ()
forall a b. (a -> b) -> a -> b
$ Seed
seed

        Log -> PropertyT IO ()
forall (m :: * -> *). MonadTest m => Log -> m ()
writeLog (Log -> PropertyT IO ())
-> (FilePath -> Log) -> FilePath -> PropertyT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Log
Footnote (FilePath -> PropertyT IO ()) -> FilePath -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$
          FilePath
"Different file generated as: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".gen"

        Maybe Diff -> FilePath -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> FilePath -> m a
failWith Maybe Diff
forall a. Maybe a
Nothing (FilePath -> PropertyT IO ())
-> ([Text] -> FilePath) -> [Text] -> PropertyT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
Text.unpack (Text -> FilePath) -> ([Text] -> Text) -> [Text] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> PropertyT IO ()) -> [Text] -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$
          [ Text
"Failed in serialization comparison"
          , Text
""
          , Text -> Text
Source.yellow Text
"Difference when generating: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack FilePath
fp
          , [Diff Text] -> Text
printDifference [Diff Text]
comparison
          ]
      else
        PropertyT IO ()
runDecodeTest
  Left FilePath
err ->
    Maybe Diff -> FilePath -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> FilePath -> m a
failWith Maybe Diff
forall a. Maybe a
Nothing (FilePath -> PropertyT IO ()) -> FilePath -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Couldn't read previous golden file (" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
") because: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
err
  where
    getSeedAndLines :: PropertyT IO (Either FilePath (Seed, [Text]))
getSeedAndLines = IO (Either FilePath (Seed, [Text]))
-> PropertyT IO (Either FilePath (Seed, [Text]))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either FilePath (Seed, [Text]))
 -> PropertyT IO (Either FilePath (Seed, [Text])))
-> IO (Either FilePath (Seed, [Text]))
-> PropertyT IO (Either FilePath (Seed, [Text]))
forall a b. (a -> b) -> a -> b
$ do
      Text
fileContents <- FilePath -> IO Text
Text.readFile FilePath
fp
      Either FilePath (Seed, [Text])
-> IO (Either FilePath (Seed, [Text]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (Seed, [Text])
 -> IO (Either FilePath (Seed, [Text])))
-> (Text -> Either FilePath (Seed, [Text]))
-> Text
-> IO (Either FilePath (Seed, [Text]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seed -> (Seed, [Text]))
-> Either FilePath Seed -> Either FilePath (Seed, [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Text -> [Text]
Text.lines Text
fileContents) (Either FilePath Seed -> Either FilePath (Seed, [Text]))
-> (Text -> Either FilePath Seed)
-> Text
-> Either FilePath (Seed, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath Seed
decodeSeed (Text -> IO (Either FilePath (Seed, [Text])))
-> Text -> IO (Either FilePath (Seed, [Text]))
forall a b. (a -> b) -> a -> b
$ Text
fileContents

printDifference :: [Diff Text] -> Text
printDifference :: [Diff Text] -> Text
printDifference
  = Text -> [Text] -> Text
Text.intercalate Text
"\n"
  ([Text] -> Text) -> ([Diff Text] -> [Text]) -> [Diff Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text] -> [Text]
Source.wrap Text
Source.boxTop Text
Source.boxBottom
  ([Text] -> [Text])
-> ([Diff Text] -> [Text]) -> [Diff Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Diff Text] -> [Text]
addLineNumbers Int
1
  ([Diff Text] -> [Text])
-> ([Diff Text] -> [Diff Text]) -> [Diff Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Diff Text] -> [Diff Text]
renderDiff
  where
    renderDiff :: [Diff Text] -> [Diff Text]
    renderDiff :: [Diff Text] -> [Diff Text]
renderDiff =
      (Diff Text -> Diff Text) -> [Diff Text] -> [Diff Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Diff Text -> Diff Text) -> [Diff Text] -> [Diff Text])
-> (Diff Text -> Diff Text) -> [Diff Text] -> [Diff Text]
forall a b. (a -> b) -> a -> b
$ \case
        Both Text
text Text
_ -> Text -> Text -> Diff Text
forall a. a -> a -> Diff a
Both (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text) (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text)
        First Text
text  -> Text -> Diff Text
forall a. a -> Diff a
First (Text -> Diff Text) -> Text -> Diff Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
Source.red (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text
        Second Text
text -> Text -> Diff Text
forall a. a -> Diff a
Second (Text -> Diff Text) -> Text -> Diff Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
Source.green (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text

    addLineNumbers :: Int -> [Diff Text] -> [Text]
    addLineNumbers :: Int -> [Diff Text] -> [Text]
addLineNumbers Int
_ [] = []
    addLineNumbers Int
i (Diff Text
d : [Diff Text]
ds) = case Diff Text
d of
      Both Text
text Text
_ ->
        Int -> Text -> Text
Source.addLineNumber Int
i Text
text Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> [Diff Text] -> [Text]
addLineNumbers (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Diff Text]
ds
      First Text
text ->
        Int -> Text -> Text
Source.addLineNumber Int
i Text
text Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> [Diff Text] -> [Text]
addLineNumbers Int
i [Diff Text]
ds
      Second Text
text ->
        Int -> Text -> Text
Source.addLineNumber Int
i Text
text Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> [Diff Text] -> [Text]
addLineNumbers (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Diff Text]
ds

goldenTest :: forall a m
   . Typeable a
  => FromJSON a
  => ToJSON a
  => MonadIO m
  => FilePath -> Gen a -> m GoldenTest
goldenTest :: FilePath -> Gen a -> m GoldenTest
goldenTest FilePath
prefix Gen a
gen = do
  let
    typeName :: Text
typeName = Text -> Text -> Text -> Text
Text.replace Text
" " Text
"_" (FilePath -> Text
Text.pack (FilePath -> Text) -> (Proxy a -> FilePath) -> Proxy a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> FilePath
forall a. Show a => a -> FilePath
show (TypeRep -> FilePath)
-> (Proxy a -> TypeRep) -> Proxy a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> Text) -> Proxy a -> Text
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a)
    fileName :: FilePath
fileName = FilePath
prefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
Text.unpack Text
typeName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".json"
    aesonValueGenerator :: ValueGenerator
aesonValueGenerator Seed
seed = Text -> [Text]
Text.lines (Text -> [Text]) -> (Seq a -> Text) -> Seq a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seed -> Seq a -> Text
forall a. ToJSON a => Seed -> Seq a -> Text
encodeGolden Seed
seed (Seq a -> [Text]) -> Seq a -> [Text]
forall a b. (a -> b) -> a -> b
$ Seed -> Gen a -> Seq a
forall a. Seed -> Gen a -> Seq a
genSamples Seed
seed Gen a
gen
    aesonValueReader :: ValueReader
aesonValueReader Text
t =
      (FilePath -> Either Text ())
-> ((Seed, Seq a) -> Either Text ())
-> Either FilePath (Seed, Seq a)
-> Either Text ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ValueReader
forall a b. a -> Either a b
Left ValueReader -> (FilePath -> Text) -> FilePath -> Either Text ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack) (Either Text () -> (Seed, Seq a) -> Either Text ()
forall a b. a -> b -> a
const (Either Text () -> (Seed, Seq a) -> Either Text ())
-> Either Text () -> (Seed, Seq a) -> Either Text ()
forall a b. (a -> b) -> a -> b
$ () -> Either Text ()
forall a b. b -> Either a b
Right ()) (Either FilePath (Seed, Seq a) -> Either Text ())
-> Either FilePath (Seed, Seq a) -> Either Text ()
forall a b. (a -> b) -> a -> b
$
        ByteString -> Either FilePath Object
forall a. FromJSON a => ByteString -> Either FilePath a
Aeson.eitherDecodeStrict (Text -> ByteString
Text.encodeUtf8 Text
t) Either FilePath Object
-> (Object -> Either FilePath (Seed, Seq a))
-> Either FilePath (Seed, Seq a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FromJSON a => Object -> Either FilePath (Seed, Seq a)
forall a. FromJSON a => Object -> Either FilePath (Seed, Seq a)
decodeGolden @a
  Bool
fileExists <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
fileName
  GoldenTest -> m GoldenTest
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GoldenTest -> m GoldenTest) -> GoldenTest -> m GoldenTest
forall a b. (a -> b) -> a -> b
$ if Bool
fileExists then
    FilePath -> ValueGenerator -> Maybe ValueReader -> GoldenTest
ExistingFile FilePath
fileName ValueGenerator
aesonValueGenerator (ValueReader -> Maybe ValueReader
forall a. a -> Maybe a
Just ValueReader
aesonValueReader)
  else
    FilePath -> ValueGenerator -> GoldenTest
NewFile FilePath
fileName ValueGenerator
aesonValueGenerator

encodeGolden :: ToJSON a => Seed -> Seq a -> Text
encodeGolden :: Seed -> Seq a -> Text
encodeGolden Seed
seed Seq a
samples =
  let
    aesonSeed :: Seed -> Value
aesonSeed (Seed Word64
value Word64
gamma) =
      [Pair] -> Value
Aeson.object [ Text
"value" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
value, Text
"gamma" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
gamma ]

    encodePretty :: Value -> Text
encodePretty =
      ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
ByteString.toStrict (ByteString -> ByteString)
-> (Value -> ByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Value -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
defConfig
        { confIndent :: Indent
confIndent = Int -> Indent
Spaces Int
2
        , confCompare :: Text -> Text -> Ordering
confCompare = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
        }
  in
    Value -> Text
encodePretty (Value -> Text) -> Value -> Text
forall a b. (a -> b) -> a -> b
$
      [Pair] -> Value
Aeson.object [ Text
"seed" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Seed -> Value
aesonSeed Seed
seed, Text
"samples" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Seq a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Seq a
samples ]

decodeSeed :: Text -> Either String Seed
decodeSeed :: Text -> Either FilePath Seed
decodeSeed Text
text =
  let
    getSeed :: Aeson.Object -> Either String Seed
    getSeed :: Object -> Either FilePath Seed
getSeed =
      (Object -> Parser Seed) -> Object -> Either FilePath Seed
forall a b. (a -> Parser b) -> a -> Either FilePath b
Aeson.parseEither ((Object -> Parser Seed) -> Object -> Either FilePath Seed)
-> (Object -> Parser Seed) -> Object -> Either FilePath Seed
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        Word64
value <- Object
obj Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"seed" Parser Object -> (Object -> Parser Word64) -> Parser Word64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"value")
        Word64
gamma <- Object
obj Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"seed" Parser Object -> (Object -> Parser Word64) -> Parser Word64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"gamma")
        Seed -> Parser Seed
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seed -> Parser Seed) -> Seed -> Parser Seed
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Seed
Seed Word64
value Word64
gamma
  in
    ByteString -> Either FilePath Object
forall a. FromJSON a => ByteString -> Either FilePath a
Aeson.eitherDecodeStrict (Text -> ByteString
Text.encodeUtf8 Text
text) Either FilePath Object
-> (Object -> Either FilePath Seed) -> Either FilePath Seed
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Either FilePath Seed
getSeed

decodeGolden :: FromJSON a => Aeson.Object -> Either String (Seed, Seq a)
decodeGolden :: Object -> Either FilePath (Seed, Seq a)
decodeGolden = (Object -> Parser (Seed, Seq a))
-> Object -> Either FilePath (Seed, Seq a)
forall a b. (a -> Parser b) -> a -> Either FilePath b
Aeson.parseEither ((Object -> Parser (Seed, Seq a))
 -> Object -> Either FilePath (Seed, Seq a))
-> (Object -> Parser (Seed, Seq a))
-> Object
-> Either FilePath (Seed, Seq a)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Word64
value <- Object
obj Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"seed" Parser Object -> (Object -> Parser Word64) -> Parser Word64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"value")
  Word64
gamma <- Object
obj Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"seed" Parser Object -> (Object -> Parser Word64) -> Parser Word64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"gamma")
  Seq a
samples <- Object
obj Object -> Text -> Parser (Seq a)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"samples"
  (Seed, Seq a) -> Parser (Seed, Seq a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Word64 -> Seed
Seed Word64
value Word64
gamma, Seq a
samples)