module Data.Object.Dynamic.Types where
import Control.Applicative ((<|>))
import Control.Lens
import Data.Dynamic
import qualified Data.Map as Map
newtype Object = Object (Map.Map TypeRep Dynamic)
deriving (Typeable)
instance Show Object where
show (Object x) = ("Object"++) $ drop 8 $ show x
class Typeable a => KeyType a where
type ValType a :: *
type Member kt = Lens Object Object (Maybe (ValType kt)) (Maybe (ValType kt))
empty :: Object
empty = Object $ Map.empty
mkMember :: forall kt. (KeyType kt, Typeable (ValType kt)) => kt -> Member kt
mkMember k1 = lens gettr settr
where
gettr :: Object -> Maybe (ValType kt)
gettr (Object map0) = Map.lookup k map0 >>= fromDynamic
settr :: Object -> (Maybe (ValType kt)) -> Object
settr (Object map0) Nothing = Object $ Map.delete k map0
settr (Object map0) (Just x) = Object $ Map.insert k (toDyn x) map0
k :: TypeRep
k = typeOf k1
mkMemberWithDef ::
forall kt. (KeyType kt, Typeable (ValType kt)) =>
kt ->
ValType kt ->
Member kt
mkMemberWithDef k1 v1 = lens gettr settr
where
gettr :: Object -> Maybe (ValType kt)
gettr (Object map0) = (Map.lookup k map0 >>= fromDynamic)
<|> Just v1
settr :: Object -> (Maybe (ValType kt)) -> Object
settr (Object map0) Nothing = Object $ Map.delete k map0
settr (Object map0) (Just x) = Object $ Map.insert k (toDyn x) map0
k :: TypeRep
k = typeOf k1