{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Data.DynamicState (
DynamicState(..),
getDyn,
setDyn,
_dyn
) where
import Data.Dynamic
import Data.HashMap.Strict as M
import Data.ConcreteTypeRep
newtype DynamicState = DynamicState { DynamicState -> HashMap ConcreteTypeRep Dynamic
unDynamicState :: M.HashMap ConcreteTypeRep Dynamic }
deriving (Typeable)
#if __GLASGOW_HASKELL__ >= 804
instance Semigroup DynamicState where
<> :: DynamicState -> DynamicState -> DynamicState
(<>) = DynamicState -> DynamicState -> DynamicState
forall a. Monoid a => a -> a -> a
mappend
#endif
instance Monoid DynamicState where
mappend :: DynamicState -> DynamicState -> DynamicState
mappend (DynamicState a :: HashMap ConcreteTypeRep Dynamic
a) (DynamicState b :: HashMap ConcreteTypeRep Dynamic
b) = HashMap ConcreteTypeRep Dynamic -> DynamicState
DynamicState (HashMap ConcreteTypeRep Dynamic
-> HashMap ConcreteTypeRep Dynamic
-> HashMap ConcreteTypeRep Dynamic
forall a. Monoid a => a -> a -> a
mappend HashMap ConcreteTypeRep Dynamic
a HashMap ConcreteTypeRep Dynamic
b)
mempty :: DynamicState
mempty = HashMap ConcreteTypeRep Dynamic -> DynamicState
DynamicState HashMap ConcreteTypeRep Dynamic
forall a. Monoid a => a
mempty
getDyn :: forall a. Typeable a => DynamicState -> Maybe a
getDyn :: DynamicState -> Maybe a
getDyn (DynamicState ds :: HashMap ConcreteTypeRep Dynamic
ds) = ConcreteTypeRep -> HashMap ConcreteTypeRep Dynamic -> Maybe Dynamic
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup (a -> ConcreteTypeRep
forall a. Typeable a => a -> ConcreteTypeRep
cTypeOf (a
forall a. HasCallStack => a
undefined :: a)) HashMap ConcreteTypeRep Dynamic
ds Maybe Dynamic -> (Dynamic -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic
setDyn :: forall a. Typeable a => DynamicState -> a -> DynamicState
setDyn :: DynamicState -> a -> DynamicState
setDyn (DynamicState ds :: HashMap ConcreteTypeRep Dynamic
ds) x :: a
x = HashMap ConcreteTypeRep Dynamic -> DynamicState
DynamicState (HashMap ConcreteTypeRep Dynamic -> DynamicState)
-> HashMap ConcreteTypeRep Dynamic -> DynamicState
forall a b. (a -> b) -> a -> b
$ ConcreteTypeRep
-> Dynamic
-> HashMap ConcreteTypeRep Dynamic
-> HashMap ConcreteTypeRep Dynamic
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert (a -> ConcreteTypeRep
forall a. Typeable a => a -> ConcreteTypeRep
cTypeOf (a
forall a. HasCallStack => a
undefined :: a)) (a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn a
x) HashMap ConcreteTypeRep Dynamic
ds
_dyn :: (Typeable a, Functor f) => a -> (a -> f a) -> DynamicState -> f DynamicState
_dyn :: a -> (a -> f a) -> DynamicState -> f DynamicState
_dyn def :: a
def afb :: a -> f a
afb s :: DynamicState
s = DynamicState -> a -> DynamicState
forall a. Typeable a => DynamicState -> a -> DynamicState
setDyn DynamicState
s (a -> DynamicState) -> f a -> f DynamicState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
afb (a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
def a -> a
forall a. a -> a
id (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ DynamicState -> Maybe a
forall a. Typeable a => DynamicState -> Maybe a
getDyn DynamicState
s)