30 actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc)) |
30 actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc)) |
31 forM_ actions processAction |
31 forM_ actions processAction |
32 |
32 |
33 mainLoop :: StateT ServerState IO () |
33 mainLoop :: StateT ServerState IO () |
34 mainLoop = forever $ do |
34 mainLoop = forever $ do |
|
35 get >>= \s -> put $! s |
|
36 |
35 si <- gets serverInfo |
37 si <- gets serverInfo |
36 r <- liftIO $ readChan $ coreChan si |
38 r <- liftIO $ readChan $ coreChan si |
37 |
39 |
38 liftIO $ putStrLn $ "Core msg: " ++ show r |
|
39 case r of |
40 case r of |
40 Accept ci -> processAction (AddClient ci) |
41 Accept ci -> processAction (AddClient ci) |
41 |
42 |
42 ClientMessage (ci, cmd) -> do |
43 ClientMessage (ci, cmd) -> do |
43 liftIO $ debugM "Clients" $ (show ci) ++ ": " ++ (show cmd) |
44 liftIO $ debugM "Clients" $ (show ci) ++ ": " ++ (show cmd) |
44 |
45 |
45 removed <- gets removedClients |
46 removed <- gets removedClients |
46 when (not $ ci `Set.member` removed) $ do |
47 when (not $ ci `Set.member` removed) $ do |
47 modify (\as -> as{clientIndex = Just ci}) |
48 as <- get |
|
49 put $! as{clientIndex = Just ci} |
48 reactCmd cmd |
50 reactCmd cmd |
49 |
51 |
50 Remove ci -> do |
52 Remove ci -> do |
51 liftIO $ debugM "Clients" $ "DeleteClient: " ++ show ci |
53 liftIO $ debugM "Clients" $ "DeleteClient: " ++ show ci |
52 processAction (DeleteClient ci) |
54 processAction (DeleteClient ci) |
58 |
60 |
59 ClientAccountInfo (ci, info) -> do |
61 ClientAccountInfo (ci, info) -> do |
60 rnc <- gets roomsClients |
62 rnc <- gets roomsClients |
61 exists <- liftIO $ clientExists rnc ci |
63 exists <- liftIO $ clientExists rnc ci |
62 when (exists) $ do |
64 when (exists) $ do |
63 modify (\as -> as{clientIndex = Just ci}) |
65 as <- get |
|
66 put $! as{clientIndex = Just ci} |
64 processAction (ProcessAccountInfo info) |
67 processAction (ProcessAccountInfo info) |
65 return () |
68 return () |
66 |
69 |
67 TimerAction tick -> |
70 TimerAction tick -> |
68 mapM_ processAction $ |
71 mapM_ processAction $ |