File: HECs.hs

package info (click to toggle)
threadscope 0.2.1-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 460 kB
  • sloc: haskell: 4,579; makefile: 7
file content (88 lines) | stat: -rw-r--r-- 2,547 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
{-# LANGUAGE CPP #-}
module Events.HECs (
    HECs(..),
    Event,
    CapEvent,
    Timestamp,

    eventIndexToTimestamp,
    timestampToEventIndex,
    extractUserMessages,
    histogram,
    histogramCounts,
  ) where

import Events.EventTree
import Events.SparkTree
import GHC.RTS.Events

import Data.Array
import qualified Data.IntMap as IM
import qualified Data.List as L

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

-- all the data from a .eventlog file
data HECs = HECs {
       hecCount         :: Int,
       hecTrees         :: [(DurationTree, EventTree, SparkTree)],
       hecEventArray    :: Array Int CapEvent,
       hecLastEventTime :: Timestamp,
       maxSparkPool     :: Double,
       minXHistogram    :: Int,
       maxXHistogram    :: Int,
       maxYHistogram    :: Timestamp,
       durHistogram     :: [(Timestamp, Int, Timestamp)]
     }

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

eventIndexToTimestamp :: HECs -> Int -> Timestamp
eventIndexToTimestamp HECs{hecEventArray=arr} n =
  time (ce_event (arr ! n))

timestampToEventIndex :: HECs -> Timestamp -> Int
timestampToEventIndex HECs{hecEventArray=arr} ts =
    search l (r+1)
  where
    (l,r) = bounds arr

    search !l !r
      | (r - l) <= 1 = if ts > time (ce_event (arr!l)) then r else l
      | ts < tmid    = search l mid
      | otherwise    = search mid r
      where
        mid  = l + (r - l) `quot` 2
        tmid = time (ce_event (arr!mid))

extractUserMessages :: HECs -> [(Timestamp, String)]
extractUserMessages hecs =
  [ (ts, msg)
  | CapEvent _ (Event ts (UserMessage msg)) <- elems (hecEventArray hecs) ]

-- | Sum durations in the same buckets to form a histogram.
histogram :: [(Int, Timestamp)] -> [(Int, Timestamp)]
histogram durs = IM.toList $ fromListWith' (+) durs

-- | Sum durations and spark counts in the same buckets to form a histogram.
histogramCounts :: [(Int, (Timestamp, Int))] -> [(Int, (Timestamp, Int))]
histogramCounts durs =
  let agg (dur1, count1) (dur2, count2) =
        -- bangs needed to avoid stack overflow
        let !dur = dur1 + dur2
            !count = count1 + count2
        in (dur, count)
  in IM.toList $ fromListWith' agg durs

fromListWith' :: (a -> a -> a) -> [(Int, a)] -> IM.IntMap a
fromListWith' f xs =
    L.foldl' ins IM.empty xs
  where
#if MIN_VERSION_containers(0,4,1)
    ins t (k,x) = IM.insertWith' f k x t
#else
    ins t (k,x) =
      let r = IM.insertWith f k x t
          v = r IM.! k
      in v `seq` r
#endif