From ab6b274b06536f9c681e3d79950f9915ec49f77f Mon Sep 17 00:00:00 2001
From: nek0 <nek0@chelnok.de>
Date: Wed, 27 Dec 2017 18:44:22 +0100
Subject: [PATCH] adjust to new affection

---
 haskelloids.cabal |  2 +-
 src/InGame.hs     | 16 ++++++++--------
 src/Types.hs      | 21 +++++++++++++--------
 3 files changed, 22 insertions(+), 17 deletions(-)

diff --git a/haskelloids.cabal b/haskelloids.cabal
index 9792085..db074a7 100644
--- a/haskelloids.cabal
+++ b/haskelloids.cabal
@@ -67,7 +67,7 @@ executable haskelloids
   
   -- Other library packages from which modules are imported.
   build-depends:       base >=4.9 && <4.11
-                     , affection <= 0.0.0.7
+                     , affection <= 0.0.0.8
                      , sdl2 >= 2.1.3.1
                      , OpenGL
 
diff --git a/src/InGame.hs b/src/InGame.hs
index d51d961..ac9dacd 100644
--- a/src/InGame.hs
+++ b/src/InGame.hs
@@ -129,16 +129,16 @@ updateGame sec = do
        || any (checkFriendlyFire (ship ud2)) (shots ud2)
        )
     && isNothing (wonlost ud2)
-    )
-    (putAffection ud2
-      { wonlost = Just Lost
-      }
-    )
-  when (isNothing (wonlost ud2) && null (haskelloids ud2))
-    (putAffection ud2
+    ) $ do
+      liftIO $ logIO A.Debug "You Lost!"
+      putAffection ud2
+        { wonlost = Just Lost
+        }
+  when (isNothing (wonlost ud2) && null (haskelloids ud2)) $ do
+    liftIO $ logIO A.Debug "You Won!"
+    putAffection ud2
       { wonlost = Just Won
       }
-    )
 
 checkShotDown :: Affection UserData ()
 checkShotDown =
diff --git a/src/Types.hs b/src/Types.hs
index 89aa877..16fab54 100644
--- a/src/Types.hs
+++ b/src/Types.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Types where
 
@@ -66,13 +67,15 @@ data Subsystems = Subsystems
   }
 
 data UUIDClean = UUIDClean
-  { uuWindow   :: [MsgId WindowMessage]
-  , uuKeyboard :: [MsgId KeyboardMessage]
+  { uuWindow   :: [UUID]
+  , uuKeyboard :: [UUID]
   }
 
 newtype Window = Window (TVar [(UUID, WindowMessage -> Affection UserData ())])
 
-instance Participant Window WindowMessage UserData where
+instance Participant Window UserData where
+  type Mesg Window UserData = WindowMessage
+
   partSubscribers (Window t) = do
     subTups <- liftIO $ readTVarIO t
     return $ map snd subTups
@@ -80,9 +83,9 @@ instance Participant Window WindowMessage UserData where
   partSubscribe (Window t) funct = do
     uuid <- genUUID
     liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
-    return $ MsgId uuid MsgWindowEmptyEvent
+    return uuid
 
-  partUnSubscribe (Window t) (MsgId uuid _) =
+  partUnSubscribe (Window t) uuid =
     liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uuid))
     where
       filterMsg :: (UUID, WindowMessage -> Affection UserData ()) -> UUID -> Bool
@@ -93,7 +96,9 @@ instance SDLSubsystem Window UserData where
 
 newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())])
 
-instance Participant Keyboard KeyboardMessage UserData where
+instance Participant Keyboard UserData where
+  type Mesg Keyboard UserData = KeyboardMessage
+
   partSubscribers (Keyboard t) = do
     subTups <- liftIO $ readTVarIO t
     return $ map snd subTups
@@ -101,9 +106,9 @@ instance Participant Keyboard KeyboardMessage UserData where
   partSubscribe (Keyboard t) funct = do
     uuid <- genUUID
     liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
-    return $ MsgId uuid MsgKeyboardEmptyEvent
+    return uuid
 
-  partUnSubscribe (Keyboard t) (MsgId uuid _) =
+  partUnSubscribe (Keyboard t) uuid =
     liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uuid))
     where
       filterMsg :: (UUID, KeyboardMessage -> Affection UserData ()) -> UUID -> Bool