packages feed

haskell-google-genai-client-0.1.0: tests/ApproxEq.hs

{-# 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 GHC.Generics as G
import Test.QuickCheck

(==~) ::
  (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