Skip to content

Commit

Permalink
Fourmolu
Browse files Browse the repository at this point in the history
  • Loading branch information
edsko committed Jul 24, 2024
1 parent 3a0c72d commit e753c9f
Show file tree
Hide file tree
Showing 2 changed files with 19 additions and 18 deletions.
1 change: 0 additions & 1 deletion Network/HTTP2/Client.hs
Original file line number Diff line number Diff line change
Expand Up @@ -71,7 +71,6 @@ module Network.HTTP2.Client (
emptyFrameRateLimit,
rstRateLimit,


-- * Common configuration
Config (..),
allocSimpleConfig,
Expand Down
36 changes: 19 additions & 17 deletions Network/HTTP2/H2/Manager.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,22 +28,22 @@ import Imports

----------------------------------------------------------------

data Command =
Stop (MVar ()) (Maybe SomeException)
| Add ThreadId
| RegisterTimeout ThreadId T.Handle
| Delete ThreadId
data Command
= Stop (MVar ()) (Maybe SomeException)
| Add ThreadId
| RegisterTimeout ThreadId T.Handle
| Delete ThreadId

-- | Manager to manage the thread and the timer.
data Manager = Manager (TQueue Command) (TVar Int) T.Manager

data TimeoutHandle =
ThreadWithTimeout T.Handle
| ThreadWithoutTimeout
data TimeoutHandle
= ThreadWithTimeout T.Handle
| ThreadWithoutTimeout

cancelTimeout :: TimeoutHandle -> IO ()
cancelTimeout (ThreadWithTimeout h) = T.cancel h
cancelTimeout ThreadWithoutTimeout = return ()
cancelTimeout ThreadWithoutTimeout = return ()

type ManagedThreads = Map ThreadId TimeoutHandle

Expand Down Expand Up @@ -89,13 +89,15 @@ stopAfter (Manager q _ _) action cleanup = do
mask $ \unmask -> do
ma <- trySyncOrAsync $ unmask action
signalTimeoutsDisabled <- newEmptyMVar
atomically $ writeTQueue q $ Stop signalTimeoutsDisabled (either Just (const Nothing) ma)
atomically $
writeTQueue q $
Stop signalTimeoutsDisabled (either Just (const Nothing) ma)
-- This call to takeMVar /will/ eventually succeed, because the Manager
-- thread cannot be killed (see comment on 'go' in 'start').
takeMVar signalTimeoutsDisabled
case ma of
Left err -> cleanup (Just err) >> throwIO err
Right a -> cleanup Nothing >> return a
Left err -> cleanup (Just err) >> throwIO err
Right a -> cleanup Nothing >> return a

----------------------------------------------------------------

Expand Down Expand Up @@ -166,17 +168,17 @@ kill signalTimeoutsDisabled threadMap err = do
forM_ (Map.elems threadMap) cancelTimeout
putMVar signalTimeoutsDisabled ()
forM_ (Map.keys threadMap) $ \tid ->
E.throwTo tid $ KilledByHttp2ThreadManager err
E.throwTo tid $ KilledByHttp2ThreadManager err

-- | Killing the IO action of the second argument on timeout.
timeoutKillThread :: Manager -> (T.Handle -> IO a) -> IO a
timeoutKillThread (Manager q _ tmgr) action = E.bracket register T.cancel action
where
register = do
h <- T.registerKillThread tmgr (return ())
tid <- myThreadId
atomically $ writeTQueue q (RegisterTimeout tid h)
return h
h <- T.registerKillThread tmgr (return ())
tid <- myThreadId
atomically $ writeTQueue q (RegisterTimeout tid h)
return h

-- | Registering closer for a resource and
-- returning a timer refresher.
Expand Down

0 comments on commit e753c9f

Please sign in to comment.