{-|
Module      : Test.Aeson.Internal.ADT.RoundtripSpecs
Description : Roundtrip tests for ToADTArbitrary
Copyright   : (c) Plow Technologies, 2016
License     : BSD3
Maintainer  : mchaver@gmail.com
Stability   : Beta

Internal module, use at your own risk.
-}

{-# LANGUAGE ScopedTypeVariables #-}

module Test.Aeson.Internal.ADT.RoundtripSpecs where

import           Control.Arrow

import qualified Data.Aeson as Aeson
import           Data.Aeson as Aeson hiding (encode)
import           Data.Typeable

import           Test.Aeson.Internal.Utils
import           Test.Hspec
import           Test.QuickCheck
import           Test.QuickCheck.Arbitrary.ADT

import Control.Monad

-- | A roundtrip test to check whether values of all of constructors of the
-- given type can be successfully converted to JSON and back to a Haskell value.
--
-- 'roundtripADTSpecs' will
--
-- - create random values for each constructor using 'ToADTArbitrary',
-- - 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'.
roundtripADTSpecs :: forall a.
  (Arbitrary a, ToADTArbitrary a, Eq a, Show a, ToJSON a, FromJSON a)
  => Proxy a
  -> Spec
roundtripADTSpecs :: Proxy a -> Spec
roundtripADTSpecs proxy :: Proxy a
proxy = Proxy a -> Maybe String -> Spec
forall a.
(ToADTArbitrary a, Eq a, Show a, Arbitrary a, ToJSON a,
 FromJSON a) =>
Proxy a -> Maybe String -> Spec
genericAesonRoundtripADTWithNote Proxy a
proxy Maybe String
forall a. Maybe a
Nothing

-- | Same as 'roundtripADTSpecs' but has the option of passing a note to the
-- 'describe' function.
genericAesonRoundtripADTWithNote :: forall a.
  (ToADTArbitrary a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a)
  => Proxy a
  -> Maybe String
  -> Spec
genericAesonRoundtripADTWithNote :: Proxy a -> Maybe String -> Spec
genericAesonRoundtripADTWithNote _ mNote :: Maybe String
mNote = do
  ADTArbitrary a
adt <- IO (ADTArbitrary a) -> SpecM () (ADTArbitrary a)
forall r a. IO r -> SpecM a r
runIO (IO (ADTArbitrary a) -> SpecM () (ADTArbitrary a))
-> IO (ADTArbitrary a) -> SpecM () (ADTArbitrary a)
forall a b. (a -> b) -> a -> b
$ Gen (ADTArbitrary a) -> IO (ADTArbitrary a)
forall a. Gen a -> IO a
generate (Proxy a -> Gen (ADTArbitrary a)
forall a. ToADTArbitrary a => Proxy a -> Gen (ADTArbitrary a)
toADTArbitrary (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe ("JSON encoding of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
addBrackets (ADTArbitrary a -> String
forall a. ADTArbitrary a -> String
adtTypeName ADTArbitrary a
adt) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
note) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it "allows to encode values with aeson and read them back" (IO () -> Spec) -> IO () -> Spec
forall a b. (a -> b) -> a -> b
$
      [ConstructorArbitraryPair a]
-> (ConstructorArbitraryPair a -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ADTArbitrary a -> [ConstructorArbitraryPair a]
forall a. ADTArbitrary a -> [ConstructorArbitraryPair a]
adtCAPs ADTArbitrary a
adt) ((ConstructorArbitraryPair a -> IO ()) -> IO ())
-> (ConstructorArbitraryPair a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \cap :: ConstructorArbitraryPair a
cap ->
        (a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (a -> ByteString) -> (ByteString -> IO a) -> a -> IO a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ByteString -> IO a
forall a. FromJSON a => ByteString -> IO a
aesonDecodeIO) (ConstructorArbitraryPair a -> a
forall a. ConstructorArbitraryPair a -> a
capArbitrary ConstructorArbitraryPair a
cap) IO a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` ConstructorArbitraryPair a -> a
forall a. ConstructorArbitraryPair a -> a
capArbitrary ConstructorArbitraryPair a
cap
  where
    note :: String
note = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (" " String -> String -> String
forall a. [a] -> [a] -> [a]
++) Maybe String
mNote