drop repetitive code

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
+  partSubscribe (Window t) = generalSubscribe t
-    uuid <- genUUID
-    liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
-    return uuid
 
   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
+  partSubscribe (Mouse t) = generalSubscribe t
-    uuid <- genUUID
-    liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
-    return uuid
 
   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
+  partSubscribe (Keyboard t) = generalSubscribe t
-    uuid <- genUUID
-    liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
-    return uuid
 
   partUnSubscribe (Keyboard t) uuid =
     liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid))