fix: read ImplicitMap lawfully

Previously, the read instance could be used to break invariants.
This commit is contained in:
vegowotenks 2025-08-12 14:41:47 +02:00
parent fd715d99e0
commit d38c30e318

View file

@ -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