{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.GenValidity.Aeson where

import Data.Aeson
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (KeyMap)
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Aeson.Key as K
#endif
import Data.Foldable (toList)
import Data.GenValidity
import Data.GenValidity.HashMap ()
import Data.GenValidity.Scientific ()
import Data.GenValidity.Text ()
import Data.GenValidity.Vector ()
import Data.Validity.Aeson ()
import Test.QuickCheck

#if MIN_VERSION_aeson(2,0,0)
instance GenValid Key where
  genValid :: Gen Key
genValid = String -> Key
K.fromString (String -> Key) -> Gen String -> Gen Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. GenValid a => Gen a
genValid
  shrinkValid :: Key -> [Key]
shrinkValid = (String -> Key) -> [String] -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Key
K.fromString ([String] -> [Key]) -> (Key -> [String]) -> Key -> [Key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. GenValid a => a -> [a]
shrinkValid (String -> [String]) -> (Key -> String) -> Key -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> String
K.toString

instance (GenValid v) => GenValid (KeyMap v) where
  genValid :: Gen (KeyMap v)
genValid = [(Key, v)] -> KeyMap v
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([(Key, v)] -> KeyMap v) -> Gen [(Key, v)] -> Gen (KeyMap v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [(Key, v)]
forall a. GenValid a => Gen a
genValid
  shrinkValid :: KeyMap v -> [KeyMap v]
shrinkValid = ([(Key, v)] -> KeyMap v) -> [[(Key, v)]] -> [KeyMap v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Key, v)] -> KeyMap v
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([[(Key, v)]] -> [KeyMap v])
-> (KeyMap v -> [[(Key, v)]]) -> KeyMap v -> [KeyMap v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, v)] -> [[(Key, v)]]
forall a. GenValid a => a -> [a]
shrinkValid ([(Key, v)] -> [[(Key, v)]])
-> (KeyMap v -> [(Key, v)]) -> KeyMap v -> [[(Key, v)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap v -> [(Key, v)]
forall v. KeyMap v -> [(Key, v)]
KM.toList
#endif

instance GenValid Value where
  genValid :: Gen Value
genValid =
    [Gen Value] -> Gen Value
forall a. [Gen a] -> Gen a
oneof
      [ Object -> Value
Object (Object -> Value) -> Gen Object -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Object
forall a. GenValid a => Gen a
genValid,
        Array -> Value
Array (Array -> Value) -> Gen Array -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Array
forall a. GenValid a => Gen a
genValid,
        Text -> Value
String (Text -> Value) -> Gen Text -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. GenValid a => Gen a
genValid,
        Scientific -> Value
Number (Scientific -> Value) -> Gen Scientific -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Scientific
forall a. GenValid a => Gen a
genValid,
        Bool -> Value
Bool (Bool -> Value) -> Gen Bool -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. GenValid a => Gen a
genValid,
        Value -> Gen Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
      ]
  shrinkValid :: Value -> [Value]
shrinkValid (Object Object
hm) =
    Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Object
hm
      [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ (Object -> Value
Object (Object -> Value) -> [Object] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> [Object]
forall a. GenValid a => a -> [a]
shrinkValid Object
hm)
  shrinkValid (Array Array
a) =
    Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
a
      [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ (Array -> Value
Array (Array -> Value) -> [Array] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array -> [Array]
forall a. GenValid a => a -> [a]
shrinkValid Array
a)
  shrinkValid (String Text
s) = Text -> Value
String (Text -> Value) -> [Text] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
forall a. GenValid a => a -> [a]
shrinkValid Text
s
  shrinkValid (Number Scientific
s) = Scientific -> Value
Number (Scientific -> Value) -> [Scientific] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> [Scientific]
forall a. GenValid a => a -> [a]
shrinkValid Scientific
s
  shrinkValid (Bool Bool
s) = Bool -> Value
Bool (Bool -> Value) -> [Bool] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [Bool]
forall a. GenValid a => a -> [a]
shrinkValid Bool
s
  shrinkValid Value
Null = []