Some refactoring.
This commit is contained in:
parent
bb806a52c9
commit
e8065147df
@ -1,7 +1,7 @@
|
|||||||
module Link.Client where
|
module Link.Client where
|
||||||
|
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
import Control.Concurrent hiding (forkFinally)
|
import Control.Concurrent
|
||||||
import Control.Exception hiding (handle)
|
import Control.Exception hiding (handle)
|
||||||
import Control.Monad (void, forever, when, unless, forM_)
|
import Control.Monad (void, forever, when, unless, forM_)
|
||||||
import Data.Time (getCurrentTime, diffUTCTime)
|
import Data.Time (getCurrentTime, diffUTCTime)
|
||||||
@ -15,11 +15,6 @@ import qualified Data.Set as Set
|
|||||||
import Link.Protocol
|
import Link.Protocol
|
||||||
import Link.Types
|
import Link.Types
|
||||||
|
|
||||||
forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
|
|
||||||
forkFinally action fun =
|
|
||||||
mask $ \restore ->
|
|
||||||
forkIO (do r <- try (restore action); fun r)
|
|
||||||
|
|
||||||
sendMessage :: Client -> Message -> STM ()
|
sendMessage :: Client -> Message -> STM ()
|
||||||
sendMessage Client {..} = writeTChan clientChan
|
sendMessage Client {..} = writeTChan clientChan
|
||||||
|
|
||||||
|
@ -40,10 +40,10 @@ connectClient server handle = do
|
|||||||
ok <- checkAddClient server user handle
|
ok <- checkAddClient server user handle
|
||||||
case ok of
|
case ok of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
printToHandle handle $ formatMessage (NameInUse name)
|
printToHandle handle . formatMessage $ NameInUse name
|
||||||
readName
|
readName
|
||||||
Just client -> do
|
Just client -> do
|
||||||
sendResponse client $ Connected name
|
printToHandle handle . formatMessage $ Connected name
|
||||||
runClient server client `finally` removeClient server user
|
runClient server client `finally` removeClient server user
|
||||||
|
|
||||||
checkAddClient :: Server -> User -> Handle -> IO (Maybe Client)
|
checkAddClient :: Server -> User -> Handle -> IO (Maybe Client)
|
||||||
|
Loading…
Reference in New Issue
Block a user