summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--examples/dhtd.hs13
1 files changed, 9 insertions, 4 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index d42ffa1a..d4216dae 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -455,15 +455,20 @@ clientSession s@Session{..} sock cnum h = do
455 unlines . map (either show show . either4or6) <$> externalAddresses 455 unlines . map (either show show . either4or6) <$> externalAddresses
456 >>= hPutClient h 456 >>= hPutClient h
457#ifdef THREAD_DEBUG 457#ifdef THREAD_DEBUG
458 ("threads", _) -> cmd0 $ do 458 ("threads", s) -> cmd0 $ do
459 ts <- threadsInformation 459 threads <- threadsInformation
460 tm <- getCurrentTime 460 tm <- getCurrentTime
461 r <- forM ts $ \(tid,PerThread{..}) -> do 461 let (ss,ts) = partition (("search" `isPrefixOf`) . lbl . snd)
462 threads
463 want_ss = ["-v"] `isInfixOf` words s
464 r <- forM (if want_ss then threads else ts) $ \(tid,PerThread{..}) -> do
462 stat <- threadStatus tid 465 stat <- threadStatus tid
463 let showStat (ThreadBlocked reason) = show reason 466 let showStat (ThreadBlocked reason) = show reason
464 showStat stat = show stat 467 showStat stat = show stat
465 return [show lbl,show (diffUTCTime tm startTime),showStat stat] 468 return [show lbl,show (diffUTCTime tm startTime),showStat stat]
466 hPutClient h $ showColumns r 469 hPutClient h $ unlines [ showColumns r
470 , (if want_ss then " There are " else " and ")
471 ++ show (length ss) ++ " search threads." ]
467#endif 472#endif
468 ("mem", s) -> cmd0 $ do 473 ("mem", s) -> cmd0 $ do
469 case s of 474 case s of