From d38c30e318975129ed5173185365de25654ac3ec Mon Sep 17 00:00:00 2001
From: VegOwOtenks <vegowotenks@jossco.de>
Date: Tue, 12 Aug 2025 14:41:47 +0200
Subject: [PATCH] fix: read ImplicitMap lawfully

Previously, the read instance could be used to break invariants.
---
 src/Data/Map/Implicit.hs | 28 +++++++++++++++++++++-------
 1 file changed, 21 insertions(+), 7 deletions(-)

diff --git a/src/Data/Map/Implicit.hs b/src/Data/Map/Implicit.hs
index ab2906e..83d5c4a 100644
--- a/src/Data/Map/Implicit.hs
+++ b/src/Data/Map/Implicit.hs
@@ -1,27 +1,41 @@
 {-# LANGUAGE Safe #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE StandaloneDeriving #-} -- specify instance contexts
+{-# LANGUAGE TypeFamilies #-} -- for KeyType
 {-# LANGUAGE FlexibleContexts #-} -- use non type-variable argument in instance head
 {-# LANGUAGE UndecidableInstances #-} -- use type family in instance head
+{-# LANGUAGE InstanceSigs #-}
 -- | A Map that derives the keys for the mapping from the items.
 
 module Data.Map.Implicit (ImplicitMap(), get, ImplicitKeyOf(..), empty) where
 import Data.Kind (Type, Constraint)
 import Data.Map (Map)
+import Text.Show (Show (show))
+import Data.String (String)
+import Control.Category ((.), Category (id))
 import Data.Map qualified as Map
-import Text.Show (Show)
-import Text.Read (Read)
+import Text.Read (Read (readPrec), ReadPrec)
+import Data.List qualified as List
+import Control.Arrow (Arrow ((&&&)))
+import Data.Functor ((<$>))
 import Data.Ord (Ord)
 
 type ImplicitMap :: Type -> Type
 type role ImplicitMap nominal
 newtype ImplicitMap v = ImplicitMap { get :: Map (KeyType v) v }
 
-deriving stock instance (Show (KeyType v), Show v) => Show (ImplicitMap v)
-deriving stock instance (Read (KeyType v), Ord (KeyType v), Read v) => Read (ImplicitMap v)
+type ImplicitMapElems :: Type -> Type
+type role ImplicitMapElems representational
+newtype ImplicitMapElems v = ImplicitMapElems { elems :: [v] }
+  deriving stock (Show, Read)
+
+instance (Show v) => Show (ImplicitMap v) where
+  show :: ImplicitMap v -> String
+  show = show . ImplicitMapElems . Map.elems . get
+
+instance (Read v, ImplicitKeyOf v, Ord (KeyType v)) => Read (ImplicitMap v) where
+  readPrec :: ReadPrec (ImplicitMap v)
+  readPrec = ImplicitMap . Map.fromList . List.map (keyOf &&& id) . elems <$> readPrec
 
 type ImplicitKeyOf :: Type -> Constraint
-
 class ImplicitKeyOf v where
   type KeyType v :: Type
   keyOf :: v -> KeyType v