module Test.QuickCheck.Classes.JSON
  ( jsonKeyLaws
  ) where

import ClassyPrelude
import Test.QuickCheck
import Test.QuickCheck.Property (failed)
import Test.QuickCheck.Classes
import Data.Aeson
import Data.Aeson.Encoding.Internal
import Data.Aeson.Types (parseMaybe)
import Data.Proxy
import Unsafe.Coerce -- DON'T PANIC, it's aeson's fault

jsonKeyLaws :: forall a. (Arbitrary a, FromJSONKey a, ToJSONKey a, Eq a, Show a, FromJSON a, ToJSON a) => Proxy a -> Laws
jsonKeyLaws _ = Laws "ToJSONKey/FromJSONKey"
  [ ("Partial Isomorphism", property $ \(a :: a) -> partialIsomorphism a)
  , ("Partial Isomorphism (List)", property $ \(as :: [a]) -> partialIsomorphism as)
  , ("Encoding Equals Value", property $ \(a :: a)
        -> let (toVal, toEnc) = case toJSONKey of
                 ToJSONKeyText toVal' toEnc' -> (String . toVal', retagEncoding . toEnc')
                 ToJSONKeyValue toVal' toEnc' -> (toVal', toEnc')
            in decode (encodingToLazyByteString $ toEnc a) == Just (toVal a)
    )
  ]
  where
    partialIsomorphism :: forall a'. (FromJSONKey a', ToJSONKey a', Eq a') => a' -> Property
    partialIsomorphism a = case (toJSONKey, fromJSONKey) of
      (ToJSONKeyText toVal _, FromJSONKeyCoerce _)
        -> property $ unsafeCoerce (toVal a) == a
      (ToJSONKeyText toVal _, FromJSONKeyText fromVal)
        -> property $ fromVal (toVal a) == a
      (ToJSONKeyText toVal _, FromJSONKeyTextParser parser)
        -> property $ parseMaybe parser (toVal a) == Just a
      (ToJSONKeyValue toVal _, FromJSONKeyValue parser)
        -> property $ parseMaybe parser (toVal a) == Just a
      (_, _)
        -> property failed