nek0/affection
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

drop repetitive code

Browse source
This commit is contained in:
nek0 2017-12-27 20:27:38 +01:00
parent a1ab48009f
commit 11bb7b69e5
1 changed files with 12 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
examples/example00.hs
View file

@ -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))