70 lines
2.6 KiB
Haskell
70 lines
2.6 KiB
Haskell
{-# LANGUAGE Safe #-}
|
|
{-# LANGUAGE TypeFamilies #-} -- for KeyType
|
|
{-# LANGUAGE FlexibleContexts #-} -- use non type-variable argument in instance head
|
|
{-# LANGUAGE UndecidableInstances #-} -- use type family in instance head
|
|
{-# LANGUAGE InstanceSigs #-} -- type signature in Show and Read instance
|
|
{-# LANGUAGE StandaloneDeriving #-} -- derive Eq
|
|
-- | A Map that derives the keys for the mapping from the items.
|
|
|
|
module Data.Map.Implicit (ImplicitMap(), get, ImplicitKeyOf(..), empty, fromList) 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.Read (Read (readPrec), ReadPrec)
|
|
import Data.List qualified as List
|
|
import Control.Arrow (Arrow ((&&&)), (>>>))
|
|
import Data.Functor ((<$>))
|
|
import Data.Ord (Ord)
|
|
import Data.Eq (Eq)
|
|
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
|
|
import Test.QuickCheck.Gen (Gen)
|
|
|
|
-- | This map will use the 'ImplicitKeyOf' class to compute the keys of the values.
|
|
|
|
type ImplicitMap :: Type -> Type
|
|
type role ImplicitMap nominal
|
|
newtype ImplicitMap v = ImplicitMap { get :: Map (KeyType v) v }
|
|
|
|
deriving stock instance (Eq v, Eq (KeyType v)) => Eq (ImplicitMap v)
|
|
|
|
instance (Show v) => Show (ImplicitMap v) where
|
|
-- Serialize via the list of elements to avoid breaking invariants help by the map
|
|
show :: ImplicitMap v -> String
|
|
show = show . ImplicitMapElems . Map.elems . get
|
|
|
|
instance (Read v, ImplicitKeyOf v, Ord (KeyType v)) => Read (ImplicitMap v) where
|
|
-- Serialize via the list of elements to avoid breaking invariants help by the map
|
|
readPrec :: ReadPrec (ImplicitMap v)
|
|
readPrec = ImplicitMap . Map.fromList . List.map (keyOf &&& id) . (\(ImplicitMapElems es) -> es) <$> readPrec
|
|
|
|
instance (Arbitrary v, ImplicitKeyOf v, Ord (KeyType v)) => Arbitrary (ImplicitMap v) where
|
|
arbitrary :: Gen (ImplicitMap v)
|
|
arbitrary = fromList . (\(ImplicitMapElems es) -> es) <$> arbitrary
|
|
|
|
|
|
-- | This is my helper type for the Show and Read instances of 'ImplicitMap'
|
|
|
|
type ImplicitMapElems :: Type -> Type
|
|
type role ImplicitMapElems representational
|
|
newtype ImplicitMapElems v = ImplicitMapElems [v]
|
|
deriving stock (Show, Read)
|
|
|
|
instance (Arbitrary v) => Arbitrary (ImplicitMapElems v) where
|
|
arbitrary :: Gen (ImplicitMapElems v)
|
|
arbitrary = ImplicitMapElems <$> arbitrary
|
|
|
|
type ImplicitKeyOf :: Type -> Constraint
|
|
class ImplicitKeyOf v where
|
|
type KeyType v :: Type
|
|
keyOf :: v -> KeyType v
|
|
|
|
empty :: ImplicitMap v
|
|
empty = ImplicitMap Map.empty
|
|
|
|
fromList :: (ImplicitKeyOf v, Ord (KeyType v)) => [v] -> ImplicitMap v
|
|
fromList = List.map (keyOf &&& id)
|
|
>>> Map.fromList
|
|
>>> ImplicitMap
|