packages feed

servant-aeson-specs 0.1 → 0.2

raw patch · 16 files changed

+642/−267 lines, 16 filesdep +aeson-prettydep +directorydep +filepath

Dependencies added: aeson-pretty, directory, filepath, mockery, quickcheck-instances, random, silently, string-conversions, text

Files

servant-aeson-specs.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           servant-aeson-specs-version:        0.1+version:        0.2 synopsis:       generic tests for aeson serialization in servant description:    tests for aeson serialization in servant category:       Web@@ -30,11 +30,16 @@     , hspec     , QuickCheck     , servant == 0.4.*+    , directory+    , filepath+    , random+    , aeson-pretty   exposed-modules:-      Servant.Aeson.RoundtripSpecs-      Servant.Aeson.RoundtripSpecs.Internal-      Test.Aeson.RoundtripSpecs-      Test.Aeson.RoundtripSpecs.Internal+      Servant.Aeson.GenericSpecs+      Servant.Aeson.Internal+      Test.Aeson.GenericSpecs+      Test.Aeson.Internal.GoldenSpecs+      Test.Aeson.Internal.RoundtripSpecs   default-language: Haskell2010  test-suite spec@@ -51,15 +56,28 @@     , hspec     , QuickCheck     , servant == 0.4.*+    , directory+    , filepath+    , random+    , aeson-pretty     , hspec-core     , temporary     , doctest+    , mockery+    , silently+    , quickcheck-instances+    , string-conversions+    , text   other-modules:       DoctestSpec+      Servant.Aeson.GoldenSpecsSpec       Servant.Aeson.RoundtripSpecsSpec+      Test.Aeson.GoldenSpecsSpec       Test.Aeson.RoundtripSpecsSpec-      Servant.Aeson.RoundtripSpecs-      Servant.Aeson.RoundtripSpecs.Internal-      Test.Aeson.RoundtripSpecs-      Test.Aeson.RoundtripSpecs.Internal+      Test.Utils+      Servant.Aeson.GenericSpecs+      Servant.Aeson.Internal+      Test.Aeson.GenericSpecs+      Test.Aeson.Internal.GoldenSpecs+      Test.Aeson.Internal.RoundtripSpecs   default-language: Haskell2010
+ src/Servant/Aeson/GenericSpecs.hs view
@@ -0,0 +1,66 @@++-- | 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,+  apiSpecs,+  usedTypes,++  -- * re-exports+  Proxy(..),+) where++import           Data.Proxy++import           Servant.Aeson.Internal
+ src/Servant/Aeson/Internal.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Internal module, use at your own risk.+module Servant.Aeson.Internal where++import           Data.Aeson+import           Data.Function+import           Data.List+import           Data.Proxy+import           Data.Typeable+import           GHC.TypeLits+import           Servant.API+import           Test.Hspec+import           Test.QuickCheck++import           Test.Aeson.Internal.GoldenSpecs+import           Test.Aeson.Internal.RoundtripSpecs++-- | Allows to obtain roundtrip tests for JSON serialization for all types used+-- in a [servant](http://haskell-servant.readthedocs.org/) api.+--+-- See also 'Test.Aeson.GenericSpecs.roundtripSpecs'.+apiRoundtripSpecs :: (HasGenericSpecs api) => Proxy api -> Spec+apiRoundtripSpecs = sequence_ . map roundtrip . mkRoundtripSpecs++-- | 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++-- | Combination of 'apiRoundtripSpecs' and 'apiGoldenSpecs'.+apiSpecs :: (HasGenericSpecs api) => Proxy api -> Spec+apiSpecs proxy = sequence_ $ map (\ ts -> roundtrip ts >> golden ts) $ mkRoundtripSpecs 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++mkRoundtripSpecs :: (HasGenericSpecs api) => Proxy api -> [TypeSpec]+mkRoundtripSpecs = normalize . collectRoundtripSpecs+  where+    normalize = nubBy ((==) `on` typ) . sortBy (compare `on` (show . typ))++class HasGenericSpecs api where+  collectRoundtripSpecs :: Proxy api -> [TypeSpec]++instance (HasGenericSpecs a, HasGenericSpecs b) => HasGenericSpecs (a :<|> b) where+  collectRoundtripSpecs Proxy =+    collectRoundtripSpecs (Proxy :: Proxy a) +++    collectRoundtripSpecs (Proxy :: Proxy b)++instance (MkTypeSpecs response) =>+  HasGenericSpecs (Get contentTypes response) where++  collectRoundtripSpecs Proxy = do+    mkTypeSpecs (Proxy :: Proxy response)++instance (MkTypeSpecs response) =>+  HasGenericSpecs (Post contentTypes response) where++  collectRoundtripSpecs Proxy = mkTypeSpecs (Proxy :: Proxy response)++instance (MkTypeSpecs body, HasGenericSpecs api) =>+  HasGenericSpecs (ReqBody contentTypes body :> api) where++  collectRoundtripSpecs Proxy =+    mkTypeSpecs (Proxy :: Proxy body) +++    collectRoundtripSpecs (Proxy :: Proxy api)++instance HasGenericSpecs api => HasGenericSpecs ((path :: Symbol) :> api) where+  collectRoundtripSpecs Proxy = collectRoundtripSpecs (Proxy :: Proxy api)++instance HasGenericSpecs api => HasGenericSpecs (MatrixParam name a :> api) where+  collectRoundtripSpecs Proxy = collectRoundtripSpecs (Proxy :: Proxy api)++data TypeSpec+  = TypeSpec {+    typ :: TypeRep,+    roundtrip :: Spec,+    golden :: Spec+  }++-- '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]++instance (Typeable a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) => MkTypeSpecs a where++  mkTypeSpecs proxy = pure $+    TypeSpec {+      typ = typeRep proxy,+      roundtrip = roundtripSpecs proxy,+      golden = goldenSpecs 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.)++instance {-# OVERLAPPING #-}+  (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>+  MkTypeSpecs [a] where++  mkTypeSpecs Proxy = pure $+    TypeSpec {+      typ = typeRep proxy,+      roundtrip = genericAesonRoundtripWithNote proxy (Just note),+      golden = goldenSpecsWithNote proxy (Just note)+    }+    where+      proxy = Proxy :: Proxy a+      note = "(as element-type in [])"++instance {-# OVERLAPPING #-}+  (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>+  MkTypeSpecs (Maybe a) where++  mkTypeSpecs Proxy = pure $+    TypeSpec {+      typ = typeRep proxy,+      roundtrip = genericAesonRoundtripWithNote proxy (Just note),+      golden = goldenSpecsWithNote proxy (Just note)+    }+    where+      proxy = Proxy :: Proxy a+      note = "(as element-type in Maybe)"++-- We trust aeson to be correct for ().+instance {-# OVERLAPPING #-}+  MkTypeSpecs () where++  mkTypeSpecs Proxy = []
− src/Servant/Aeson/RoundtripSpecs.hs 
@@ -1,63 +0,0 @@---- | 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.) 'roundtripSpecs' allows you to--- generically obtain a test-suite, that makes sure for those types, that they--- can be serialized to JSON and read back to Haskell successfully.------ 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 $ roundtripSpecs 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.RoundtripSpecs (-  roundtripSpecs,-  usedTypes,--  -- * re-exports-  Proxy(..),-) where--import           Data.Proxy--import           Servant.Aeson.RoundtripSpecs.Internal
− src/Servant/Aeson/RoundtripSpecs/Internal.hs 
@@ -1,92 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}---- | Internal module, use at your own risk.-module Servant.Aeson.RoundtripSpecs.Internal where--import           Data.Aeson-import           Data.Function-import           Data.List-import           Data.Proxy-import           Data.Typeable-import           GHC.TypeLits-import           Servant.API-import           Test.Hspec-import           Test.QuickCheck--import           Test.Aeson.RoundtripSpecs.Internal---- | Allows to obtain roundtrip tests for JSON serialization for all types used--- in a [servant](http://haskell-servant.readthedocs.org/) api.------ See also 'Test.Aeson.RoundtripSpecs.genericAesonRoundtrip'.-roundtripSpecs :: (HasRoundtripSpecs api) => Proxy api -> Spec-roundtripSpecs = sequence_ . map snd . mkRoundtripSpecs---- | Allows to retrieve a list of all used types in a--- [servant](http://haskell-servant.readthedocs.org/) api as 'TypeRep's.-usedTypes :: (HasRoundtripSpecs api) => Proxy api -> [TypeRep]-usedTypes = map fst . mkRoundtripSpecs--mkRoundtripSpecs :: (HasRoundtripSpecs api) => Proxy api -> [(TypeRep, Spec)]-mkRoundtripSpecs = normalize . collectRoundtripSpecs-  where-    normalize = nubBy ((==) `on` fst) . sortBy (compare `on` (show . fst))--class HasRoundtripSpecs api where-  collectRoundtripSpecs :: Proxy api -> [(TypeRep, Spec)]--instance (HasRoundtripSpecs a, HasRoundtripSpecs b) => HasRoundtripSpecs (a :<|> b) where-  collectRoundtripSpecs Proxy =-    collectRoundtripSpecs (Proxy :: Proxy a) ++-    collectRoundtripSpecs (Proxy :: Proxy b)--instance (MkSpec response) =>-  HasRoundtripSpecs (Get contentTypes response) where--  collectRoundtripSpecs Proxy = do-    mkSpec (Proxy :: Proxy response)--instance (MkSpec response) =>-  HasRoundtripSpecs (Post contentTypes response) where--  collectRoundtripSpecs Proxy = mkSpec (Proxy :: Proxy response)--instance (MkSpec body, HasRoundtripSpecs api) =>-  HasRoundtripSpecs (ReqBody contentTypes body :> api) where--  collectRoundtripSpecs Proxy =-    mkSpec (Proxy :: Proxy body) ++-    collectRoundtripSpecs (Proxy :: Proxy api)--instance HasRoundtripSpecs api => HasRoundtripSpecs ((path :: Symbol) :> api) where-  collectRoundtripSpecs Proxy = collectRoundtripSpecs (Proxy :: Proxy api)--instance HasRoundtripSpecs api => HasRoundtripSpecs (MatrixParam name a :> api) where-  collectRoundtripSpecs Proxy = collectRoundtripSpecs (Proxy :: Proxy api)---- 'mkSpec' 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 MkSpec a where-  mkSpec :: Proxy a -> [(TypeRep, Spec)]--instance (Typeable a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) => MkSpec a where--  mkSpec proxy = [(typeRep proxy, genericAesonRoundtrip proxy)]---- This will only test json serialization of the element type. As we trust aeson--- to do the right thing for lists, we don't need to test that. (This speeds up--- test suites immensely.)-instance {-# OVERLAPPING #-}-  (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>-  MkSpec [a] where--  mkSpec Proxy = [(typeRep proxy, genericAesonRoundtripWithNote proxy (Just note))]-    where-      proxy = Proxy :: Proxy a-      note = "(as element-type in [])"
+ src/Test/Aeson/GenericSpecs.hs view
@@ -0,0 +1,15 @@++module Test.Aeson.GenericSpecs (+  roundtripSpecs,+  goldenSpecs,++  shouldBeIdentity,++  -- * re-exports+  Proxy(..),+) where++import           Data.Proxy++import           Test.Aeson.Internal.GoldenSpecs+import           Test.Aeson.Internal.RoundtripSpecs
+ src/Test/Aeson/Internal/GoldenSpecs.hs view
@@ -0,0 +1,127 @@+{-# 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
+ src/Test/Aeson/Internal/RoundtripSpecs.hs view
@@ -0,0 +1,59 @@+{-# 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)
− src/Test/Aeson/RoundtripSpecs.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--module Test.Aeson.RoundtripSpecs (-  genericAesonRoundtrip,-  shouldBeIdentity,--  -- * re-exports-  Proxy(..),-) where--import           Data.Proxy--import           Test.Aeson.RoundtripSpecs.Internal
− src/Test/Aeson/RoundtripSpecs/Internal.hs 
@@ -1,59 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}---- | Internal module, use at your own risk.-module Test.Aeson.RoundtripSpecs.Internal 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.------ 'genericAesonRoundtrip' 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').-genericAesonRoundtrip :: forall a .-  (Typeable a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) =>-  Proxy a -> Spec-genericAesonRoundtrip 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)
test/DoctestSpec.hs view
@@ -1,10 +1,15 @@  module DoctestSpec where +import           System.Directory+import           System.FilePath import           Test.DocTest import           Test.Hspec+import           Test.Mockery.Directory  spec :: Spec spec = do   it "doctest" $ do-    doctest ["src/Servant/Aeson/RoundtripSpecs.hs"]+    dir <- getCurrentDirectory+    inTempDirectory $ do+      doctest [dir </> "src/Servant/Aeson/GenericSpecs.hs"]
+ test/Servant/Aeson/GoldenSpecsSpec.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE DataKinds #-}++module Servant.Aeson.GoldenSpecsSpec where++import           Data.Proxy+import           Servant.API+import           System.Directory+import           Test.Hspec+import           Test.Hspec.Core.Runner+import           Test.Mockery.Directory+import           Test.Utils++import           Servant.Aeson.GenericSpecs++spec :: Spec+spec = do+  describe "apiGoldenSpecs" $ do+    it "writes files for used types" $ do+      inTempDirectory $ do+        _ <- hspecSilently $ apiGoldenSpecs (Proxy :: Proxy (Get '[JSON] Bool))+        doesFileExist "golden.json/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"+        apiGoldenSpecs (Proxy :: Proxy (Get '[JSON] Bool)) `shouldTestAs`+          Summary 1 1
test/Servant/Aeson/RoundtripSpecsSpec.hs view
@@ -3,15 +3,19 @@  module Servant.Aeson.RoundtripSpecsSpec where +import           Data.List import           Data.Typeable import           Servant.API+import           System.Directory import           System.IO import           System.IO.Temp import           Test.Hspec import           Test.Hspec.Core.Runner+import           Test.Mockery.Directory -import           Servant.Aeson.RoundtripSpecs+import           Servant.Aeson.GenericSpecs import           Test.Aeson.RoundtripSpecsSpec+import           Test.Utils  -- ignores the Summary hspecOutput :: Spec -> IO String@@ -26,23 +30,38 @@  spec :: Spec spec = do-  describe "roundtripSpecs" $ do+  describe "apiRoundtripSpecs" $ do     it "detects failures in types from ReqBody" $ do-      roundtripSpecs reqBodyFailApi `shouldTestAs`+      apiRoundtripSpecs reqBodyFailApi `shouldTestAs`         Summary 2 1      it "detects failures in types from Get" $ do-      roundtripSpecs getFailApi `shouldTestAs`+      apiRoundtripSpecs getFailApi `shouldTestAs`         Summary 1 1      context "when it finds a list of something" $ do       it "returns only the element type" $ do-        usedTypes getBoolList `shouldBe` [boolRep]+        usedTypes getListOfBool `shouldBe` [boolRep]        it "mentions that the type was wrapped in a list" $ do-        output <- hspecOutput $ roundtripSpecs getBoolList+        output <- hspecOutput $ apiRoundtripSpecs getListOfBool         output `shouldContain` "(as element-type in [])" +    context "when it finds a Maybe" $ do+      it "returns only the element type" $ do+        usedTypes (Proxy :: Proxy (Get '[JSON] (Maybe Bool)))+          `shouldBe` [boolRep]++    context "when it finds ()" $ do+      it "does not return anything" $ do+        usedTypes (Proxy :: Proxy (Get '[JSON] ()))+          `shouldBe` []++    it "does not write any files" $ do+      inTempDirectory $ do+        _ <- hspecSilently $ apiRoundtripSpecs reqBodyFailApi+        sort <$> getDirectoryContents "." `shouldReturn` [".", ".."]+   describe "usedTypes" $ do     it "extracts types from ReqBody" $ do       usedTypes reqBodyFailApi `shouldMatchList`@@ -71,8 +90,8 @@ getFailApi :: Proxy (Get '[JSON] FaultyRoundtrip) getFailApi = Proxy -getBoolList :: Proxy (Get '[JSON] [Bool])-getBoolList = Proxy+getListOfBool :: Proxy (Get '[JSON] [Bool])+getListOfBool = Proxy  doubleTypesApi :: Proxy (ReqBody '[JSON] Bool :> Get '[JSON] Bool) doubleTypesApi = Proxy
+ test/Test/Aeson/GoldenSpecsSpec.hs view
@@ -0,0 +1,102 @@+{-# 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"
test/Test/Aeson/RoundtripSpecsSpec.hs view
@@ -7,41 +7,25 @@ import           Control.Applicative import           Data.Aeson import           GHC.Generics-import           System.IO-import           System.IO.Temp import           Test.Hspec import           Test.Hspec.Core.Runner import           Test.QuickCheck -import           Test.Aeson.RoundtripSpecs--hspecSilently :: Spec -> IO Summary-hspecSilently s = do-  withSystemTempFile "ghcjs-hspec-jsval-aeson" $ \ path handle -> do-    hClose handle-    let silentConfig :: Test.Hspec.Core.Runner.Config-        silentConfig = defaultConfig{-          configOutputFile = Right path-        }-    hspecWithResult silentConfig s--shouldTestAs :: Spec -> Summary -> IO ()-shouldTestAs spec expected = do-  summary <- hspecSilently spec-  summary `shouldBe` expected+import           Test.Aeson.GenericSpecs+import           Test.Utils  spec :: Spec spec = do-  describe "genericAesonRoundtrip" $ do+  describe "roundtripSpecs" $ do     it "detects incompatible json encodings" $ do-      genericAesonRoundtrip faultyRoundtripProxy `shouldTestAs` Summary 1 1+      roundtripSpecs faultyRoundtripProxy `shouldTestAs` Summary 1 1      context "when used with compatible encodings" $ do       it "creates passing tests" $ do-        genericAesonRoundtrip correctProxy `shouldTestAs` Summary 1 0+        roundtripSpecs correctProxy `shouldTestAs` Summary 1 0        it "creates passing tests for sum types" $ do-        genericAesonRoundtrip correctSumProxy `shouldTestAs` Summary 1 0+        roundtripSpecs correctSumProxy `shouldTestAs` Summary 1 0  -- | Type where roundtrips don't work. data FaultyRoundtrip
+ test/Test/Utils.hs view
@@ -0,0 +1,37 @@++module Test.Utils where++import           Control.Monad+import           Data.Tuple+import           System.IO.Silently+import           Test.Hspec+import           Test.Hspec.Core.Runner++hspecSilently :: Spec -> IO (Summary, String)+hspecSilently s = do+  swap <$> capture (hspecResult s)++shouldTestAs :: Spec -> Summary -> IO ()+shouldTestAs spec expected = do+  (summary, output) <- hspecSilently spec+  when (summary /= expected) $+    expectationFailure $+      "spec didn't yield the expected summary:\n" +++      "  expected: " ++ show expected ++ "\n" +++      "  got:      " ++ show summary ++ "\n" +++      "output of the test-suite:\n" +++      indent output++shouldProduceFailures :: Spec -> Int -> IO ()+shouldProduceFailures spec expected = do+  (summary, output) <- hspecSilently spec+  when (summaryFailures summary /= expected) $+    expectationFailure $+      "spec didn't yield the expected number of failures summary:\n" +++      "  expected: " ++ show expected ++ "\n" +++      "  got:      " ++ show (summaryFailures summary) ++ "\n" +++      "output of the test-suite:\n" +++      indent output++indent :: String -> String+indent = unlines . map ("    " ++ ) . lines