module Data.Object.Dynamic.Types where
import Control.Applicative ((<$>),pure, (<|>))
import qualified Control.Category as Cat ((.))
import Control.Lens
import Control.Lens.Iso
import Data.Dynamic
import qualified Data.Map as Map
newtype Object u = Object {unObject :: Table}
instance Objective (Object u) where
table = iso unObject Object
newtype Table = Table {unTable :: Map.Map TypeRep Dynamic}
class Objective o where
table :: Simple Iso o Table
tableMap :: Simple Iso o (Map.Map TypeRep Dynamic)
tableMap = table Cat.. (iso unTable Table)
class (Objective o,Typeable memb, Typeable (ValType o memb)) => Member o memb where
type ValType o memb :: *
type MemberLens o memb = (Member o memb) => Simple Traversal o (ValType o memb)
memberLensDef ::
(Member o memb)
=> memb
-> (o -> Maybe (ValType o memb))
-> MemberLens o memb
memberLensDef label0 def0 r2ar obj =
case (Map.lookup key (unTable tbl) >>= fromDynamic) <|> def0 obj of
Just r -> go r
Nothing -> pure obj
where
tbl :: Table
tbl = obj ^. table
key :: TypeRep
key = typeOf label0
go r = (\r' -> obj & over tableMap (Map.insert key (toDyn r')) )
<$> r2ar r
memberLens :: (Member o memb) => memb -> MemberLens o memb
memberLens label0 = memberLensDef label0 (const Nothing)
insert :: (Objective o, Member o memb, ValType o memb ~ val,
Typeable memb, Typeable val)
=> memb -> val -> o -> o
insert label0 val0 = over tableMap $ Map.insert tag (toDyn val0)
where
tag :: TypeRep
tag = typeOf label0