{-# OPTIONS_GHC -Wno-orphans #-}

{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE UndecidableInstances #-}

module GHCup.Types.JSON.MapIgnoreUnknownKeys where

import           GHCup.Types

import           Data.Aeson              hiding (Key)
import           Data.Aeson.Types        hiding (Key)

import qualified Data.Aeson.Key                as Key
import qualified Data.Aeson.KeyMap             as KeyMap
import qualified Data.Map.Strict               as Map

#if defined(STRICT_METADATA_PARSING)
-- | Use the instance of Map
instance (FromJSON (Map.Map k v)) => FromJSON (MapIgnoreUnknownKeys k v) where
  parseJSON = fmap MapIgnoreUnknownKeys . parseJSON
#else

-- | Create a Map ignoring KeyValue pair which fail at parse of the key
-- But if the key is parsed, the failures of parsing the value will not be ignored
instance (Ord k, FromJSONKey k, FromJSON v) => FromJSON (MapIgnoreUnknownKeys k v) where
  parseJSON :: Value -> Parser (MapIgnoreUnknownKeys k v)
parseJSON = String
-> (Object -> Parser (MapIgnoreUnknownKeys k v))
-> Value
-> Parser (MapIgnoreUnknownKeys k v)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"MapIgnoreUnknownKeys" ((Object -> Parser (MapIgnoreUnknownKeys k v))
 -> Value -> Parser (MapIgnoreUnknownKeys k v))
-> (Object -> Parser (MapIgnoreUnknownKeys k v))
-> Value
-> Parser (MapIgnoreUnknownKeys k v)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Map k v
m <- case FromJSONKeyFunction k
forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey of
      FromJSONKeyTextParser Text -> Parser k
f ->
        let doParse :: Key -> Value -> Parser (Map k v) -> Parser (Map k v)
doParse Key
k Value
v Parser (Map k v)
m = case (Text -> Parser k) -> Text -> Maybe k
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Text -> Parser k
f (Key -> Text
Key.toText Key
k) of
              Just k
k' -> k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k' (v -> Map k v -> Map k v)
-> Parser v -> Parser (Map k v -> Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser v
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser (Map k v -> Map k v) -> Parser (Map k v) -> Parser (Map k v)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Map k v)
m
              Maybe k
Nothing -> Parser (Map k v)
m
        in (Key -> Value -> Parser (Map k v) -> Parser (Map k v))
-> Parser (Map k v) -> Object -> Parser (Map k v)
forall v a. (Key -> v -> a -> a) -> a -> KeyMap v -> a
KeyMap.foldrWithKey Key -> Value -> Parser (Map k v) -> Parser (Map k v)
doParse (Map k v -> Parser (Map k v)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k v
forall k a. Map k a
Map.empty) Object
obj
      FromJSONKeyValue Value -> Parser k
f ->
        let doParse :: Key -> Value -> Parser (Map k v) -> Parser (Map k v)
doParse Key
k Value
v Parser (Map k v)
m = case (Value -> Parser k) -> Value -> Maybe k
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser k
f (Key -> Value
forall a. ToJSON a => a -> Value
toJSON Key
k) of
              Just k
k' -> k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k' (v -> Map k v -> Map k v)
-> Parser v -> Parser (Map k v -> Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser v
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser (Map k v -> Map k v) -> Parser (Map k v) -> Parser (Map k v)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Map k v)
m
              Maybe k
Nothing -> Parser (Map k v)
m
        in (Key -> Value -> Parser (Map k v) -> Parser (Map k v))
-> Parser (Map k v) -> Object -> Parser (Map k v)
forall v a. (Key -> v -> a -> a) -> a -> KeyMap v -> a
KeyMap.foldrWithKey Key -> Value -> Parser (Map k v) -> Parser (Map k v)
doParse (Map k v -> Parser (Map k v)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k v
forall k a. Map k a
Map.empty) Object
obj
      -- FromJSONKeyCoerce and FromJSONKeyText always parse to Success; hence use instance of Map
      FromJSONKeyFunction k
_ -> Value -> Parser (Map k v)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
obj)
    MapIgnoreUnknownKeys k v -> Parser (MapIgnoreUnknownKeys k v)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MapIgnoreUnknownKeys k v -> Parser (MapIgnoreUnknownKeys k v))
-> MapIgnoreUnknownKeys k v -> Parser (MapIgnoreUnknownKeys k v)
forall a b. (a -> b) -> a -> b
$ Map k v -> MapIgnoreUnknownKeys k v
forall k v. Map k v -> MapIgnoreUnknownKeys k v
MapIgnoreUnknownKeys Map k v
m
#endif

instance (ToJSON (Map.Map k v)) => ToJSON (MapIgnoreUnknownKeys k v) where
  toJSON :: MapIgnoreUnknownKeys k v -> Value
toJSON = Map k v -> Value
forall a. ToJSON a => a -> Value
toJSON (Map k v -> Value)
-> (MapIgnoreUnknownKeys k v -> Map k v)
-> MapIgnoreUnknownKeys k v
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapIgnoreUnknownKeys k v -> Map k v
forall k v. MapIgnoreUnknownKeys k v -> Map k v
unMapIgnoreUnknownKeys