NamedJsonFieldsSpec.hs

{-# LANGUAGE DerivingVia #-}

module DomainDriven.Internal.NamedJsonFieldsSpec where

import Control.Monad
import Data.Aeson
import Data.OpenApi
import Data.Proxy
import Data.String
import Data.Text (Text)
import DomainDriven.Internal.HasFieldName
import DomainDriven.Internal.NamedJsonFields
import GHC.Generics
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
import Test.QuickCheck.Arbitrary.ADT
import Test.QuickCheck.Classes
import Prelude

data Test1 = Test1
    { namedField1 :: Int
    , namedField2 :: Double
    }
    deriving (Show, Eq, Ord, Generic)
    deriving (FromJSON, ToJSON, ToSchema) via (NamedJsonFields Test1)

instance Arbitrary Test1 where
    arbitrary = genericArbitrary

newtype MyText = MyText Text
    deriving (Show, Eq, Ord, Generic)
    deriving newtype (FromJSON, ToJSON, IsString, ToSchema)
    deriving anyclass (HasFieldName)

------------------------------------------------------------------------------

instance Arbitrary Duplicated where
    arbitrary = genericArbitrary

instance Arbitrary MyText where
    arbitrary = elements ["hej", "hopp", "kalle", "anka", "ekorre"]

data Test2
    = Test2a
    | Test2b Int MyText
    | Test2c MyText
    | Test2d String String
    | Test2e (Maybe String)
    deriving (Show, Eq, Ord, Generic)
    deriving (FromJSON, ToJSON, ToSchema) via (NamedJsonFields Test2)

instance Arbitrary Test2 where
    arbitrary = genericArbitrary

data Duplicated
    = Duplicated1 Int Int Int String Int String
    | Duplicated2 Int String Int Double
    deriving (Show, Eq, Generic)
    -- deriving anyclass (FromJSON, ToJSON, ToSchema)
    deriving (FromJSON, ToJSON, ToSchema) via (NamedJsonFields Duplicated)

newtype DuplicatedNoTag = DuplicatedNoTag Duplicated
    deriving stock (Generic)
    deriving newtype (Show, Eq, Arbitrary)

noTagOpts :: NamedJsonOptions
noTagOpts = defaultNamedJsonOptions{skipTagField = True}

instance FromJSON DuplicatedNoTag where
    parseJSON = fmap DuplicatedNoTag . gNamedParseJson noTagOpts

instance ToJSON DuplicatedNoTag where
    toJSON (DuplicatedNoTag a) = gNamedToJson noTagOpts a

instance ToSchema DuplicatedNoTag where
    declareNamedSchema _ = gNamedDeclareNamedSchema noTagOpts (Proxy @Duplicated)

spec :: Spec
spec = do
    describe "ToJSON and FromJSON instances" $ do
        describe "Test1" . void $
            traverse
                (uncurry prop)
                (lawsProperties $ jsonLaws $ Proxy @Test1)
        describe "Test2" . void $
            traverse
                (uncurry prop)
                (lawsProperties $ jsonLaws $ Proxy @Test2)
        describe "Duplicated" . void $
            traverse
                (uncurry prop)
                (lawsProperties $ jsonLaws $ Proxy @Duplicated)
        describe "DuplicatedNoTag" . void $
            traverse
                (uncurry prop)
                (lawsProperties $ jsonLaws $ Proxy @DuplicatedNoTag)
    describe "ToSchema instances" $ do
        prop "Test1" $ \(a :: Test1) -> validateToJSON a == []
        prop "Test2" $ \(a :: Test2) -> validateToJSON a == []
        prop "Duplicated" $ \(a :: Duplicated) -> validateToJSON a == []