{-# LANGUAGE CPP #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.TypeMap.Internal.Dynamic where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative, (<$>))
#endif
import Data.Map (Map)
import Data.Proxy (Proxy(..))
import Data.Typeable
#if MIN_VERSION_base(4,10,0)
import GHC.Exts (Any)
import qualified Type.Reflection as T
#else
import GHC.Prim (Any, Proxy#)
#endif
import Unsafe.Coerce
import qualified Data.Map as Map
newtype TypeMap x = TypeMap (Map TypeRep Any)
type family Item x t
data OfType a
type instance Item (OfType a) t = a
null :: TypeMap x -> Bool
null (TypeMap m) = Map.null m
size :: TypeMap x -> Int
size (TypeMap m) = Map.size m
empty :: TypeMap x
empty = TypeMap Map.empty
insert
:: forall t x proxy
. Typeable t => proxy t -> Item x t -> TypeMap x -> TypeMap x
insert t v (TypeMap m) = TypeMap (Map.insert (typeRep t) (coerce v) m)
where
coerce :: Item x t -> Any
coerce = unsafeCoerce
(<:)
:: forall t x proxy
. Typeable t => TypeMap x -> (proxy t, Item x t) -> TypeMap x
(<:) tm (p, v) = insert p v tm
update
:: forall t x proxy
. Typeable t => proxy t -> (Item x t -> Maybe (Item x t)) -> TypeMap x -> TypeMap x
update t f (TypeMap m) = TypeMap (Map.update (coerce f) (typeRep t) m)
where
coerce :: (Item x t -> Maybe (Item x t)) -> (Any -> Maybe Any)
coerce = unsafeCoerce
lookup
:: forall t x proxy
. Typeable t => proxy t -> TypeMap x -> Maybe (Item x t)
lookup t (TypeMap m) = coerce (Map.lookup (typeRep t) m)
where
coerce :: Maybe Any -> Maybe (Item x t)
coerce = unsafeCoerce
delete
:: forall t x proxy
. Typeable t => proxy t -> TypeMap x -> TypeMap x
delete t (TypeMap m) = TypeMap (Map.delete (typeRep t) m)
union
:: forall x. TypeMap x -> TypeMap x -> TypeMap x
union (TypeMap m) (TypeMap n) = TypeMap (Map.union m n)
difference
:: forall x. TypeMap x -> TypeMap x -> TypeMap x
difference (TypeMap m) (TypeMap n) = TypeMap (Map.difference m n)
intersection
:: forall x y. TypeMap x -> TypeMap y -> TypeMap x
intersection (TypeMap m) (TypeMap n) = TypeMap (Map.intersection m n)
map
:: forall x y
. (forall t. Typeable t => Proxy t -> Item x t -> Item y t)
-> TypeMap x -> TypeMap y
map f (TypeMap m) = TypeMap (Map.mapWithKey f' m)
where f' = withTypeRep f (Proxy :: Proxy (ItemFun x y))
traverse
:: forall f x y
. Applicative f
=> (forall t. Typeable t => Proxy t -> Item x t -> f (Item y t))
-> TypeMap x -> f (TypeMap y)
traverse f (TypeMap m) = TypeMap <$> Map.traverseWithKey f' m
where f' = withTypeRep f (Proxy :: Proxy (ItemKleisli f x y))
type family Typed x t
type family UnTyped x
type instance Typed (OfType a) t = a
type instance UnTyped (OfType a) = a
data ItemFun x y
type instance Typed (ItemFun x y) t = Item x t -> Item y t
type instance UnTyped (ItemFun x y) = Any -> Any
data ItemKleisli (f :: * -> *) x y
type instance Typed (ItemKleisli f x y) t = Item x t -> f (Item y t)
type instance UnTyped (ItemKleisli f x y) = Any -> f Any
withTypeRep
:: forall x proxy
. (forall t. Typeable t => Proxy t -> Typed x t)
-> proxy x
-> TypeRep -> UnTyped x
#if MIN_VERSION_base(4,10,0)
withTypeRep f _ someRep =
case someRep of
T.SomeTypeRep (rep' :: T.TypeRep t) ->
(unsafeCoerce
((\rep -> T.withTypeable rep (f (Proxy :: Proxy a)))
:: forall a. T.TypeRep a -> Typed x a)
:: T.TypeRep t -> UnTyped x) rep'
#else
withTypeRep f _ rep =
withTypeable (WithTypeable f :: WithTypeable x) (\_ -> rep) Proxy
newtype WithTypeable x
= WithTypeable (forall t. Typeable t => Proxy t -> Typed x t)
withTypeable :: WithTypeable x -> (Proxy# () -> TypeRep) -> Proxy () -> UnTyped x
withTypeable = unsafeCoerce
#endif