summaryrefslogtreecommitdiff
path: root/dht/src/DebugUtil.hs
diff options
context:
space:
mode:
Diffstat (limited to 'dht/src/DebugUtil.hs')
-rw-r--r--dht/src/DebugUtil.hs42
1 files changed, 0 insertions, 42 deletions
diff --git a/dht/src/DebugUtil.hs b/dht/src/DebugUtil.hs
deleted file mode 100644
index 96ab8cc5..00000000
--- a/dht/src/DebugUtil.hs
+++ /dev/null
@@ -1,42 +0,0 @@
1{-# LANGUAGE CPP #-}
2module DebugUtil where
3
4import Control.Monad
5import Data.Time.Clock
6import Data.List
7import Text.Printf
8import GHC.Conc (threadStatus,ThreadStatus(..))
9#ifdef THREAD_DEBUG
10import Control.Concurrent.Lifted.Instrument
11#else
12import Control.Concurrent.Lifted
13import GHC.Conc (labelThread)
14#endif
15
16showReport :: [(String,String)] -> String
17showReport kvs = showColumns $ map (\(x,y)->[x,y]) kvs
18
19showColumns :: [[String]] -> String
20showColumns rows = do
21 let cols = transpose rows
22 ws = map (maximum . map (succ . length)) cols
23 fs <- rows
24 _ <- take 1 fs -- Guard against empty rows so that 'last' is safe.
25 " " ++ concat (zipWith (printf "%-*s") (init ws) (init fs)) ++ last fs ++ "\n"
26
27
28threadReport :: Bool -- ^ False to summarize search threads.
29 -> IO String
30threadReport want_ss = do
31 threads <- threadsInformation
32 tm <- getCurrentTime
33 let (ss,ts) = partition (("search" `isPrefixOf`) . lbl . snd)
34 threads
35 r <- forM (if want_ss then threads else ts) $ \(tid,PerThread{..}) -> do
36 stat <- threadStatus tid
37 let showStat (ThreadBlocked reason) = show reason
38 showStat stat = show stat
39 return [show lbl,show (diffUTCTime tm startTime),showStat stat]
40 return $ unlines [ showColumns r
41 , (if want_ss then " There are " else " and ")
42 ++ show (length ss) ++ " search threads." ]