{-# LANGUAGE UndecidableInstances #-}

module Language.LSP.Protocol.QuickCheck.Common where

import Data.Foldable
import Data.Row qualified as R
import Data.Row.Records qualified as R
import GHC.TypeLits
import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types
import Test.QuickCheck
import Test.QuickCheck.Instances ()

instance (Arbitrary a, Arbitrary b) => Arbitrary (a |? b) where
  arbitrary :: Gen (a |? b)
arbitrary = [Gen (a |? b)] -> Gen (a |? b)
forall a. HasCallStack => [Gen a] -> Gen a
oneof [a -> a |? b
forall a b. a -> a |? b
InL (a -> a |? b) -> Gen a -> Gen (a |? b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary, b -> a |? b
forall a b. b -> a |? b
InR (b -> a |? b) -> Gen b -> Gen (a |? b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen b
forall a. Arbitrary a => Gen a
arbitrary]
  shrink :: (a |? b) -> [a |? b]
shrink = (a |? b) -> [a |? b]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Null where
  arbitrary :: Gen Null
arbitrary = Null -> Gen Null
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Null
Null

instance (R.AllUniqueLabels r, R.Forall r Arbitrary) => Arbitrary (R.Rec r) where
  arbitrary :: Gen (Rec r)
arbitrary = forall (c :: * -> Constraint) (f :: * -> *) (ρ :: Row (*)).
(Applicative f, Forall ρ c, AllUniqueLabels ρ) =>
(forall (l :: Symbol) a. (KnownSymbol l, c a) => Label l -> f a)
-> f (Rec ρ)
R.fromLabelsA @Arbitrary ((forall (l :: Symbol) a.
  (KnownSymbol l, Arbitrary a) =>
  Label l -> Gen a)
 -> Gen (Rec r))
-> (forall (l :: Symbol) a.
    (KnownSymbol l, Arbitrary a) =>
    Label l -> Gen a)
-> Gen (Rec r)
forall a b. (a -> b) -> a -> b
$ \Label l
_l -> Gen a
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Rec r -> [Rec r]
shrink Rec r
record = forall (c :: * -> Constraint) (f :: * -> *) (r :: Row (*)).
(Forall r c, Applicative f) =>
(forall a. c a => a -> f a) -> Rec r -> f (Rec r)
R.traverse @Arbitrary @[] a -> [a]
forall a. Arbitrary a => a -> [a]
shrink Rec r
record

instance Arbitrary UInt where
  arbitrary :: Gen UInt
arbitrary = Integer -> UInt
forall a. Num a => Integer -> a
fromInteger (Integer -> UInt) -> Gen Integer -> Gen UInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary Uri where
  arbitrary :: Gen Uri
arbitrary = Text -> Uri
Uri (Text -> Uri) -> Gen Text -> Gen Uri
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Uri -> [Uri]
shrink = Uri -> [Uri]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary (LspId m) where
  arbitrary :: Gen (LspId m)
arbitrary = [Gen (LspId m)] -> Gen (LspId m)
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Int32 -> LspId m
forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt (Int32 -> LspId m) -> Gen Int32 -> Gen (LspId m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int32
forall a. Arbitrary a => Gen a
arbitrary, Text -> LspId m
forall (f :: MessageDirection) (m :: Method f 'Request).
Text -> LspId m
IdString (Text -> LspId m) -> Gen Text -> Gen (LspId m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary]
  shrink :: LspId m -> [LspId m]
shrink = LspId m -> [LspId m]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance (LspEnum a) => Arbitrary (AsLspEnum a) where
  arbitrary :: Gen (AsLspEnum a)
arbitrary = [AsLspEnum a] -> Gen (AsLspEnum a)
forall a. HasCallStack => [a] -> Gen a
elements ([AsLspEnum a] -> Gen (AsLspEnum a))
-> [AsLspEnum a] -> Gen (AsLspEnum a)
forall a b. (a -> b) -> a -> b
$ a -> AsLspEnum a
forall a. a -> AsLspEnum a
AsLspEnum (a -> AsLspEnum a) -> [a] -> [AsLspEnum a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set a -> [a]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set a
forall a. LspEnum a => Set a
knownValues

instance (KnownSymbol s) => Arbitrary (AString s) where
  arbitrary :: Gen (AString s)
arbitrary = AString s -> Gen (AString s)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AString s -> Gen (AString s)) -> AString s -> Gen (AString s)
forall a b. (a -> b) -> a -> b
$ AString s
forall (s :: Symbol). KnownSymbol s => AString s
AString

instance (KnownNat n) => Arbitrary (AnInteger n) where
  arbitrary :: Gen (AnInteger n)
arbitrary = AnInteger n -> Gen (AnInteger n)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnInteger n -> Gen (AnInteger n))
-> AnInteger n -> Gen (AnInteger n)
forall a b. (a -> b) -> a -> b
$ AnInteger n
forall (n :: Nat). KnownNat n => AnInteger n
AnInteger