{-# 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