From a335ff0307aea33aa32f3a7e1e263f665a6a02e6 Mon Sep 17 00:00:00 2001
From: Victor Miraldo <victor.miraldo@converge.io>
Date: Fri, 10 Apr 2026 10:14:25 +0200
Subject: [PATCH 1/2] Add a FromJSONKey instance for Data.Fixed

---
 src/Data/Aeson/Types/FromJSON.hs | 10 ++++++++++
 tests/PropertyKeys.hs            |  3 +++
 2 files changed, 13 insertions(+)

diff --git a/src/Data/Aeson/Types/FromJSON.hs b/src/Data/Aeson/Types/FromJSON.hs
index 7fbacaeaa..f908ab5b9 100644
--- a/src/Data/Aeson/Types/FromJSON.hs
+++ b/src/Data/Aeson/Types/FromJSON.hs
@@ -216,6 +216,12 @@ parseScientificText = scanScientific
     (\sci rest -> if T.null rest then return sci else fail $ "Expecting end-of-input, got " ++ show (T.take 10 rest))
     fail
 
+parseBoundedScientificText :: Text -> Parser Scientific
+parseBoundedScientificText t = parseScientificText t >>= rejectLargeExponent
+  where
+    rejectLargeExponent :: Scientific -> Parser Scientific
+    rejectLargeExponent s = withBoundedScientific' pure (Number s)
+
 parseIntegralText :: Integral a => String -> Text -> Parser a
 parseIntegralText name t =
     prependContext name $
@@ -1730,6 +1736,10 @@ instance (FromJSON a, Integral a) => FromJSON (Ratio a) where
 instance HasResolution a => FromJSON (Fixed a) where
     parseJSON = prependContext "Fixed" . withBoundedScientific' (pure . realToFrac)
 
+instance HasResolution a => FromJSONKey (Fixed a) where
+  fromJSONKey = FromJSONKeyTextParser $ \t ->
+      realToFrac <$> parseBoundedScientificText t
+
 instance FromJSON Int where
     parseJSON = parseBoundedIntegral "Int"
 
diff --git a/tests/PropertyKeys.hs b/tests/PropertyKeys.hs
index 56ed2cb1f..b79d9fc73 100644
--- a/tests/PropertyKeys.hs
+++ b/tests/PropertyKeys.hs
@@ -6,6 +6,7 @@ module PropertyKeys ( keysTests ) where
 import Prelude.Compat
 
 import Control.Applicative (Const)
+import Data.Fixed
 import Data.Time.Compat (Day, LocalTime, TimeOfDay, UTCTime)
 import Data.Time.Calendar.Compat (DayOfWeek)
 import Data.Time.Calendar.Month.Compat (Month)
@@ -47,4 +48,6 @@ keysTests =
     , testProperty "Lazy Text"     $ roundTripKey @LT.Text
     , testProperty "UUID"          $ roundTripKey @UUID.UUID
     , testProperty "Const Text"    $ roundTripKey @(Const T.Text ())
+    , testProperty "Fixed E3"      $ roundTripKey @(Fixed E3)
+    , testProperty "Fixed E6"      $ roundTripKey @(Fixed E6)
     ]

From e2d453b0bc9529dd5452003893e79781f317eeca Mon Sep 17 00:00:00 2001
From: Victor Miraldo <victor.miraldo@converge.io>
Date: Tue, 14 Apr 2026 13:38:06 +0200
Subject: [PATCH 2/2] Explicit import list; avoid duplication refactoring some
 scientific parsing functions

---
 src/Data/Aeson/Types/FromJSON.hs | 20 ++++++++++----------
 tests/PropertyKeys.hs            |  2 +-
 2 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/src/Data/Aeson/Types/FromJSON.hs b/src/Data/Aeson/Types/FromJSON.hs
index f908ab5b9..00253614e 100644
--- a/src/Data/Aeson/Types/FromJSON.hs
+++ b/src/Data/Aeson/Types/FromJSON.hs
@@ -216,22 +216,22 @@ parseScientificText = scanScientific
     (\sci rest -> if T.null rest then return sci else fail $ "Expecting end-of-input, got " ++ show (T.take 10 rest))
     fail
 
-parseBoundedScientificText :: Text -> Parser Scientific
-parseBoundedScientificText t = parseScientificText t >>= rejectLargeExponent
-  where
-    rejectLargeExponent :: Scientific -> Parser Scientific
-    rejectLargeExponent s = withBoundedScientific' pure (Number s)
-
-parseIntegralText :: Integral a => String -> Text -> Parser a
-parseIntegralText name t =
+parseBoundedScientificTextTo :: (Scientific -> Parser a) -> String -> Text -> Parser a
+parseBoundedScientificTextTo toResultType name t =
     prependContext name $
             parseScientificText t
         >>= rejectLargeExponent
-        >>= parseIntegralFromScientific
+        >>= toResultType
   where
     rejectLargeExponent :: Scientific -> Parser Scientific
     rejectLargeExponent s = withBoundedScientific' pure (Number s)
 
+parseBoundedScientificText :: String -> Text -> Parser Scientific
+parseBoundedScientificText = parseBoundedScientificTextTo pure
+
+parseIntegralText :: Integral a => String -> Text -> Parser a
+parseIntegralText = parseBoundedScientificTextTo parseIntegralFromScientific
+
 parseBoundedIntegralText :: (Bounded a, Integral a) => String -> Text -> Parser a
 parseBoundedIntegralText name t =
     prependContext name $
@@ -1738,7 +1738,7 @@ instance HasResolution a => FromJSON (Fixed a) where
 
 instance HasResolution a => FromJSONKey (Fixed a) where
   fromJSONKey = FromJSONKeyTextParser $ \t ->
-      realToFrac <$> parseBoundedScientificText t
+      realToFrac <$> parseBoundedScientificText "Fixed" t
 
 instance FromJSON Int where
     parseJSON = parseBoundedIntegral "Int"
diff --git a/tests/PropertyKeys.hs b/tests/PropertyKeys.hs
index b79d9fc73..a67258997 100644
--- a/tests/PropertyKeys.hs
+++ b/tests/PropertyKeys.hs
@@ -6,7 +6,7 @@ module PropertyKeys ( keysTests ) where
 import Prelude.Compat
 
 import Control.Applicative (Const)
-import Data.Fixed
+import Data.Fixed (Fixed, E3, E6)
 import Data.Time.Compat (Day, LocalTime, TimeOfDay, UTCTime)
 import Data.Time.Calendar.Compat (DayOfWeek)
 import Data.Time.Calendar.Month.Compat (Month)