port module Types.UserData

src/Types/UserData.hs

@@ -34,10 +34,10 @@ data UserData = UserData
   , translation     :: Translation
   , nano            :: Context
   , uuid            :: [UUID]
-  , worldState      :: SystemState Entity (AffectionState (AffectionData UserData) IO)
+  , worldState      :: SystemState Entity (AffectionState AffectionData IO)
   , stateData       :: StateData
   , stateMVar       :: MVar
-    ( SystemState Entity (AffectionState (AffectionData UserData) IO)
+    ( SystemState Entity (AffectionState AffectionData IO)
     , StateData
     )
   , stateProgress   :: MVar (Float, T.Text)
@@ -133,14 +133,14 @@ data ActionMessage = ActionMessage
 instance Message ActionMessage where
   msgTime (ActionMessage _ t) = t
 
-newtype SubWindow     = SubWindow (TVar [(UUID, WindowMessage -> Affection UserData())])
+newtype SubWindow     = SubWindow (TVar [(UUID, WindowMessage -> Affection())])
-newtype SubMouse      = SubMouse (TVar [(UUID, MouseMessage -> Affection UserData ())])
+newtype SubMouse      = SubMouse (TVar [(UUID, MouseMessage -> Affection ())])
-newtype SubKeyboard   = SubKeyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())])
+newtype SubKeyboard   = SubKeyboard (TVar [(UUID, KeyboardMessage -> Affection ())])
-newtype SubJoypad     = SubJoypad (TVar [(UUID, JoystickMessage -> Affection UserData ())])
+newtype SubJoypad     = SubJoypad (TVar [(UUID, JoystickMessage -> Affection ())])
-newtype SubTranslator = SubTranslator (TVar [(UUID, ActionMessage -> Affection UserData ())])
+newtype SubTranslator = SubTranslator (TVar [(UUID, ActionMessage -> Affection ())])
 
-instance Participant SubWindow UserData where
+instance Participant SubWindow where
-  type Mesg SubWindow UserData = WindowMessage
+  type Mesg SubWindow = WindowMessage
 
   partSubscribers (SubWindow t) = generalSubscribers t
 
@@ -148,11 +148,11 @@ instance Participant SubWindow UserData where
 
   partUnSubscribe (SubWindow t) = generalUnSubscribe t
 
-instance SDLSubsystem SubWindow UserData where
+instance SDLSubsystem SubWindow where
   consumeSDLEvents = consumeSDLWindowEvents
 
-instance Participant SubMouse UserData where
+instance Participant SubMouse where
-  type Mesg SubMouse UserData = MouseMessage
+  type Mesg SubMouse = MouseMessage
 
   partSubscribers (SubMouse t) = generalSubscribers t
 
@@ -160,11 +160,11 @@ instance Participant SubMouse UserData where
 
   partUnSubscribe (SubMouse t) = generalUnSubscribe t
 
-instance SDLSubsystem SubMouse UserData where
+instance SDLSubsystem SubMouse where
   consumeSDLEvents = consumeSDLMouseEvents
 
-instance Participant SubKeyboard UserData where
+instance Participant SubKeyboard where
-  type Mesg SubKeyboard UserData = KeyboardMessage
+  type Mesg SubKeyboard = KeyboardMessage
 
   partSubscribers (SubKeyboard t) = generalSubscribers t
 
@@ -172,11 +172,11 @@ instance Participant SubKeyboard UserData where
 
   partUnSubscribe (SubKeyboard t) = generalUnSubscribe t
 
-instance SDLSubsystem SubKeyboard UserData where
+instance SDLSubsystem SubKeyboard where
   consumeSDLEvents = consumeSDLKeyboardEvents
 
-instance Participant SubJoypad UserData where
+instance Participant SubJoypad where
-  type Mesg SubJoypad UserData = JoystickMessage
+  type Mesg SubJoypad = JoystickMessage
 
   partSubscribers (SubJoypad t) = generalSubscribers t
 
@@ -184,11 +184,11 @@ instance Participant SubJoypad UserData where
 
   partUnSubscribe (SubJoypad t) = generalUnSubscribe t
 
-instance SDLSubsystem SubJoypad UserData where
+instance SDLSubsystem SubJoypad where
   consumeSDLEvents = consumeSDLJoystickEvents
 
-instance Participant SubTranslator UserData where
+instance Participant SubTranslator where
-  type Mesg SubTranslator UserData = ActionMessage
+  type Mesg SubTranslator = ActionMessage
 
   partSubscribers (SubTranslator t) = generalSubscribers t
 
@@ -197,25 +197,25 @@ instance Participant SubTranslator UserData where
   partUnSubscribe (SubTranslator t) = generalUnSubscribe t
 
 generalSubscribers
-  :: TVar [(UUID, msg -> Affection UserData ())]
+  :: TVar [(UUID, msg -> Affection ())]
-  -> Affection UserData [(msg -> Affection UserData ())]
+  -> Affection [(msg -> Affection ())]
 generalSubscribers t = do
   subTups <- liftIO $ readTVarIO t
   return $ map snd subTups
 
 generalSubscribe
-  :: TVar [(UUID, msg -> Affection UserData ())]
+  :: TVar [(UUID, msg -> Affection ())]
-  -> (msg -> Affection UserData ())
+  -> (msg -> Affection ())
-  -> Affection UserData UUID
+  -> Affection UUID
 generalSubscribe t funct = do
   uu <- genUUID
   liftIO $ atomically $ modifyTVar' t ((uu, funct) :)
   return uu
 
 generalUnSubscribe
-  :: TVar [(UUID, msg -> Affection UserData ())]
+  :: TVar [(UUID, msg -> Affection ())]
   -> UUID
-  -> Affection UserData ()
+  -> Affection ()
 generalUnSubscribe t uu =
   liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uu))
   where