From ca817955853e15558b4a8af931b75d7baf0a4bea Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 15 Dec 2017 18:12:16 +0100 Subject: [PATCH] linted --- examples/example00.hs | 34 ++++++++++++++----------------- src/Affection.hs | 4 ++-- src/Affection/MessageBus/Class.hs | 4 ++-- 3 files changed, 19 insertions(+), 23 deletions(-) diff --git a/examples/example00.hs b/examples/example00.hs index a53b441..d49eb94 100644 --- a/examples/example00.hs +++ b/examples/example00.hs @@ -6,7 +6,7 @@ import qualified SDL import Control.Concurrent.STM import Control.Monad.IO.Class (liftIO) -data StateData = StateData +newtype StateData = StateData { sdSubs :: Subsystems } @@ -16,19 +16,16 @@ data Subsystems = Subsystems , subKeyboard :: Keyboard } -data Window = Window (TVar [(UUID, WindowMessage -> Affection StateData ())]) -data Mouse = Mouse (TVar [(UUID, MouseMessage -> Affection StateData ())]) -data Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection StateData ())]) +newtype Window = Window (TVar [(UUID, WindowMessage -> Affection StateData ())]) +newtype Mouse = Mouse (TVar [(UUID, MouseMessage -> Affection StateData ())]) +newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection StateData ())]) instance Participant Window WindowMessage StateData where partSubscribers (Window t) = do - subTups <- liftIO $ readTVarIO $ t + 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)) @@ -38,13 +35,10 @@ instance SDLSubsystem Window StateData where instance Participant Mouse MouseMessage StateData where partSubscribers (Mouse t) = do - subTups <- liftIO $ readTVarIO $ t + 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)) @@ -54,13 +48,10 @@ instance SDLSubsystem Mouse StateData where instance Participant Keyboard KeyboardMessage StateData where partSubscribers (Keyboard t) = do - subTups <- liftIO $ readTVarIO $ t + 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)) @@ -68,6 +59,11 @@ instance Participant Keyboard KeyboardMessage StateData where instance SDLSubsystem Keyboard StateData where consumeSDLEvents = consumeSDLKeyboardEvents +generalSubscribe t funct = do + uuid <- genUUID + liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) + return uuid + main :: IO () main = do logIO Debug "Starting" diff --git a/src/Affection.hs b/src/Affection.hs index 6852a4d..4988362 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -52,7 +52,7 @@ withAffection AffectionConfig{..} = do -- construct window window <- SDL.createWindow windowTitle windowConfig SDL.showWindow window - context <- SDL.glCreateContext windw + context <- SDL.glCreateContext window let SDL.V2 (CInt rw) (CInt rh) = SDL.windowInitialSize windowConfig (w, h) = case canvasSize of Just (cw, ch) -> (cw, ch) @@ -104,7 +104,7 @@ withAffection AffectionConfig{..} = do -- execute user defined draw loop liftIO $ GL.clear [ColorBuffer, DepthBuffer] drawLoop - liftIO $ flush + liftIO flush -- handle all new draw requests ad2 <- get -- actual drawing diff --git a/src/Affection/MessageBus/Class.hs b/src/Affection/MessageBus/Class.hs index 4530278..a715970 100644 --- a/src/Affection/MessageBus/Class.hs +++ b/src/Affection/MessageBus/Class.hs @@ -23,7 +23,7 @@ class (Show m, Message m) => Participant prt m us where partSubscribers :: prt -- ^ the 'Participant''s subscriber storage - -> Affection us [(m -> Affection us ())] + -> Affection us [m -> Affection us ()] -- ^ List of Subscriber functions -- | Subscribe to the 'Participant''s events @@ -58,4 +58,4 @@ class (Show m, Message m) => Participant prt m us where -- | Helper function to generate new 'UUID's genUUID :: Affection us UUID -genUUID = liftIO $ nextRandom +genUUID = liftIO nextRandom