{-# LANGUAGE ScopedTypeVariables #-}

module Test.Utils.Roundtrip
    ( jsonRoundtripAndGolden
    , httpApiDataRoundtrip
    ) where

import Prelude

import Data.Aeson
    ( FromJSON (..), ToJSON (..) )
import Data.Char
    ( isAlphaNum )
import Data.Proxy
    ( Proxy (..) )
import Data.Typeable
    ( Typeable, splitTyConApp, tyConName, typeRep )
import Test.Aeson.GenericSpecs
    ( GoldenDirectoryOption (CustomDirectoryName)
    , Settings
    , defaultSettings
    , goldenDirectoryOption
    , sampleSize
    , useModuleNameAsSubDirectory
    )
import Test.Aeson.Internal.GoldenSpecs
    ( goldenSpecsWithNotePlain )
import Test.Aeson.Internal.RoundtripSpecs
    ( roundtripSpecs )
import Test.Aeson.Internal.Utils
    ( TypeName (..), TypeNameInfo (..), mkTypeNameInfo )
import Test.Hspec
    ( Spec, it, runIO, shouldBe )
import Test.QuickCheck
    ( Arbitrary (..), property )
import Web.HttpApiData
    ( FromHttpApiData (..), ToHttpApiData (..) )

-- Golden tests files are generated automatically on first run. On later runs
-- we check that the format stays the same. The golden files should be tracked
-- in git.
--
-- Example:
-- >>> roundtripAndGolden $ Proxy @ Wallet
--
-- ...will compare @ToJSON@ of @Wallet@ against `Wallet.json`. It may either
-- match and succeed, or fail and write `Wallet.faulty.json` to disk with the
-- new format. Faulty golden files should /not/ be commited.
--
-- The directory `test/data/Cardano/Wallet/Api` is used.
jsonRoundtripAndGolden
    :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Typeable a)
    => FilePath
    -> Proxy a
    -> Spec
jsonRoundtripAndGolden :: FilePath -> Proxy a -> Spec
jsonRoundtripAndGolden FilePath
dir Proxy a
proxy = do
    Proxy a -> Spec
forall a.
(Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>
Proxy a -> Spec
roundtripSpecs Proxy a
proxy
    TypeNameInfo a
typeNameInfo <- IO (TypeNameInfo a) -> SpecM () (TypeNameInfo a)
forall r a. IO r -> SpecM a r
runIO IO (TypeNameInfo a)
mkCompatibleTypeNameInfo
    Settings -> TypeNameInfo a -> Maybe FilePath -> Spec
forall a.
(Arbitrary a, ToJSON a, FromJSON a) =>
Settings -> TypeNameInfo a -> Maybe FilePath -> Spec
goldenSpecsWithNotePlain Settings
settings TypeNameInfo a
typeNameInfo Maybe FilePath
forall a. Maybe a
Nothing
  where
    -- NOTE
    -- We use a custom 'TypeNameInfo' instead of the default one provided by
    -- @hspec-golden-aeson@ because the defaults generates names that are
    -- invalid for Windows file-system.
    mkCompatibleTypeNameInfo :: IO (TypeNameInfo a)
    mkCompatibleTypeNameInfo :: IO (TypeNameInfo a)
mkCompatibleTypeNameInfo = do
        TypeNameInfo a
typeNameInfo <- Settings -> Proxy a -> IO (TypeNameInfo a)
forall a.
(Arbitrary a, Typeable a) =>
Settings -> Proxy a -> IO (TypeNameInfo a)
mkTypeNameInfo Settings
settings Proxy a
proxy
        TypeNameInfo a -> IO (TypeNameInfo a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeNameInfo a -> IO (TypeNameInfo a))
-> TypeNameInfo a -> IO (TypeNameInfo a)
forall a b. (a -> b) -> a -> b
$ TypeNameInfo a
typeNameInfo
            { typeNameTypeName :: TypeName
typeNameTypeName =
                TypeName -> TypeName
mkValidForWindows (TypeNameInfo a -> TypeName
forall a. TypeNameInfo a -> TypeName
typeNameTypeName TypeNameInfo a
typeNameInfo)
            }
      where
        mkValidForWindows :: TypeName -> TypeName
        mkValidForWindows :: TypeName -> TypeName
mkValidForWindows (TypeName FilePath
typeName) =
            FilePath -> TypeName
TypeName ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum FilePath
typeName)

    settings :: Settings
    settings :: Settings
settings = Settings
defaultSettings
        { goldenDirectoryOption :: GoldenDirectoryOption
goldenDirectoryOption =
            FilePath -> GoldenDirectoryOption
CustomDirectoryName FilePath
dir
        , useModuleNameAsSubDirectory :: Bool
useModuleNameAsSubDirectory =
            Bool
False
        , sampleSize :: Int
sampleSize = Int
10
        }

-- Perform roundtrip tests for FromHttpApiData & ToHttpApiData instances
httpApiDataRoundtrip
    :: forall a.
        ( Arbitrary a
        , FromHttpApiData a
        , ToHttpApiData a
        , Typeable a
        , Eq a
        , Show a
        )
    => Proxy a
    -> Spec
httpApiDataRoundtrip :: Proxy a -> Spec
httpApiDataRoundtrip Proxy a
proxy =
    FilePath -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
FilePath -> a -> SpecWith (Arg a)
it (FilePath
"URL encoding of " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> TypeRep -> FilePath
cons (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
proxy)) (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ (a -> Expectation) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> Expectation) -> Property) -> (a -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
x :: a) -> do
        let bytes :: Text
bytes = a -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece a
x
        let x' :: Either Text a
x' = Text -> Either Text a
forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece Text
bytes
        Either Text a
x' Either Text a -> Either Text a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a -> Either Text a
forall a b. b -> Either a b
Right a
x
  where
    cons :: TypeRep -> FilePath
cons TypeRep
rep =
        let
            (TyCon
c, [TypeRep]
args) = TypeRep -> (TyCon, [TypeRep])
splitTyConApp TypeRep
rep
        in
            case [TypeRep]
args of
                [] ->
                    TyCon -> FilePath
tyConName TyCon
c
                [TypeRep]
xs ->
                    FilePath
"(" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> TyCon -> FilePath
tyConName TyCon
c FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
unwords (TypeRep -> FilePath
cons (TypeRep -> FilePath) -> [TypeRep] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeRep]
xs) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
")"