path: root/tests/Instances.hs

{-# 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 AnyType where
  arbitrary = AnyType <$> arbitrary

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