diff --git a/servant-aeson-specs.cabal b/servant-aeson-specs.cabal --- a/servant-aeson-specs.cabal +++ b/servant-aeson-specs.cabal @@ -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 diff --git a/src/Servant/Aeson/GenericSpecs.hs b/src/Servant/Aeson/GenericSpecs.hs --- a/src/Servant/Aeson/GenericSpecs.hs +++ b/src/Servant/Aeson/GenericSpecs.hs @@ -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 --- --- 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 --- --- 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 + +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 + +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 diff --git a/src/Servant/Aeson/Internal.hs b/src/Servant/Aeson/Internal.hs --- a/src/Servant/Aeson/Internal.hs +++ b/src/Servant/Aeson/Internal.hs @@ -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 = [] diff --git a/src/Test/Aeson/GenericSpecs.hs b/src/Test/Aeson/GenericSpecs.hs deleted file mode 100644 --- a/src/Test/Aeson/GenericSpecs.hs +++ /dev/null @@ -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 diff --git a/src/Test/Aeson/Internal/GoldenSpecs.hs b/src/Test/Aeson/Internal/GoldenSpecs.hs deleted file mode 100644 --- a/src/Test/Aeson/Internal/GoldenSpecs.hs +++ /dev/null @@ -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 diff --git a/src/Test/Aeson/Internal/RoundtripSpecs.hs b/src/Test/Aeson/Internal/RoundtripSpecs.hs deleted file mode 100644 --- a/src/Test/Aeson/Internal/RoundtripSpecs.hs +++ /dev/null @@ -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) diff --git a/test/Servant/Aeson/GoldenSpecsSpec.hs b/test/Servant/Aeson/GoldenSpecsSpec.hs --- a/test/Servant/Aeson/GoldenSpecsSpec.hs +++ b/test/Servant/Aeson/GoldenSpecsSpec.hs @@ -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 diff --git a/test/Servant/Aeson/RoundtripSpecsSpec.hs b/test/Servant/Aeson/RoundtripSpecsSpec.hs --- a/test/Servant/Aeson/RoundtripSpecsSpec.hs +++ b/test/Servant/Aeson/RoundtripSpecsSpec.hs @@ -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 diff --git a/test/Test/Aeson/GoldenSpecsSpec.hs b/test/Test/Aeson/GoldenSpecsSpec.hs deleted file mode 100644 --- a/test/Test/Aeson/GoldenSpecsSpec.hs +++ /dev/null @@ -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" diff --git a/test/Test/Aeson/RoundtripSpecsSpec.hs b/test/Test/Aeson/RoundtripSpecsSpec.hs deleted file mode 100644 --- a/test/Test/Aeson/RoundtripSpecsSpec.hs +++ /dev/null @@ -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) : - []