module Test.Aeson.Internal.GoldenSpecs where
import Control.Exception
import Control.Monad
import Data.Aeson
import Data.Aeson.Encode.Pretty
import Data.ByteString.Lazy hiding (putStrLn)
import Data.Proxy
import Data.Typeable
import Prelude hiding (readFile, writeFile)
import System.Directory
import System.FilePath
import System.Random
import Test.Aeson.Internal.RandomSamples
import Test.Aeson.Internal.Utils
import Test.Hspec
import Test.QuickCheck
goldenSpecs :: (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>
Int -> Proxy a -> Spec
goldenSpecs sampleSize proxy = goldenSpecsWithNote sampleSize proxy Nothing
goldenSpecsWithNote :: (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>
Int -> Proxy a -> Maybe String -> Spec
goldenSpecsWithNote sampleSize proxy mNote = do
let goldenFile = mkGoldenFile proxy
note = maybe "" (" " ++) mNote
describe ("JSON encoding of " ++ addBrackets (show (typeRep proxy)) ++ note) $
it ("produces the same JSON as is found in " ++ goldenFile) $ do
exists <- doesFileExist goldenFile
if exists
then compareWithGolden proxy goldenFile
else createGoldenfile sampleSize proxy goldenFile
mkGoldenFile :: Typeable a => Proxy a -> FilePath
mkGoldenFile proxy =
"golden.json" </> show (typeRep proxy) <.> "json"
mkFaultyFile :: Typeable a => Proxy a -> FilePath
mkFaultyFile proxy =
"golden.json" </> show (typeRep proxy) <.> "faulty" <.> "json"
createGoldenfile :: forall a . (Show a, Arbitrary a, ToJSON a) =>
Int -> Proxy a -> FilePath -> IO ()
createGoldenfile sampleSize proxy goldenFile = do
createDirectoryIfMissing True (takeDirectory goldenFile)
rSeed <- randomIO
rSamples <- mkRandomSamples sampleSize proxy rSeed
writeFile goldenFile (encodePretty rSamples)
putStrLn $
"\n" ++
"WARNING: Running for the first time, not testing anything.\n" ++
" Created " ++ goldenFile ++ " containing random samples,\n" ++
" will compare JSON encodings with this from now on.\n" ++
" Please, consider putting " ++ goldenFile ++ " under version control."
compareWithGolden :: forall a .
(Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>
Proxy a -> FilePath -> IO ()
compareWithGolden proxy goldenFile = do
goldenSeed <- readSeed =<< readFile goldenFile
sampleSize <- readSampleSize =<< readFile goldenFile
newSamples <- mkRandomSamples sampleSize proxy goldenSeed
whenFails (writeComparisonFile newSamples) $ do
goldenSamples :: RandomSamples a <-
either (throwIO . ErrorCall) return =<<
eitherDecode' <$>
readFile goldenFile
newSamples `shouldBe` goldenSamples
where
whenFails :: forall b c . IO c -> IO b -> IO b
whenFails = flip onException
writeComparisonFile newSamples = do
writeFile (mkFaultyFile proxy) (encodePretty newSamples)
putStrLn $
"\n" ++
"INFO: Written the current encodings into " ++ mkFaultyFile proxy ++ "."
mkRandomSamples :: forall a . Arbitrary a =>
Int -> Proxy a -> Int -> IO (RandomSamples a)
mkRandomSamples sampleSize Proxy rSeed = RandomSamples rSeed <$> generate gen
where
correctedSampleSize = if sampleSize <= 0 then 1 else sampleSize
gen :: Gen [a]
gen = setSeed rSeed $ replicateM correctedSampleSize (arbitrary :: Gen a)