fix: read ImplicitMap lawfully
Previously, the read instance could be used to break invariants.
This commit is contained in:
parent
fd715d99e0
commit
d38c30e318
1 changed files with 21 additions and 7 deletions
|
@ -1,27 +1,41 @@
|
||||||
{-# LANGUAGE Safe #-}
|
{-# LANGUAGE Safe #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-} -- for KeyType
|
||||||
{-# LANGUAGE StandaloneDeriving #-} -- specify instance contexts
|
|
||||||
{-# LANGUAGE FlexibleContexts #-} -- use non type-variable argument in instance head
|
{-# LANGUAGE FlexibleContexts #-} -- use non type-variable argument in instance head
|
||||||
{-# LANGUAGE UndecidableInstances #-} -- use type family 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.
|
-- | A Map that derives the keys for the mapping from the items.
|
||||||
|
|
||||||
module Data.Map.Implicit (ImplicitMap(), get, ImplicitKeyOf(..), empty) where
|
module Data.Map.Implicit (ImplicitMap(), get, ImplicitKeyOf(..), empty) where
|
||||||
import Data.Kind (Type, Constraint)
|
import Data.Kind (Type, Constraint)
|
||||||
import Data.Map (Map)
|
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 Data.Map qualified as Map
|
||||||
import Text.Show (Show)
|
import Text.Read (Read (readPrec), ReadPrec)
|
||||||
import Text.Read (Read)
|
import Data.List qualified as List
|
||||||
|
import Control.Arrow (Arrow ((&&&)))
|
||||||
|
import Data.Functor ((<$>))
|
||||||
import Data.Ord (Ord)
|
import Data.Ord (Ord)
|
||||||
|
|
||||||
type ImplicitMap :: Type -> Type
|
type ImplicitMap :: Type -> Type
|
||||||
type role ImplicitMap nominal
|
type role ImplicitMap nominal
|
||||||
newtype ImplicitMap v = ImplicitMap { get :: Map (KeyType v) v }
|
newtype ImplicitMap v = ImplicitMap { get :: Map (KeyType v) v }
|
||||||
|
|
||||||
deriving stock instance (Show (KeyType v), Show v) => Show (ImplicitMap v)
|
type ImplicitMapElems :: Type -> Type
|
||||||
deriving stock instance (Read (KeyType v), Ord (KeyType v), Read v) => Read (ImplicitMap v)
|
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
|
type ImplicitKeyOf :: Type -> Constraint
|
||||||
|
|
||||||
class ImplicitKeyOf v where
|
class ImplicitKeyOf v where
|
||||||
type KeyType v :: Type
|
type KeyType v :: Type
|
||||||
keyOf :: v -> KeyType v
|
keyOf :: v -> KeyType v
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue