#if __GLASGOW_HASKELL__ < 710
#endif
module Data.Hetero.DynDict
(
DynDict
, empty
, add
, InDict
, get
, modify
, set
, key
, KV(..)
, KVList(..)
, NotHasKey
, Ix
, ShowDynDict(..)
) where
import Data.Hetero.KVList
import Data.List (intercalate)
import Data.Proxy
import qualified Data.Sequence as S
import Data.Typeable (TypeRep, Typeable, typeOf)
import GHC.Exts (Any)
import GHC.TypeLits
import Unsafe.Coerce
newtype DynDict (kvs :: [KV *]) = DynDict (S.Seq Any)
empty :: DynDict '[]
empty = DynDict S.empty
add :: (NotHasKey k kvs) => proxy k -> v -> DynDict kvs -> DynDict (k ':= v ': kvs)
add _ v (DynDict d) = DynDict (unsafeCoerce v S.<| d)
getImpl :: forall i proxy k kvs v. ('Index i ~ Ix k kvs, KnownNat i) => proxy (k :: Symbol) -> DynDict kvs -> v
getImpl _ (DynDict d) = unsafeCoerce $ d `S.index` fromIntegral (natVal (Proxy :: Proxy i))
modifyImpl :: forall i proxy k kvs v. ('Index i ~ Ix k kvs, KnownNat i) => proxy (k :: Symbol) -> (v -> v) -> DynDict kvs -> DynDict kvs
modifyImpl _ f (DynDict d) = DynDict $
S.adjust (unsafeCoerce . f . unsafeCoerce) (fromIntegral (natVal (Proxy :: Proxy i))) d
class InDict (k :: Symbol) (v :: *) (kvs :: [KV *]) | k kvs -> v where
get' :: proxy k -> DynDict kvs -> v
modify' :: proxy k -> (v -> v) -> DynDict kvs -> DynDict kvs
#if __GLASGOW_HASKELL__ >= 710
instance InDict k v (k ':= v ': kvs) where
#else
instance InDict k v (k ':= v ': kvs) where
#endif
get' = getImpl
modify' = modifyImpl
instance (InDict k v kvs, 'Index i ~ Ix k (k' ':= v' ': kvs), KnownNat i) => InDict k v (k' ':= v' ': kvs) where
get' = getImpl
modify' = modifyImpl
get :: InDict k v kvs => proxy k -> DynDict kvs -> v
get = get'
modify :: (InDict k v kvs) => proxy k -> (v -> v) -> DynDict kvs -> DynDict kvs
modify = modify'
set :: (InDict k v kvs) => proxy k -> v -> DynDict kvs -> DynDict kvs
set p v = modify' p (const v)
class ShowDynDict (kvs :: [KV *]) where
showDict :: Int -> DynDict kvs -> [(String, String, TypeRep)]
instance ShowDynDict '[] where
showDict _ _ = []
instance (KnownSymbol k, Typeable v, Show v, ShowDynDict kvs) => ShowDynDict (k ':= v ': kvs) where
showDict i (DynDict t) =
(symbolVal (Proxy :: Proxy k), show (unsafeCoerce $ t `S.index` i :: v), typeOf (undefined :: v)):
showDict (i + 1) (unsafeCoerce $ DynDict t :: DynDict kvs)
instance ShowDynDict kvs => Show (DynDict kvs) where
show d = "DynDict {" ++
(intercalate ", " . map (\(k, v, t) -> k ++ " = " ++ v ++ " :: " ++ show t) $ showDict 0 d)
++ "}"