    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE CPP #-}
    {-# OPTIONS_HADDOCK show-extensions #-}

    -- |
    -- Module      :  Data.DynamicState
    -- License     :  GPL2
    -- Maintainer  :  zcarterc@gmail.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- This module implements a simple HashMap ConcreteTypeRep Dynamic

    module Data.DynamicState (
      DynamicState(..),
      getDyn,
      setDyn,
      _dyn
      ) where

    import Data.Dynamic
    import Data.HashMap.Strict as M
    import Data.ConcreteTypeRep

    -- | An extensible record, indexed by type
    newtype DynamicState = DynamicState { DynamicState -> HashMap ConcreteTypeRep Dynamic
    unDynamicState :: M.HashMap ConcreteTypeRep Dynamic }
      deriving (Typeable)

    #if __GLASGOW_HASKELL__ >= 804
    instance Semigroup DynamicState where
      DynamicState HashMap ConcreteTypeRep Dynamic
    a <> :: DynamicState -> DynamicState -> DynamicState
    <> DynamicState HashMap ConcreteTypeRep Dynamic
    b = HashMap ConcreteTypeRep Dynamic -> DynamicState
    DynamicState (HashMap ConcreteTypeRep Dynamic
    a HashMap ConcreteTypeRep Dynamic
    -> HashMap ConcreteTypeRep Dynamic
    -> HashMap ConcreteTypeRep Dynamic
    forall a. Semigroup a => a -> a -> a
    <> HashMap ConcreteTypeRep Dynamic
    b)
    #endif

    instance Monoid DynamicState where
    #if !MIN_VERSION_base(4,11,0)
      mappend (DynamicState a) (DynamicState b) = DynamicState (mappend a b)
    #endif
      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 :: forall a. Typeable a => DynamicState -> Maybe a
    getDyn (DynamicState 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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
    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 :: forall a. Typeable a => DynamicState -> a -> DynamicState
    setDyn (DynamicState HashMap ConcreteTypeRep Dynamic
    ds) 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

    -- | Lens with default value
    _dyn :: (Typeable a, Functor f) => a -> (a -> f a) -> DynamicState -> f DynamicState
    _dyn :: forall a (f :: * -> *).
    (Typeable a, Functor f) =>
    a -> (a -> f a) -> DynamicState -> f DynamicState
    _dyn a
    def a -> f a
    afb 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)