servant-aeson-specs 0.4.1 → 0.5.0.0

raw patch · 10 files changed

+204/−508 lines, 10 filesdep +hspec-golden-aesondep +quickcheck-arbitrary-adtnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec-golden-aeson, quickcheck-arbitrary-adt

API changes (from Hackage documentation)

Files

• servant-aeson-specs.cabal +12/−11
• src/Servant/Aeson/GenericSpecs.hs +68/−51
• src/Servant/Aeson/Internal.hs +77/−39
• src/Test/Aeson/GenericSpecs.hs +0/−15
• src/Test/Aeson/Internal/GoldenSpecs.hs +0/−127
• src/Test/Aeson/Internal/RoundtripSpecs.hs +0/−59
• test/Servant/Aeson/GoldenSpecsSpec.hs +22/−4
• test/Servant/Aeson/RoundtripSpecsSpec.hs +25/−2
• test/Test/Aeson/GoldenSpecsSpec.hs +0/−102
• test/Test/Aeson/RoundtripSpecsSpec.hs +0/−98

@@ -1,15 +1,18 @@--- This file has been generated from package.yaml by hpack version 0.14.0.+-- This file has been generated from package.yaml by hpack version 0.14.1. -- -- see: https://github.com/sol/hpack  name:           servant-aeson-specs-version:        0.4.1+version:        0.5.0.0 synopsis:       generic tests for aeson serialization in servant description:    tests for aeson serialization in servant category:       Web+stability:      alpha homepage:       https://github.com/plow-technologies/servant-aeson-specs#readme bug-reports:    https://github.com/plow-technologies/servant-aeson-specs/issues-maintainer:     soenkehahn@gmail.com+author:         Sönke Hahn, James M.C. Haver II+maintainer:     soenkehahn@gmail.com, mchaver@gmail.com+copyright:      Plow Technologies license:        MIT license-file:   LICENSE build-type:     Simple@@ -34,12 +37,11 @@     , filepath     , random     , aeson-pretty+    , quickcheck-arbitrary-adt == 0.2.0.0+    , hspec-golden-aeson == 0.2.0.1   exposed-modules:       Servant.Aeson.GenericSpecs       Servant.Aeson.Internal-      Test.Aeson.GenericSpecs-      Test.Aeson.Internal.GoldenSpecs-      Test.Aeson.Internal.RoundtripSpecs   default-language: Haskell2010  test-suite spec@@ -60,6 +62,8 @@     , filepath     , random     , aeson-pretty+    , quickcheck-arbitrary-adt == 0.2.0.0+    , hspec-golden-aeson == 0.2.0.1     , hspec-core     , temporary     , doctest@@ -68,16 +72,13 @@     , quickcheck-instances     , string-conversions     , text+    , quickcheck-arbitrary-adt == 0.2.0.0+    , hspec-golden-aeson == 0.2.0.1   other-modules:       DoctestSpec       Servant.Aeson.GoldenSpecsSpec       Servant.Aeson.RoundtripSpecsSpec-      Test.Aeson.GoldenSpecsSpec-      Test.Aeson.RoundtripSpecsSpec       Test.Utils       Servant.Aeson.GenericSpecs       Servant.Aeson.Internal-      Test.Aeson.GenericSpecs-      Test.Aeson.Internal.GoldenSpecs-      Test.Aeson.Internal.RoundtripSpecs   default-language: Haskell2010

@@ -1,66 +1,83 @@+{-|+Module      : Servant.Aeson.GenericSpecs+Description : Expose some internal data and re-export useful dependencies+Copyright   : (c) Plow Technologies, 2016+License     : MIT+Maintainer  : soenkehahn@gmail.com, mchaver@gmail.com+Stability   : Alpha --- | If you're using [servant](http://haskell-servant.readthedocs.org/) with--- either [servant-client](http://hackage.haskell.org/package/servant-client)--- or [servant-server](http://hackage.haskell.org/package/servant-server) there--- will be types included in your APIs that servant will convert to and from--- JSON. (At least for most common APIs.) This module allows you to--- generically obtain test-suites for JSON serialization and deserialization of--- those types.------ Here's an example:------ >>> :set -XTypeOperators--- >>> :set -XDataKinds--- >>> :set -XDeriveGeneric------ >>> import Servant.API--- >>> import Test.Hspec (hspec)--- >>> import GHC.Generics (Generic)--- >>> import Data.Aeson (ToJSON, FromJSON)--- >>> import Test.QuickCheck (Arbitrary(..), oneof)------ >>> data Foo = Foo { a :: String, b :: Int } deriving (Eq, Show, Generic)--- >>> instance FromJSON Foo--- >>> instance ToJSON Foo--- >>> :{---   instance Arbitrary Foo where---     arbitrary = Foo <$> arbitrary <*> arbitrary--- :}------ >>> data Bar = BarA | BarB { bar :: Bool } deriving (Eq, Show, Generic)--- >>> instance FromJSON Bar--- >>> instance ToJSON Bar--- >>> :{---   instance Arbitrary Bar where---     arbitrary = oneof $---       pure BarA :---       (BarB <$> arbitrary) :---       []--- :}--------- >>> type Api = "post" :> ReqBody '[JSON] Foo :> Get '[JSON] Bar--- >>> let api = Proxy :: Proxy Api--- >>> hspec $ apiRoundtripSpecs api--- <BLANKLINE>--- JSON encoding of Bar---   allows to encode values with aeson and read them back--- JSON encoding of Foo---   allows to encode values with aeson and read them back--- <BLANKLINE>--- Finished in ... seconds--- 2 examples, 0 failures ++If you're using [servant](http://haskell-servant.readthedocs.org/) with+either [servant-client](http://hackage.haskell.org/package/servant-client)+or [servant-server](http://hackage.haskell.org/package/servant-server) there+will be types included in your APIs that servant will convert to and from+JSON. (At least for most common APIs.) This module allows you to+generically obtain test-suites for JSON serialization and deserialization of+those types.++Here's an example:++>>> :set -XTypeOperators+>>> :set -XDataKinds+>>> :set -XDeriveGeneric++>>> import Servant.API+>>> import Test.Hspec (hspec)+>>> import GHC.Generics (Generic)+>>> import Data.Aeson (ToJSON, FromJSON)+>>> import Test.QuickCheck (Arbitrary(..), oneof)++>>> data Foo = Foo { a :: String, b :: Int } deriving (Eq, Show, Generic)+>>> instance FromJSON Foo+>>> instance ToJSON Foo+>>> :{+  instance Arbitrary Foo where+    arbitrary = Foo <$> arbitrary <*> arbitrary+:}++>>> data Bar = BarA | BarB { bar :: Bool } deriving (Eq, Show, Generic)+>>> instance FromJSON Bar+>>> instance ToJSON Bar+>>> :{+  instance Arbitrary Bar where+    arbitrary = oneof $+      pure BarA :+      (BarB <$> arbitrary) :+      []+:}+++>>> type Api = "post" :> ReqBody '[JSON] Foo :> Get '[JSON] Bar+>>> let api = Proxy :: Proxy Api+>>> hspec $ apiRoundtripSpecs api+<BLANKLINE>+JSON encoding of Bar+  allows to encode values with aeson and read them back+JSON encoding of Foo+  allows to encode values with aeson and read them back+<BLANKLINE>+Finished in ... seconds+2 examples, 0 failures+-}+ module Servant.Aeson.GenericSpecs (   apiRoundtripSpecs,   apiGoldenSpecs,+  apiGoldenSpecsWithSettings,   apiSpecs,+  apiSpecsWithSettings,   usedTypes,    -- * re-exports   Proxy(..),+  GoldenDirectoryOption(..),+  Settings(..),+  defaultSettings, ) where  import           Data.Proxy  import           Servant.Aeson.Internal++import           Test.Aeson.GenericSpecs

@@ -1,3 +1,14 @@+{-|+Module      : Servant.Aeson.Internal+Description : Servant hspec test functions+Copyright   : (c) Plow Technologies, 2016+License     : MIT+Maintainer  : soenkehahn@gmail.com, mchaver@gmail.com+Stability   : Alpha++Internal module, use at your own risk.+-}+ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}@@ -7,7 +18,6 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} --- | Internal module, use at your own risk. module Servant.Aeson.Internal where  import           Data.Aeson@@ -22,142 +32,170 @@  import           Test.Aeson.Internal.GoldenSpecs import           Test.Aeson.Internal.RoundtripSpecs+import           Test.Aeson.GenericSpecs  -- | Allows to obtain roundtrip tests for JSON serialization for all types used--- in a [servant](http://haskell-servant.readthedocs.org/) api.+-- in a [servant](http://haskell-servant.readthedocs.org/) api. It uses settings+-- are not used in 'roundtripSpecs'. There is no need to let the user pass+-- cusomt settings. It automatically uses 'defaultSettings'. -- -- See also 'Test.Aeson.GenericSpecs.roundtripSpecs'. apiRoundtripSpecs :: (HasGenericSpecs api) => Proxy api -> Spec-apiRoundtripSpecs = sequence_ . map roundtrip . mkRoundtripSpecs+apiRoundtripSpecs = sequence_ . map roundtrip . mkRoundtripSpecs defaultSettings  -- | Allows to obtain golden tests for JSON serialization for all types used -- in a [servant](http://haskell-servant.readthedocs.org/) api. -- -- See also 'Test.Aeson.GenericSpecs.goldenSpecs'. apiGoldenSpecs :: HasGenericSpecs api => Proxy api -> Spec-apiGoldenSpecs proxy = sequence_ $ map golden $ mkRoundtripSpecs proxy+apiGoldenSpecs proxy = apiGoldenSpecsWithSettings defaultSettings proxy +-- | Same as 'apiGoldenSpecs', but allows custom settings.+apiGoldenSpecsWithSettings :: HasGenericSpecs api => Settings -> Proxy api -> Spec+apiGoldenSpecsWithSettings settings proxy = sequence_ $ map golden $ mkRoundtripSpecs settings proxy+ -- | Combination of 'apiRoundtripSpecs' and 'apiGoldenSpecs'. apiSpecs :: (HasGenericSpecs api) => Proxy api -> Spec-apiSpecs proxy = sequence_ $ map (\ ts -> roundtrip ts >> golden ts) $ mkRoundtripSpecs proxy+apiSpecs proxy = apiSpecsWithSettings defaultSettings proxy +-- | Same as 'apiSpecs', but allows custom settings.+apiSpecsWithSettings :: (HasGenericSpecs api) => Settings -> Proxy api -> Spec+apiSpecsWithSettings settings proxy = sequence_ $ map (\ ts -> roundtrip ts >> golden ts) $ mkRoundtripSpecs settings proxy+ -- | Allows to retrieve a list of all used types in a -- [servant](http://haskell-servant.readthedocs.org/) api as 'TypeRep's. usedTypes :: (HasGenericSpecs api) => Proxy api -> [TypeRep]-usedTypes = map typ . mkRoundtripSpecs+usedTypes = map typ . mkRoundtripSpecs defaultSettings -mkRoundtripSpecs :: (HasGenericSpecs api) => Proxy api -> [TypeSpec]-mkRoundtripSpecs = normalize . collectRoundtripSpecs+-- | Make roundtrip test for all the routes in an API, remove duplicates.+mkRoundtripSpecs :: (HasGenericSpecs api) => Settings -> Proxy api -> [TypeSpec]+mkRoundtripSpecs settings = normalize . collectRoundtripSpecs settings   where     normalize = nubBy ((==) `on` typ) . sortBy (compare `on` (show . typ)) +-- | Allows you to iterate over the routes of a Servant API class HasGenericSpecs api where-  collectRoundtripSpecs :: Proxy api -> [TypeSpec]+  collectRoundtripSpecs :: Settings -> Proxy api -> [TypeSpec] +-- | Match ':<|>'. instance (HasGenericSpecs a, HasGenericSpecs b) => HasGenericSpecs (a :<|> b) where-  collectRoundtripSpecs Proxy =-    collectRoundtripSpecs (Proxy :: Proxy a) ++-    collectRoundtripSpecs (Proxy :: Proxy b)+  collectRoundtripSpecs settings Proxy =+    collectRoundtripSpecs settings (Proxy :: Proxy a) +++    collectRoundtripSpecs settings (Proxy :: Proxy b)  -- * http methods  #if MIN_VERSION_servant(0, 5, 0)+-- | Servant >= 0.5.0, pattern match on 'StdMethod' and response with content,+-- make 'TypeSpec's. instance {-# OVERLAPPABLE #-}   (MkTypeSpecs response) =>   HasGenericSpecs (Verb (method :: StdMethod) returnStatus contentTypes response) where -  collectRoundtripSpecs Proxy = do-    mkTypeSpecs (Proxy :: Proxy response)+  collectRoundtripSpecs settings Proxy = do+    mkTypeSpecs settings (Proxy :: Proxy response) +-- | Servant >= 0.5.0, pattern match on 'StdMethod' and 'NoContent', make+-- 'TypeSpec's. instance {-# OVERLAPPING #-}   HasGenericSpecs (Verb (method :: StdMethod) returnStatus contentTypes NoContent) where -  collectRoundtripSpecs Proxy = []+  collectRoundtripSpecs _ Proxy = [] #else+-- | Servant < 0.5.0, match 'Get', make 'TypeSpec's. instance (MkTypeSpecs response) =>   HasGenericSpecs (Get contentTypes response) where -  collectRoundtripSpecs Proxy = do-    mkTypeSpecs (Proxy :: Proxy response)+  collectRoundtripSpecs settings Proxy = do+    mkTypeSpecs settings (Proxy :: Proxy response) +-- | Servant < 0.5.0, match 'Post', make 'TypeSpec's. instance (MkTypeSpecs response) =>   HasGenericSpecs (Post contentTypes response) where -  collectRoundtripSpecs Proxy = mkTypeSpecs (Proxy :: Proxy response)+  collectRoundtripSpecs settings Proxy = mkTypeSpecs settings (Proxy :: Proxy response) #endif  -- * combinators +-- | Match 'ReqBody' and ':>'. instance (MkTypeSpecs body, HasGenericSpecs api) =>   HasGenericSpecs (ReqBody contentTypes body :> api) where -  collectRoundtripSpecs Proxy =-    mkTypeSpecs (Proxy :: Proxy body) ++-    collectRoundtripSpecs (Proxy :: Proxy api)+  collectRoundtripSpecs settings Proxy =+    mkTypeSpecs settings (Proxy :: Proxy body) +++    collectRoundtripSpecs settings (Proxy :: Proxy api) +-- | Match 'Symbol' and ':>'. instance HasGenericSpecs api => HasGenericSpecs ((path :: Symbol) :> api) where-  collectRoundtripSpecs Proxy = collectRoundtripSpecs (Proxy :: Proxy api)+  collectRoundtripSpecs settings Proxy = collectRoundtripSpecs settings (Proxy :: Proxy api)  #if !MIN_VERSION_servant(0, 5, 0)+-- | Servant < 0.5.0, match 'MatrixParam' and ':>'. instance HasGenericSpecs api => HasGenericSpecs (MatrixParam name a :> api) where-  collectRoundtripSpecs Proxy = collectRoundtripSpecs (Proxy :: Proxy api)+  collectRoundtripSpecs settings Proxy = collectRoundtripSpecs settings (Proxy :: Proxy api) #endif -data TypeSpec-  = TypeSpec {-    typ :: TypeRep,-    roundtrip :: Spec,-    golden :: Spec-  }+-- | Data type to for holding tests and type representation of each route in a+-- Servant API. A function can be used to pick which tests to run and return+-- the type name for reference.+data TypeSpec = TypeSpec {+  typ       :: TypeRep+, roundtrip :: Spec+, golden    :: Spec+} --- 'mkTypeSpecs' has to be implemented as a method of a separate class, because we+-- | 'mkTypeSpecs' has to be implemented as a method of a separate class, because we -- want to be able to have a specialized implementation for lists. class MkTypeSpecs a where-  mkTypeSpecs :: Proxy a -> [TypeSpec]+  mkTypeSpecs :: Settings -> Proxy a -> [TypeSpec] +-- | Test JSON Serialization for non-wrapped types. instance (Typeable a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) => MkTypeSpecs a where -  mkTypeSpecs proxy = pure $+  mkTypeSpecs settings proxy = pure $     TypeSpec {       typ = typeRep proxy,       roundtrip = roundtripSpecs proxy,-      golden = goldenSpecs proxy+      golden = goldenSpecs settings proxy     }  -- The following instances will only test json serialization of element types. -- As we trust aeson to do the right thing for standard container types, we -- don't need to test that. (This speeds up test suites immensely.) +-- | Test JSON serialization for '[]' types. instance {-# OVERLAPPING #-}   (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>   MkTypeSpecs [a] where -  mkTypeSpecs Proxy = pure $+  mkTypeSpecs settings Proxy = pure $     TypeSpec {       typ = typeRep proxy,       roundtrip = genericAesonRoundtripWithNote proxy (Just note),-      golden = goldenSpecsWithNote proxy (Just note)+      golden = goldenSpecsWithNote settings proxy (Just note)     }     where       proxy = Proxy :: Proxy a       note = "(as element-type in [])" +-- | Test JSON serialization for 'Maybe' types. instance {-# OVERLAPPING #-}   (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>   MkTypeSpecs (Maybe a) where -  mkTypeSpecs Proxy = pure $+  mkTypeSpecs settings Proxy = pure $     TypeSpec {       typ = typeRep proxy,       roundtrip = genericAesonRoundtripWithNote proxy (Just note),-      golden = goldenSpecsWithNote proxy (Just note)+      golden = goldenSpecsWithNote settings proxy (Just note)     }     where       proxy = Proxy :: Proxy a       note = "(as element-type in Maybe)" --- We trust aeson to be correct for ().+-- | We trust aeson to be correct for (). instance {-# OVERLAPPING #-}   MkTypeSpecs () where -  mkTypeSpecs Proxy = []+  mkTypeSpecs _ Proxy = []

@@ -1,15 +0,0 @@--module Test.Aeson.GenericSpecs (-  roundtripSpecs,-  goldenSpecs,--  shouldBeIdentity,--  -- * re-exports-  Proxy(..),-) where--import           Data.Proxy--import           Test.Aeson.Internal.GoldenSpecs-import           Test.Aeson.Internal.RoundtripSpecs

@@ -1,127 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--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           GHC.Generics-import           Prelude hiding (readFile, writeFile)-import           System.Directory-import           System.FilePath-import           System.Random-import           Test.Hspec-import           Test.QuickCheck-import           Test.QuickCheck.Gen-import           Test.QuickCheck.Random--import           Test.Aeson.Internal.RoundtripSpecs---- | Allows to obtain tests that will try to ensure that the JSON encoding--- didn't change unintentionally. To this end 'goldenSpecs' will------ - write a file @golden.json/TYPENAME.json@ in the current directory---   containing a number of JSON-encoded sample values,--- - during subsequent tests it will encode the same sample values again and---   compare them with the saved golden encodings,--- - on failure it will create a file @golden.json/TYPENAME.faulty.json@ for---   easy manual inspection.------ You can consider putting the golden files under revision control. That way--- it'll be obvious when JSON encodings change.-goldenSpecs :: (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>-  Proxy a -> Spec-goldenSpecs proxy = goldenSpecsWithNote proxy Nothing--goldenSpecsWithNote :: (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>-  Proxy a -> Maybe String -> Spec-goldenSpecsWithNote proxy mNote = do-  let goldenFile = mkGoldenFile proxy-      note = maybe "" (" " ++) mNote-  describe ("JSON encoding of " ++ addBrackets (show (typeRep proxy)) ++ note) $ do-    it ("produces the same JSON as is found in " ++ goldenFile) $ do-      exists <- doesFileExist goldenFile-      if exists-        then compareWithGolden proxy goldenFile-        else createGoldenfile 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) =>-  Proxy a -> FilePath -> IO ()-createGoldenfile proxy goldenFile = do-  createDirectoryIfMissing True (takeDirectory goldenFile)-  seed <- randomIO-  samples <- mkRandomSamples proxy seed-  writeFile goldenFile (encodePretty samples)-  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."--setSeed :: Int -> Gen a -> Gen a-setSeed seed (MkGen g) = MkGen $ \ _randomSeed size ->-  g (mkQCGen seed) size--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-  newSamples <- mkRandomSamples proxy goldenSeed-  whenFails (writeComparisonFile newSamples) $ do-    goldenSamples :: RandomSamples a <--      either (throwIO . ErrorCall) return =<<-      eitherDecode' <$>-      readFile goldenFile-    newSamples `shouldBe` goldenSamples-  where-    whenFails :: forall a b . IO b -> IO a -> IO a-    whenFails = flip onException--    writeComparisonFile newSamples = do-      writeFile (mkFaultyFile proxy) (encodePretty newSamples)-      putStrLn $-        "\n" ++-        "INFO: Written the current encodings into " ++ mkFaultyFile proxy ++ "."---- reads the seed without looking at the samples-readSeed :: ByteString -> IO Int-readSeed s = case eitherDecode s :: Either String (RandomSamples Value) of-  Right samples -> return $ seed samples-  Left err -> throwIO $ ErrorCall err---- * RandomSamples--data RandomSamples a-  = RandomSamples {-    seed :: Int,-    samples :: [a]-  }-  deriving (Eq, Ord, Show, Generic)--instance FromJSON a => FromJSON (RandomSamples a)--instance ToJSON a => ToJSON (RandomSamples a)--mkRandomSamples :: forall a . Arbitrary a =>-  Proxy a -> Int -> IO (RandomSamples a)-mkRandomSamples Proxy seed = do-  let gen :: Gen [a]-      gen = setSeed seed $ do-        replicateM 200 (arbitrary :: Gen a)-  RandomSamples seed <$> generate gen

@@ -1,59 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}---- | Internal module, use at your own risk.-module Test.Aeson.Internal.RoundtripSpecs where--import           Control.Arrow-import           Control.Exception-import qualified Data.Aeson as Aeson-import           Data.Aeson as Aeson hiding (encode)-import           Data.ByteString.Lazy (ByteString)-import           Data.Typeable-import           Test.Hspec-import           Test.QuickCheck---- | Allows to obtain a roundtrip test to check whether values of the given type--- can be successfully converted to JSON and back.------ 'roundtripSpecs' will------ - create random values (using 'Arbitrary'),--- - convert them into JSON (using 'ToJSON'),--- - read them back into Haskell (using 'FromJSON') and--- - make sure that the result is the same as the value it started with---   (using 'Eq').-roundtripSpecs :: forall a .-  (Typeable a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) =>-  Proxy a -> Spec-roundtripSpecs proxy = genericAesonRoundtripWithNote proxy Nothing--genericAesonRoundtripWithNote :: forall a .-  (Typeable a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) =>-  Proxy a -> Maybe String -> Spec-genericAesonRoundtripWithNote proxy mNote = do-  let note = maybe "" (" " ++) mNote-  describe ("JSON encoding of " ++ addBrackets (show (typeRep proxy)) ++ note) $ do-    it "allows to encode values with aeson and read them back" $ do-      shouldBeIdentity proxy $-        Aeson.encode >>> aesonDecodeIO--addBrackets :: String -> String-addBrackets s =-  if ' ' `elem` s-    then "(" ++ s ++ ")"-    else s---- | [hspec](http://hspec.github.io/) style combinator to easily write tests--- that check the a given operation returns the same value it was given, e.g.--- roundtrip tests.-shouldBeIdentity :: (Eq a, Show a, Arbitrary a) =>-  Proxy a -> (a -> IO a) -> Property-shouldBeIdentity Proxy function =-  property $ \ (a :: a) -> do-    function a `shouldReturn` a--aesonDecodeIO :: FromJSON a => ByteString -> IO a-aesonDecodeIO bs = case eitherDecode bs of-  Right a -> return a-  Left msg -> throwIO $ ErrorCall-    ("aeson couldn't parse value: " ++ msg)

@@ -3,6 +3,7 @@ module Servant.Aeson.GoldenSpecsSpec where  import           Data.Proxy+import           Servant.Aeson.GenericSpecs import           Servant.API import           System.Directory import           Test.Hspec@@ -10,7 +11,6 @@ import           Test.Mockery.Directory import           Test.Utils -import           Servant.Aeson.GenericSpecs  spec :: Spec spec = do@@ -18,11 +18,29 @@     it "writes files for used types" $ do       inTempDirectory $ do         _ <- hspecSilently $ apiGoldenSpecs (Proxy :: Proxy (Get '[JSON] Bool))-        doesFileExist "golden.json/Bool.json" `shouldReturn` True+        doesFileExist "golden/Bool.json" `shouldReturn` True      it "raises errors for non-matching golden files" $ do       inTempDirectory $ do-        createDirectoryIfMissing True "golden.json"-        writeFile "golden.json/Bool.json" "foo"+        createDirectoryIfMissing True "golden"+        writeFile "golden/Bool.json" "foo"         apiGoldenSpecs (Proxy :: Proxy (Get '[JSON] Bool)) `shouldTestAs`+          Summary 1 1++  describe "apiGoldenSpecsWithSettings" $ do+    it "writes files for used types" $ do+      inTempDirectory $ do+        _ <- hspecSilently $ apiGoldenSpecsWithSettings (defaultSettings {goldenDirectoryOption = CustomDirectoryName "json-testing"}) (Proxy :: Proxy (Get '[JSON] Bool))+        doesFileExist "json-testing/Bool.json" `shouldReturn` True++    it "can write files using the module name in the directory" $ do+      inTempDirectory $ do+        _ <- hspecSilently $ apiGoldenSpecsWithSettings (defaultSettings {useModuleNameAsSubDirectory = True}) (Proxy :: Proxy (Get '[JSON] Bool))+        doesFileExist "golden/GHC.Types/Bool.json" `shouldReturn` True++    it "raises errors for non-matching golden files" $ do+      inTempDirectory $ do+        createDirectoryIfMissing True "json-testing"+        writeFile "json-testing/Bool.json" "foo"+        apiGoldenSpecsWithSettings (defaultSettings {goldenDirectoryOption = CustomDirectoryName "json-testing"}) (Proxy :: Proxy (Get '[JSON] Bool)) `shouldTestAs`           Summary 1 1

@@ -1,11 +1,15 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-}  module Servant.Aeson.RoundtripSpecsSpec where +import           Data.Aeson import           Data.List import           Data.Typeable+import           GHC.Generics import           Servant.API import           System.Directory import           System.IO@@ -13,9 +17,8 @@ import           Test.Hspec import           Test.Hspec.Core.Runner import           Test.Mockery.Directory-+import           Test.QuickCheck import           Servant.Aeson.GenericSpecs-import           Test.Aeson.RoundtripSpecsSpec import           Test.Utils  -- ignores the Summary@@ -136,3 +139,23 @@ #else noContentTest = return () #endif+++-- | Type where roundtrips don't work.+data FaultyRoundtrip+  = FaultyRoundtrip {+    faultyRoundtripFoo :: String,+    faultyRoundtripBar :: Int+  }+  deriving (Show, Eq, Generic)++instance ToJSON FaultyRoundtrip where+  toJSON x = object $+    "foo" .= faultyRoundtripFoo x :+    "bar" .= faultyRoundtripBar x :+    []++instance FromJSON FaultyRoundtrip++instance Arbitrary FaultyRoundtrip where+  arbitrary = FaultyRoundtrip <$> arbitrary <*> arbitrary

@@ -1,102 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Test.Aeson.GoldenSpecsSpec where--import           Control.Exception-import           Data.Aeson-import           Data.Aeson.Encode.Pretty-import           Data.ByteString.Lazy as DBL (readFile, writeFile)-import           Data.List-import           Data.Proxy-import           Data.String.Conversions-import           Data.Text (Text)-import           Prelude hiding (readFile, writeFile, putStrLn)-import           System.Directory-import           Test.Hspec-import           Test.Mockery.Directory-import           Test.QuickCheck.Instances ()--import           Test.Aeson.Internal.GoldenSpecs-import           Test.Utils--textP :: Proxy Text-textP = Proxy--spec :: Spec-spec = do-  describe "goldenSpecs" $ do-    around_ inTempDirectory $ do-      context "when invoked for the first time" $ do-        it "creates passing tests" $ do-          goldenSpecs textP `shouldProduceFailures` 0--        it "writes a golden file" $ do-          _ <- hspecSilently $ goldenSpecs textP-          doesFileExist "golden.json/Text.json" `shouldReturn` True--        it "writes a seed and a list of values into a golden file" $ do-          _ <- hspecSilently $ goldenSpecs textP-          contents <- readFile "golden.json/Text.json"-          case decode' contents :: Maybe (RandomSamples String) of-            Nothing -> throwIO $ ErrorCall "decoding error"-            Just _ -> return ()--        it "warns about not testing anything" $ do-          (_, output) <- hspecSilently $ goldenSpecs textP-          output `shouldContain`-            "WARNING: Running for the first time, not testing anything"--        it "writes JSON pretty-printed" $ do-          _ <- hspecSilently $ goldenSpecs textP-          samplesString <- readFile "golden.json/Text.json"-          samples :: RandomSamples Text <--            either (throwIO . ErrorCall) return-            (eitherDecode samplesString)-          let prefix = unlines $-                 "{" :-                ("    \"seed\": " ++ show (seed samples) ++ ",") :-                 "    \"samples\": [" :-                []-          cs samplesString `shouldStartWith` prefix--      context "when invoked for the second time" $ do-        it "creates passing tests for correct encodings" $ do-          _ <- hspecSilently $ goldenSpecs textP-          goldenSpecs textP `shouldProduceFailures` 0--        it "creates failing tests for incorrect encodings of RandomSamples" $ do-          createDirectoryIfMissing True "golden.json"-          writeFile "golden.json/Text.json" "foo"-          goldenSpecs textP `shouldProduceFailures` 1--        context "when encodings changed" $ do-          it "creates failing tests for incorrect encodings of elements" $ do-            createGoldenfile (Proxy :: Proxy Int) "golden.json/Text.json"-            goldenSpecs textP `shouldProduceFailures` 1--          let createFaultySamples = do-                createDirectoryIfMissing True "golden.json"-                let faultySamples :: RandomSamples Text-                    faultySamples = RandomSamples 42 (take 200 (cycle ["foo", "bar"]))-                writeFile "golden.json/Text.json" (encode faultySamples)--          it "creates failing tests for correct encodings of wrong values" $ do-            createFaultySamples-            goldenSpecs textP `shouldProduceFailures` 1--          it "writes a new file for easy manual comparison" $ do-            createDirectoryIfMissing True "golden.json"-            let faultySamples :: RandomSamples Int-                faultySamples = RandomSamples 42 (take 200 [1 ..])-            writeFile "golden.json/Text.json" (encode faultySamples)-            _ <- hspecSilently $ goldenSpecs textP--            testSeedSamples <- mkRandomSamples textP 42-            readFile "golden.json/Text.faulty.json" `shouldReturn`-              encodePretty testSeedSamples--          it "mentions the created file in the output" $ do-            createFaultySamples-            (_, output) <- hspecSilently $ goldenSpecs textP-            output `shouldContain` "golden.json/Text.faulty.json"

@@ -1,98 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}--module Test.Aeson.RoundtripSpecsSpec where--import           Control.Applicative-import           Data.Aeson-import           GHC.Generics-import           Test.Hspec-import           Test.Hspec.Core.Runner-import           Test.QuickCheck--import           Test.Aeson.GenericSpecs-import           Test.Utils--spec :: Spec-spec = do-  describe "roundtripSpecs" $ do-    it "detects incompatible json encodings" $ do-      roundtripSpecs faultyRoundtripProxy `shouldTestAs` Summary 1 1--    context "when used with compatible encodings" $ do-      it "creates passing tests" $ do-        roundtripSpecs correctProxy `shouldTestAs` Summary 1 0--      it "creates passing tests for sum types" $ do-        roundtripSpecs correctSumProxy `shouldTestAs` Summary 1 0---- | Type where roundtrips don't work.-data FaultyRoundtrip-  = FaultyRoundtrip {-    faultyRoundtripFoo :: String,-    faultyRoundtripBar :: Int-  }-  deriving (Show, Eq, Generic)--faultyRoundtripProxy :: Proxy FaultyRoundtrip-faultyRoundtripProxy = Proxy--instance ToJSON FaultyRoundtrip where-  toJSON x = object $-    "foo" .= faultyRoundtripFoo x :-    "bar" .= faultyRoundtripBar x :-    []--instance FromJSON FaultyRoundtrip--instance Arbitrary FaultyRoundtrip where-  arbitrary = FaultyRoundtrip <$> arbitrary <*> arbitrary--data Correct-  = Correct {-    correctFoo :: String,-    correctBar :: String-  }-  deriving (Show, Eq, Generic)--correctProxy :: Proxy Correct-correctProxy = Proxy--instance ToJSON Correct--instance FromJSON Correct--instance Arbitrary Correct where-  arbitrary = Correct <$> arbitrary <*> arbitrary--data CorrectSum-  = Foo {-    correctSumFoo :: String-  }-  | Bar {-    correctSumFoo :: String,-    correctSumBar :: String-  }-  deriving (Show, Eq, Generic)--correctSumProxy :: Proxy CorrectSum-correctSumProxy = Proxy--instance ToJSON CorrectSum where-  toJSON = \ case-    Foo foo -> object ["Foo" .= foo]-    Bar foo bar -> object-      ["Bar" .= object ["correctSumFoo" .= foo, "correctSumBar" .= bar]]--instance FromJSON CorrectSum where-  parseJSON = withObject "CorrectSum" $ \ o ->-    (Foo <$> o .: "Foo") <|>-    (o .: "Bar" >>= \ dict ->-      Bar <$> dict .: "correctSumFoo" <*> dict .: "correctSumBar")--instance Arbitrary CorrectSum where-  arbitrary = oneof $-    (Foo <$> arbitrary) :-    (Bar <$> arbitrary <*> arbitrary) :-    []