diff --git a/src/Semantic/Stat.hs b/src/Semantic/Stat.hs index 9bb500906..c1a8e5c49 100644 --- a/src/Semantic/Stat.hs +++ b/src/Semantic/Stat.hs @@ -14,6 +14,7 @@ module Semantic.Stat -- Client , defaultStatsClient , StatsClient(..) +, closeStatClient -- Internal, exposed for testing , renderDatagram @@ -26,7 +27,7 @@ import Data.List (intercalate) import Data.List.Split (splitOneOf) import Data.Maybe import Data.Monoid -import Network.Socket (Socket(..), SocketType(..), socket, connect, getAddrInfo, addrFamily, addrAddress, defaultProtocol) +import Network.Socket (Socket(..), SocketType(..), socket, connect, close, getAddrInfo, addrFamily, addrAddress, defaultProtocol) import Network.Socket.ByteString import Network.URI import Numeric @@ -138,6 +139,10 @@ statsClient host port statsClientNamespace = do connect sock (addrAddress addr) pure (StatsClient sock statsClientNamespace host port) +-- | Close the client's underlying socket. +closeStatClient :: StatsClient -> IO () +closeStatClient StatsClient{..} = close statsClientUDPSocket + -- | Send a stat over the StatsClient's socket. sendStat :: StatsClient -> Stat -> IO () sendStat StatsClient{..} = void . tryIOError . sendAll statsClientUDPSocket . B.pack . renderDatagram statsClientNamespace diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 5100b56d7..785ed8e0d 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -162,6 +162,7 @@ runTaskWithOptions options task = do run options logger statter task closeQueue statter + closeStatClient (asyncQueueExtra statter) closeQueue logger either (die . displayException) pure result where