diff --git a/examples/example00.hs b/examples/example00.hs index a8bf470..c9090b8 100644 --- a/examples/example00.hs +++ b/examples/example00.hs @@ -21,6 +21,15 @@ newtype Window = Window (TVar [(UUID, WindowMessage -> Affection StateData ())]) newtype Mouse = Mouse (TVar [(UUID, MouseMessage -> Affection StateData ())]) newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection StateData ())]) +generalSubscribe + :: TVar [(UUID, msg -> Affection StateData ())] + -> (msg -> Affection StateData()) + -> Affection StateData UUID +generalSubscribe t funct = do + uuid <- genUUID + liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) + return uuid + instance Participant Window StateData where type Mesg Window StateData = WindowMessage @@ -28,10 +37,7 @@ instance Participant Window StateData where subTups <- liftIO $ readTVarIO t return $ map snd subTups - partSubscribe (Window t) funct = do - uuid <- genUUID - liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) - return uuid + partSubscribe (Window t) = generalSubscribe t partUnSubscribe (Window t) uuid = liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid)) @@ -46,10 +52,7 @@ instance Participant Mouse StateData where subTups <- liftIO $ readTVarIO t return $ map snd subTups - partSubscribe (Mouse t) funct = do - uuid <- genUUID - liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) - return uuid + partSubscribe (Mouse t) = generalSubscribe t partUnSubscribe (Mouse t) uuid = liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid)) @@ -64,10 +67,7 @@ instance Participant Keyboard StateData where subTups <- liftIO $ readTVarIO t return $ map snd subTups - partSubscribe (Keyboard t) funct = do - uuid <- genUUID - liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) - return uuid + partSubscribe (Keyboard t) = generalSubscribe t partUnSubscribe (Keyboard t) uuid = liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid))