TypedMap.hs

module TypedMap 
( TypedMap
, empty
, insert
, lookup
) where

import Data.Dynamic
import Data.Maybe (fromJust)
import qualified Data.Map as M

newtype TypedMap = TM { unTM :: M.Map TypeRep Dynamic }

empty :: TypedMap
empty = TM M.empty

insert :: Typeable a => a -> TypedMap -> TypedMap
insert a (TM m) = TM $ M.insert (typeOf a) (toDyn a) m

lookup :: Typeable a => TypedMap -> Maybe a
lookup (TM m) = res where 
  a = fromJust res
  res = M.lookup (typeOf a) m >>= fromDynamic

TypedMap_take2.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module TypedMap where

import Data.Dynamic
import Data.Maybe (fromJust)
import qualified Data.Map as M

import Prelude hiding (lookup)

newtype TypedMap (s :: [*]) = TM { unTM :: M.Map TypeRep Dynamic }

type family If (p :: Bool) (t  :: k) (f :: k) where
  If True t f = t
  If False t f = f

type family Elem (x :: *) (xs :: [*]) where
  Elem x '[] = False
  Elem x (x ': xs) = True
  Elem x (y ': xs) = Elem x xs

type Add x xs = If (Elem x xs) xs (x ': xs)

empty :: TypedMap '[]
empty = TM M.empty

insert :: (Typeable a, Add a s ~ (h ': t)) => a -> TypedMap s -> TypedMap (h ': t)
insert a (TM m) = TM $ M.insert (typeOf a) (toDyn a) m

lookup :: (Elem a s ~ True, Typeable a) => TypedMap s -> a
lookup (TM m) = res where 
  res = fromJust $ M.lookup (typeOf res) m >>= fromDynamic

instance Show (TypedMap '[]) where
  show _ = "[]"

instance (Typeable h, Show h, Show (TypedMap t)) => Show (TypedMap (h ': t)) where
  show tm@(TM m) = show (lookup tm :: h) ++ " : " ++ show (TM m :: TypedMap t)