From d1f92d496d80c63d1255bcd335c492290397ee16 Mon Sep 17 00:00:00 2001
From: Divam <dfordivam@gmail.com>
Date: Sun, 3 Nov 2024 15:13:12 +0900
Subject: [PATCH] Add flag 'strict-metadata-parsing' to enable use of normal
 Map instance

This is for use in ghcup-metadata validation code
---
 ghcup.cabal                                  | 10 ++++++++++
 lib/GHCup/Types/JSON/MapIgnoreUnknownKeys.hs |  8 ++++++++
 2 files changed, 18 insertions(+)

diff --git a/ghcup.cabal b/ghcup.cabal
index f040554e..aec5e8a7 100644
--- a/ghcup.cabal
+++ b/ghcup.cabal
@@ -54,6 +54,13 @@ flag internal-downloader
   default:     False
   manual:      True
 
+flag strict-metadata-parsing
+  description:
+    Don't ignore unknown keys in metadata. Useful for metadata testing.
+
+  default:     False
+  manual:      True
+
 flag no-exe
   description: Don't build any executables
   default:     False
@@ -278,6 +285,9 @@ library
     cpp-options:   -DBRICK
     build-depends: vty ^>=6.0 || ^>=6.1 || ^>=6.2
 
+  if (flag(strict-metadata-parsing))
+    cpp-options:     -DSTRICT_METADATA_PARSING
+
 library ghcup-optparse
   import:             app-common-depends
   exposed-modules:
diff --git a/lib/GHCup/Types/JSON/MapIgnoreUnknownKeys.hs b/lib/GHCup/Types/JSON/MapIgnoreUnknownKeys.hs
index 210a7e31..f61063cf 100644
--- a/lib/GHCup/Types/JSON/MapIgnoreUnknownKeys.hs
+++ b/lib/GHCup/Types/JSON/MapIgnoreUnknownKeys.hs
@@ -1,5 +1,6 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 
+{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -14,6 +15,12 @@ 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
@@ -32,6 +39,7 @@ instance (Ord k, FromJSONKey k, FromJSON v) => FromJSON (MapIgnoreUnknownKeys k
       -- FromJSONKeyCoerce and FromJSONKeyText always parse to Success; hence use instance of Map
       _ -> parseJSON (Object obj)
     pure $ MapIgnoreUnknownKeys m
+#endif
 
 instance (ToJSON (Map.Map k v)) => ToJSON (MapIgnoreUnknownKeys k v) where
   toJSON = toJSON . unMapIgnoreUnknownKeys