diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/ApproxEq.hs | 81 | ||||
| -rw-r--r-- | tests/Instances.hs | 466 | ||||
| -rw-r--r-- | tests/PropMime.hs | 51 | ||||
| -rw-r--r-- | tests/Test.hs | 52 |
4 files changed, 650 insertions, 0 deletions
diff --git a/tests/ApproxEq.hs b/tests/ApproxEq.hs new file mode 100644 index 0000000..88ca211 --- /dev/null +++ b/tests/ApproxEq.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module ApproxEq where + +import Data.Text (Text) +import Data.Time.Clock +import Test.QuickCheck +import GHC.Generics as G + +(==~) + :: (ApproxEq a, Show a) + => a -> a -> Property +a ==~ b = counterexample (show a ++ " !=~ " ++ show b) (a =~ b) + +class GApproxEq f where + gApproxEq :: f a -> f a -> Bool + +instance GApproxEq U1 where + gApproxEq U1 U1 = True + +instance (GApproxEq a, GApproxEq b) => + GApproxEq (a :+: b) where + gApproxEq (L1 a) (L1 b) = gApproxEq a b + gApproxEq (R1 a) (R1 b) = gApproxEq a b + gApproxEq _ _ = False + +instance (GApproxEq a, GApproxEq b) => + GApproxEq (a :*: b) where + gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2 + +instance (ApproxEq a) => + GApproxEq (K1 i a) where + gApproxEq (K1 a) (K1 b) = a =~ b + +instance (GApproxEq f) => + GApproxEq (M1 i t f) where + gApproxEq (M1 a) (M1 b) = gApproxEq a b + +class ApproxEq a where + (=~) :: a -> a -> Bool + default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool + a =~ b = gApproxEq (G.from a) (G.from b) + +instance ApproxEq Text where + (=~) = (==) + +instance ApproxEq Char where + (=~) = (==) + +instance ApproxEq Bool where + (=~) = (==) + +instance ApproxEq Int where + (=~) = (==) + +instance ApproxEq Double where + (=~) = (==) + +instance ApproxEq a => + ApproxEq (Maybe a) + +instance ApproxEq UTCTime where + (=~) = (==) + +instance ApproxEq a => + ApproxEq [a] where + as =~ bs = and (zipWith (=~) as bs) + +instance (ApproxEq l, ApproxEq r) => + ApproxEq (Either l r) where + Left a =~ Left b = a =~ b + Right a =~ Right b = a =~ b + _ =~ _ = False + +instance (ApproxEq l, ApproxEq r) => + ApproxEq (l, r) where + (=~) (l1, r1) (l2, r2) = l1 =~ l2 && r1 =~ r2 diff --git a/tests/Instances.hs b/tests/Instances.hs new file mode 100644 index 0000000..33459bc --- /dev/null +++ b/tests/Instances.hs @@ -0,0 +1,466 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-unused-matches #-} + +module Instances where + +import G4fClient.Model +import G4fClient.Core + +import qualified Data.Aeson as A +import qualified Data.ByteString.Lazy as BL +import qualified Data.HashMap.Strict as HM +import qualified Data.Set as Set +import qualified Data.Text as T +import qualified Data.Time as TI +import qualified Data.Vector as V +import Data.String (fromString) + +import Control.Monad +import Data.Char (isSpace) +import Data.List (sort) +import Test.QuickCheck + +import ApproxEq + +instance Arbitrary T.Text where + arbitrary = T.pack <$> arbitrary + +instance Arbitrary TI.Day where + arbitrary = TI.ModifiedJulianDay . (2000 +) <$> arbitrary + shrink = (TI.ModifiedJulianDay <$>) . shrink . TI.toModifiedJulianDay + +instance Arbitrary TI.UTCTime where + arbitrary = + TI.UTCTime <$> arbitrary <*> (TI.secondsToDiffTime <$> choose (0, 86401)) + +instance Arbitrary BL.ByteString where + arbitrary = BL.pack <$> arbitrary + shrink xs = BL.pack <$> shrink (BL.unpack xs) + +instance Arbitrary ByteArray where + arbitrary = ByteArray <$> arbitrary + shrink (ByteArray xs) = ByteArray <$> shrink xs + +instance Arbitrary Binary where + arbitrary = Binary <$> arbitrary + shrink (Binary xs) = Binary <$> shrink xs + +instance Arbitrary DateTime where + arbitrary = DateTime <$> arbitrary + shrink (DateTime xs) = DateTime <$> shrink xs + +instance Arbitrary Date where + arbitrary = Date <$> arbitrary + shrink (Date xs) = Date <$> shrink xs + +#if MIN_VERSION_aeson(2,0,0) +#else +-- | A naive Arbitrary instance for A.Value: +instance Arbitrary A.Value where + arbitrary = arbitraryValue +#endif + +arbitraryValue :: Gen A.Value +arbitraryValue = + frequency [(3, simpleTypes), (1, arrayTypes), (1, objectTypes)] + where + simpleTypes :: Gen A.Value + simpleTypes = + frequency + [ (1, return A.Null) + , (2, liftM A.Bool (arbitrary :: Gen Bool)) + , (2, liftM (A.Number . fromIntegral) (arbitrary :: Gen Int)) + , (2, liftM (A.String . T.pack) (arbitrary :: Gen String)) + ] + mapF (k, v) = (fromString k, v) + simpleAndArrays = frequency [(1, sized sizedArray), (4, simpleTypes)] + arrayTypes = sized sizedArray + objectTypes = sized sizedObject + sizedArray n = liftM (A.Array . V.fromList) $ replicateM n simpleTypes + sizedObject n = + liftM (A.object . map mapF) $ + replicateM n $ (,) <$> (arbitrary :: Gen String) <*> simpleAndArrays + +-- | Checks if a given list has no duplicates in _O(n log n)_. +hasNoDups + :: (Ord a) + => [a] -> Bool +hasNoDups = go Set.empty + where + go _ [] = True + go s (x:xs) + | s' <- Set.insert x s + , Set.size s' > Set.size s = go s' xs + | otherwise = False + +instance ApproxEq TI.Day where + (=~) = (==) + +arbitraryReduced :: Arbitrary a => Int -> Gen a +arbitraryReduced n = resize (n `div` 2) arbitrary + +arbitraryReducedMaybe :: Arbitrary a => Int -> Gen (Maybe a) +arbitraryReducedMaybe 0 = elements [Nothing] +arbitraryReducedMaybe n = arbitraryReduced n + +arbitraryReducedMaybeValue :: Int -> Gen (Maybe A.Value) +arbitraryReducedMaybeValue 0 = elements [Nothing] +arbitraryReducedMaybeValue n = do + generated <- arbitraryReduced n + if generated == Just A.Null + then return Nothing + else return generated + +-- * Models + +instance Arbitrary ApiKey where + arbitrary = sized genApiKey + +genApiKey :: Int -> Gen ApiKey +genApiKey n = + + pure ApiKey + +instance Arbitrary AudioResponseModel where + arbitrary = sized genAudioResponseModel + +genAudioResponseModel :: Int -> Gen AudioResponseModel +genAudioResponseModel n = + AudioResponseModel + <$> arbitrary -- audioResponseModelData :: Text + <*> arbitraryReducedMaybe n -- audioResponseModelTranscript :: Maybe Text + +instance Arbitrary AudioSpeechConfig where + arbitrary = sized genAudioSpeechConfig + +genAudioSpeechConfig :: Int -> Gen AudioSpeechConfig +genAudioSpeechConfig n = + AudioSpeechConfig + <$> arbitrary -- audioSpeechConfigInput :: Text + <*> arbitraryReducedMaybe n -- audioSpeechConfigModel :: Maybe Text + <*> arbitraryReducedMaybe n -- audioSpeechConfigProvider :: Maybe Text + <*> arbitraryReducedMaybe n -- audioSpeechConfigVoice :: Maybe Text + <*> arbitraryReducedMaybe n -- audioSpeechConfigInstrcutions :: Maybe Text + <*> arbitraryReducedMaybe n -- audioSpeechConfigResponseFormat :: Maybe Text + <*> arbitraryReducedMaybe n -- audioSpeechConfigLanguage :: Maybe Text + <*> arbitraryReducedMaybe n -- audioSpeechConfigDownloadMedia :: Maybe Bool + +instance Arbitrary ChatCompletion where + arbitrary = sized genChatCompletion + +genChatCompletion :: Int -> Gen ChatCompletion +genChatCompletion n = + ChatCompletion + <$> arbitrary -- chatCompletionId :: Text + <*> arbitrary -- chatCompletionObject :: Text + <*> arbitrary -- chatCompletionCreated :: Int + <*> arbitrary -- chatCompletionModel :: Text + <*> arbitrary -- chatCompletionProvider :: Text + <*> arbitraryReduced n -- chatCompletionChoices :: [ChatCompletionChoice] + <*> arbitraryReduced n -- chatCompletionUsage :: UsageModel + <*> arbitraryReduced n -- chatCompletionConversation :: (Map.Map String AnyType) + +instance Arbitrary ChatCompletionChoice where + arbitrary = sized genChatCompletionChoice + +genChatCompletionChoice :: Int -> Gen ChatCompletionChoice +genChatCompletionChoice n = + ChatCompletionChoice + <$> arbitrary -- chatCompletionChoiceIndex :: Int + <*> arbitraryReduced n -- chatCompletionChoiceMessage :: ChatCompletionMessage + <*> arbitrary -- chatCompletionChoiceFinishReason :: Text + +instance Arbitrary ChatCompletionMessage where + arbitrary = sized genChatCompletionMessage + +genChatCompletionMessage :: Int -> Gen ChatCompletionMessage +genChatCompletionMessage n = + ChatCompletionMessage + <$> arbitrary -- chatCompletionMessageRole :: Text + <*> arbitrary -- chatCompletionMessageContent :: Text + <*> arbitraryReducedMaybe n -- chatCompletionMessageReasoning :: Maybe Text + <*> arbitraryReducedMaybe n -- chatCompletionMessageToolCalls :: Maybe [ToolCallModel] + <*> arbitraryReducedMaybe n -- chatCompletionMessageAudio :: Maybe AudioResponseModel + +instance Arbitrary ChatCompletionsConfig where + arbitrary = sized genChatCompletionsConfig + +genChatCompletionsConfig :: Int -> Gen ChatCompletionsConfig +genChatCompletionsConfig n = + ChatCompletionsConfig + <$> arbitraryReducedMaybe n -- chatCompletionsConfigModel :: Maybe Text + <*> arbitraryReducedMaybe n -- chatCompletionsConfigProvider :: Maybe Text + <*> arbitraryReducedMaybe n -- chatCompletionsConfigMedia :: Maybe [[AnyType]] + <*> arbitraryReducedMaybe n -- chatCompletionsConfigModalities :: Maybe [Text] + <*> arbitraryReducedMaybe n -- chatCompletionsConfigTemperature :: Maybe Double + <*> arbitraryReducedMaybe n -- chatCompletionsConfigPresencePenalty :: Maybe Double + <*> arbitraryReducedMaybe n -- chatCompletionsConfigFrequencyPenalty :: Maybe Double + <*> arbitraryReducedMaybe n -- chatCompletionsConfigTopP :: Maybe Double + <*> arbitraryReducedMaybe n -- chatCompletionsConfigMaxTokens :: Maybe Int + <*> arbitraryReducedMaybe n -- chatCompletionsConfigStop :: Maybe Stop + <*> arbitraryReducedMaybe n -- chatCompletionsConfigApiKey :: Maybe ApiKey + <*> arbitraryReducedMaybe n -- chatCompletionsConfigBaseUrl :: Maybe Text + <*> arbitraryReducedMaybe n -- chatCompletionsConfigWebSearch :: Maybe Bool + <*> arbitraryReducedMaybe n -- chatCompletionsConfigProxy :: Maybe Text + <*> arbitraryReducedMaybe n -- chatCompletionsConfigConversation :: Maybe (Map.Map String AnyType) + <*> arbitraryReducedMaybe n -- chatCompletionsConfigTimeout :: Maybe Int + <*> arbitraryReducedMaybe n -- chatCompletionsConfigStreamTimeout :: Maybe Int + <*> arbitraryReducedMaybe n -- chatCompletionsConfigToolCalls :: Maybe [AnyType] + <*> arbitraryReducedMaybe n -- chatCompletionsConfigReasoningEffort :: Maybe Text + <*> arbitraryReducedMaybe n -- chatCompletionsConfigLogitBias :: Maybe (Map.Map String AnyType) + <*> arbitraryReducedMaybe n -- chatCompletionsConfigAudio :: Maybe (Map.Map String AnyType) + <*> arbitraryReducedMaybe n -- chatCompletionsConfigResponseFormat :: Maybe (Map.Map String AnyType) + <*> arbitraryReducedMaybe n -- chatCompletionsConfigDownloadMedia :: Maybe Bool + <*> arbitraryReducedMaybe n -- chatCompletionsConfigRaw :: Maybe Bool + <*> arbitraryReducedMaybe n -- chatCompletionsConfigExtraBody :: Maybe (Map.Map String AnyType) + <*> arbitraryReducedMaybe n -- chatCompletionsConfigToolEmulation :: Maybe Bool + <*> arbitraryReduced n -- chatCompletionsConfigMessages :: [Message] + <*> arbitraryReducedMaybe n -- chatCompletionsConfigStream :: Maybe Bool + <*> arbitraryReducedMaybe n -- chatCompletionsConfigImage :: Maybe Text + <*> arbitraryReducedMaybe n -- chatCompletionsConfigImageName :: Maybe Text + <*> arbitraryReducedMaybe n -- chatCompletionsConfigImages :: Maybe [[AnyType]] + <*> arbitraryReducedMaybe n -- chatCompletionsConfigTools :: Maybe [AnyType] + <*> arbitraryReducedMaybe n -- chatCompletionsConfigParallelToolCalls :: Maybe Bool + <*> arbitraryReducedMaybe n -- chatCompletionsConfigToolChoice :: Maybe Text + <*> arbitraryReducedMaybe n -- chatCompletionsConfigConversationId :: Maybe Text + +instance Arbitrary CompletionTokenDetails where + arbitrary = sized genCompletionTokenDetails + +genCompletionTokenDetails :: Int -> Gen CompletionTokenDetails +genCompletionTokenDetails n = + CompletionTokenDetails + <$> arbitrary -- completionTokenDetailsReasoningTokens :: Int + <*> arbitrary -- completionTokenDetailsImageTokens :: Int + <*> arbitrary -- completionTokenDetailsAudioTokens :: Int + +instance Arbitrary Content where + arbitrary = sized genContent + +genContent :: Int -> Gen Content +genContent n = + + pure Content + +instance Arbitrary ContentPart where + arbitrary = sized genContentPart + +genContentPart :: Int -> Gen ContentPart +genContentPart n = + ContentPart + <$> arbitraryReducedMaybe n -- contentPartType :: Maybe Text + <*> arbitraryReducedMaybe n -- contentPartText :: Maybe Text + <*> arbitraryReducedMaybe n -- contentPartImageUrl :: Maybe (Map.Map String Text) + <*> arbitraryReducedMaybe n -- contentPartInputAudio :: Maybe (Map.Map String Text) + <*> arbitraryReducedMaybe n -- contentPartBucketId :: Maybe Text + <*> arbitraryReducedMaybe n -- contentPartName :: Maybe Text + +instance Arbitrary ErrorResponseMessageModel where + arbitrary = sized genErrorResponseMessageModel + +genErrorResponseMessageModel :: Int -> Gen ErrorResponseMessageModel +genErrorResponseMessageModel n = + ErrorResponseMessageModel + <$> arbitrary -- errorResponseMessageModelMessage :: Text + +instance Arbitrary ErrorResponseModel where + arbitrary = sized genErrorResponseModel + +genErrorResponseModel :: Int -> Gen ErrorResponseModel +genErrorResponseModel n = + ErrorResponseModel + <$> arbitraryReduced n -- errorResponseModelError :: ErrorResponseMessageModel + <*> arbitraryReducedMaybe n -- errorResponseModelModel :: Maybe Text + <*> arbitraryReducedMaybe n -- errorResponseModelProvider :: Maybe Text + +instance Arbitrary FileResponseModel where + arbitrary = sized genFileResponseModel + +genFileResponseModel :: Int -> Gen FileResponseModel +genFileResponseModel n = + FileResponseModel + <$> arbitrary -- fileResponseModelFilename :: Text + +instance Arbitrary HTTPValidationError where + arbitrary = sized genHTTPValidationError + +genHTTPValidationError :: Int -> Gen HTTPValidationError +genHTTPValidationError n = + HTTPValidationError + <$> arbitraryReducedMaybe n -- hTTPValidationErrorDetail :: Maybe [ValidationError] + +instance Arbitrary Image where + arbitrary = sized genImage + +genImage :: Int -> Gen Image +genImage n = + Image + <$> arbitrary -- imageUrl :: Text + <*> arbitrary -- imageB64Json :: Text + <*> arbitrary -- imageRevisedPrompt :: Text + +instance Arbitrary ImageGenerationConfig where + arbitrary = sized genImageGenerationConfig + +genImageGenerationConfig :: Int -> Gen ImageGenerationConfig +genImageGenerationConfig n = + ImageGenerationConfig + <$> arbitrary -- imageGenerationConfigPrompt :: Text + <*> arbitraryReducedMaybe n -- imageGenerationConfigModel :: Maybe Text + <*> arbitraryReducedMaybe n -- imageGenerationConfigProvider :: Maybe Text + <*> arbitraryReducedMaybe n -- imageGenerationConfigResponseFormat :: Maybe Text + <*> arbitraryReducedMaybe n -- imageGenerationConfigApiKey :: Maybe Text + <*> arbitraryReducedMaybe n -- imageGenerationConfigProxy :: Maybe Text + <*> arbitraryReducedMaybe n -- imageGenerationConfigWidth :: Maybe Int + <*> arbitraryReducedMaybe n -- imageGenerationConfigHeight :: Maybe Int + <*> arbitraryReducedMaybe n -- imageGenerationConfigNumInferenceSteps :: Maybe Int + <*> arbitraryReducedMaybe n -- imageGenerationConfigSeed :: Maybe Int + <*> arbitraryReducedMaybe n -- imageGenerationConfigGuidanceScale :: Maybe Int + <*> arbitraryReducedMaybe n -- imageGenerationConfigAspectRatio :: Maybe Text + <*> arbitraryReducedMaybe n -- imageGenerationConfigN :: Maybe Int + <*> arbitraryReducedMaybe n -- imageGenerationConfigNegativePrompt :: Maybe Text + <*> arbitraryReducedMaybe n -- imageGenerationConfigResolution :: Maybe Text + <*> arbitraryReducedMaybe n -- imageGenerationConfigAudio :: Maybe (Map.Map String AnyType) + <*> arbitraryReducedMaybe n -- imageGenerationConfigDownloadMedia :: Maybe Bool + +instance Arbitrary ImagesResponse where + arbitrary = sized genImagesResponse + +genImagesResponse :: Int -> Gen ImagesResponse +genImagesResponse n = + ImagesResponse + <$> arbitraryReduced n -- imagesResponseData :: [Image] + <*> arbitrary -- imagesResponseModel :: Text + <*> arbitrary -- imagesResponseProvider :: Text + <*> arbitrary -- imagesResponseCreated :: Int + +instance Arbitrary Message where + arbitrary = sized genMessage + +genMessage :: Int -> Gen Message +genMessage n = + Message + <$> arbitrary -- messageRole :: Text + <*> arbitraryReduced n -- messageContent :: Content + +instance Arbitrary ModelResponseModel where + arbitrary = sized genModelResponseModel + +genModelResponseModel :: Int -> Gen ModelResponseModel +genModelResponseModel n = + ModelResponseModel + <$> arbitrary -- modelResponseModelId :: Text + <*> arbitraryReducedMaybe n -- modelResponseModelObject :: Maybe Text + <*> arbitrary -- modelResponseModelCreated :: Int + <*> arbitrary -- modelResponseModelOwnedBy :: Text + +instance Arbitrary PromptTokenDetails where + arbitrary = sized genPromptTokenDetails + +genPromptTokenDetails :: Int -> Gen PromptTokenDetails +genPromptTokenDetails n = + PromptTokenDetails + <$> arbitrary -- promptTokenDetailsCachedTokens :: Int + <*> arbitrary -- promptTokenDetailsAudioTokens :: Int + +instance Arbitrary ProviderResponseDetailModel where + arbitrary = sized genProviderResponseDetailModel + +genProviderResponseDetailModel :: Int -> Gen ProviderResponseDetailModel +genProviderResponseDetailModel n = + ProviderResponseDetailModel + <$> arbitrary -- providerResponseDetailModelId :: Text + <*> arbitraryReducedMaybe n -- providerResponseDetailModelObject :: Maybe Text + <*> arbitrary -- providerResponseDetailModelCreated :: Int + <*> arbitrary -- providerResponseDetailModelUrl :: Text + <*> arbitrary -- providerResponseDetailModelLabel :: Text + <*> arbitrary -- providerResponseDetailModelModels :: [Text] + <*> arbitrary -- providerResponseDetailModelImageModels :: [Text] + <*> arbitrary -- providerResponseDetailModelVisionModels :: [Text] + <*> arbitrary -- providerResponseDetailModelParams :: [Text] + +instance Arbitrary ProviderResponseModel where + arbitrary = sized genProviderResponseModel + +genProviderResponseModel :: Int -> Gen ProviderResponseModel +genProviderResponseModel n = + ProviderResponseModel + <$> arbitrary -- providerResponseModelId :: Text + <*> arbitraryReducedMaybe n -- providerResponseModelObject :: Maybe Text + <*> arbitrary -- providerResponseModelCreated :: Int + <*> arbitrary -- providerResponseModelUrl :: Text + <*> arbitrary -- providerResponseModelLabel :: Text + +instance Arbitrary Stop where + arbitrary = sized genStop + +genStop :: Int -> Gen Stop +genStop n = + + pure Stop + +instance Arbitrary ToolCallModel where + arbitrary = sized genToolCallModel + +genToolCallModel :: Int -> Gen ToolCallModel +genToolCallModel n = + ToolCallModel + <$> arbitrary -- toolCallModelId :: Text + <*> arbitrary -- toolCallModelType :: Text + <*> arbitraryReduced n -- toolCallModelFunction :: ToolFunctionModel + +instance Arbitrary ToolFunctionModel where + arbitrary = sized genToolFunctionModel + +genToolFunctionModel :: Int -> Gen ToolFunctionModel +genToolFunctionModel n = + ToolFunctionModel + <$> arbitrary -- toolFunctionModelName :: Text + <*> arbitrary -- toolFunctionModelArguments :: Text + +instance Arbitrary TranscriptionResponseModel where + arbitrary = sized genTranscriptionResponseModel + +genTranscriptionResponseModel :: Int -> Gen TranscriptionResponseModel +genTranscriptionResponseModel n = + TranscriptionResponseModel + <$> arbitrary -- transcriptionResponseModelText :: Text + <*> arbitrary -- transcriptionResponseModelModel :: Text + <*> arbitrary -- transcriptionResponseModelProvider :: Text + +instance Arbitrary UsageModel where + arbitrary = sized genUsageModel + +genUsageModel :: Int -> Gen UsageModel +genUsageModel n = + UsageModel + <$> arbitrary -- usageModelPromptTokens :: Int + <*> arbitrary -- usageModelCompletionTokens :: Int + <*> arbitrary -- usageModelTotalTokens :: Int + <*> arbitraryReduced n -- usageModelPromptTokensDetails :: PromptTokenDetails + <*> arbitraryReduced n -- usageModelCompletionTokensDetails :: CompletionTokenDetails + <*> arbitraryReducedMaybe n -- usageModelCache :: Maybe Text + +instance Arbitrary ValidationError where + arbitrary = sized genValidationError + +genValidationError :: Int -> Gen ValidationError +genValidationError n = + ValidationError + <$> arbitraryReduced n -- validationErrorLoc :: [ValidationErrorLocInner] + <*> arbitrary -- validationErrorMsg :: Text + <*> arbitrary -- validationErrorType :: Text + <*> arbitraryReduced n -- validationErrorInput :: AnyType + <*> arbitraryReduced n -- validationErrorCtx :: AnyType + +instance Arbitrary ValidationErrorLocInner where + arbitrary = sized genValidationErrorLocInner + +genValidationErrorLocInner :: Int -> Gen ValidationErrorLocInner +genValidationErrorLocInner n = + + pure ValidationErrorLocInner + + + + diff --git a/tests/PropMime.hs b/tests/PropMime.hs new file mode 100644 index 0000000..eccbfbe --- /dev/null +++ b/tests/PropMime.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ConstraintKinds #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + +module PropMime where + +import Data.Aeson +import Data.Aeson.Types (parseEither) +import Data.Monoid ((<>)) +import Data.Typeable (Proxy(..), typeOf, Typeable) +import qualified Data.ByteString.Lazy.Char8 as BL8 +import Test.Hspec +import Test.QuickCheck +import Test.QuickCheck.Property +import Test.Hspec.QuickCheck (prop) + +import G4fClient.MimeTypes + +import ApproxEq + +-- * Type Aliases + +type ArbitraryMime mime a = ArbitraryRoundtrip (MimeUnrender mime) (MimeRender mime) a + +type ArbitraryRoundtrip from to a = (from a, to a, Arbitrary' a) + +type Arbitrary' a = (Arbitrary a, Show a, Typeable a) + +-- * Mime + +propMime + :: forall a b mime. + (ArbitraryMime mime a, Testable b) + => String -> (a -> a -> b) -> mime -> Proxy a -> Spec +propMime eqDescr eq m _ = + prop + (show (typeOf (undefined :: a)) <> " " <> show (typeOf (undefined :: mime)) <> " roundtrip " <> eqDescr) $ + \(x :: a) -> + let rendered = mimeRender' m x + actual = mimeUnrender' m rendered + expected = Right x + failMsg = + "ACTUAL: " <> show actual <> "\nRENDERED: " <> BL8.unpack rendered + in counterexample failMsg $ + either reject property (eq <$> actual <*> expected) + where + reject = property . const rejected + +propMimeEq :: (ArbitraryMime mime a, Eq a) => mime -> Proxy a -> Spec +propMimeEq = propMime "(EQ)" (==) diff --git a/tests/Test.hs b/tests/Test.hs new file mode 100644 index 0000000..152472b --- /dev/null +++ b/tests/Test.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE PartialTypeSignatures #-} + +module Main where + +import Data.Typeable (Proxy(..)) +import Test.Hspec +import Test.Hspec.QuickCheck + +import PropMime +import Instances () + +import G4fClient.Model +import G4fClient.MimeTypes + +main :: IO () +main = + hspec $ modifyMaxSize (const 10) $ do + describe "JSON instances" $ do + pure () + propMimeEq MimeJSON (Proxy :: Proxy ApiKey) + propMimeEq MimeJSON (Proxy :: Proxy AudioResponseModel) + propMimeEq MimeJSON (Proxy :: Proxy AudioSpeechConfig) + propMimeEq MimeJSON (Proxy :: Proxy ChatCompletion) + propMimeEq MimeJSON (Proxy :: Proxy ChatCompletionChoice) + propMimeEq MimeJSON (Proxy :: Proxy ChatCompletionMessage) + propMimeEq MimeJSON (Proxy :: Proxy ChatCompletionsConfig) + propMimeEq MimeJSON (Proxy :: Proxy CompletionTokenDetails) + propMimeEq MimeJSON (Proxy :: Proxy Content) + propMimeEq MimeJSON (Proxy :: Proxy ContentPart) + propMimeEq MimeJSON (Proxy :: Proxy ErrorResponseMessageModel) + propMimeEq MimeJSON (Proxy :: Proxy ErrorResponseModel) + propMimeEq MimeJSON (Proxy :: Proxy FileResponseModel) + propMimeEq MimeJSON (Proxy :: Proxy HTTPValidationError) + propMimeEq MimeJSON (Proxy :: Proxy Image) + propMimeEq MimeJSON (Proxy :: Proxy ImageGenerationConfig) + propMimeEq MimeJSON (Proxy :: Proxy ImagesResponse) + propMimeEq MimeJSON (Proxy :: Proxy Message) + propMimeEq MimeJSON (Proxy :: Proxy ModelResponseModel) + propMimeEq MimeJSON (Proxy :: Proxy PromptTokenDetails) + propMimeEq MimeJSON (Proxy :: Proxy ProviderResponseDetailModel) + propMimeEq MimeJSON (Proxy :: Proxy ProviderResponseModel) + propMimeEq MimeJSON (Proxy :: Proxy Stop) + propMimeEq MimeJSON (Proxy :: Proxy ToolCallModel) + propMimeEq MimeJSON (Proxy :: Proxy ToolFunctionModel) + propMimeEq MimeJSON (Proxy :: Proxy TranscriptionResponseModel) + propMimeEq MimeJSON (Proxy :: Proxy UsageModel) + propMimeEq MimeJSON (Proxy :: Proxy ValidationError) + propMimeEq MimeJSON (Proxy :: Proxy ValidationErrorLocInner) + |