content: module GUI.SummaryView (
      SummaryView,
      summaryViewNew,
      summaryViewSetEvents,
      summaryViewSetInterval,
    ) where
  
  import GHC.RTS.Events
  
  import GUI.Types
  
  import Graphics.UI.Gtk
  
  import Control.Exception (assert)
  import Control.Monad
  import Data.Array
  import qualified Data.IntMap as IM
  import Data.IORef
  import Data.List as L
  import Data.Maybe
  import Data.Word (Word64)
  import Numeric (showFFloat)
  import Text.Printf
  
  ------------------------------------------------------------------------------
  
  type Events = Array Int CapEvent
  
  data SummaryView = SummaryView {
  
      -- we cache the stats for the whole interval
      cacheEventsStats      :: !(IORef (Maybe (Events, SummaryStats, Bool)))
  
      -- widgets for time stuff
    , labelTimeTotal        :: Label
    , labelTimeMutator      :: Label
    , labelTimeGC           :: Label
    , labelTimeProductivity :: Label
  
      -- widgets for heap stuff
    , labelHeapMaxSize
    , labelHeapMaxResidency
    , labelHeapAllocTotal
    , labelHeapAllocRate
    , labelHeapMaxSlop      :: (Label, Label, Label, Label)
    , tableHeap             :: Widget
  
      -- widgets for GC stuff
    , labelGcCopied         :: (Label, Label, Label, Label)
    , labelGcParWorkBalance :: Label
    , storeGcStats          :: ListStore GcStatsEntry
    , tableGc               :: Widget
  
      -- widgets for sparks stuff
    , storeSparkStats       :: ListStore (Cap, SparkCounts)
    }
  
  ------------------------------------------------------------------------------
  
  summaryViewNew :: Builder -> IO SummaryView
  summaryViewNew builder = do
      cacheEventsStats <- newIORef Nothing
  
      let getWidget cast = builderGetObject builder cast
          getLabel       = getWidget castToLabel
          getHeapLabels w1 w2 w3 w4 = liftM4 (,,,) (getLabel w1) (getLabel w2)
                                                   (getLabel w3) (getLabel w4)
  
      labelTimeTotal        <- getWidget castToLabel "labelTimeTotal"
      labelTimeMutator      <- getWidget castToLabel "labelTimeMutator"
      labelTimeGC           <- getWidget castToLabel "labelTimeGC"
      labelTimeProductivity <- getWidget castToLabel "labelTimeProductivity"
  
  
      labelHeapMaxSize      <- getHeapLabels "labelHeapMaxSize"           "labelHeapMaxSizeUnit"
                                             "labelHeapMaxSizeBytes"      "labelHeapMaxSizeUnit1"
      labelHeapMaxResidency <- getHeapLabels "labelHeapMaxResidency"      "labelHeapMaxResidencyUnit"
                                             "labelHeapMaxResidencyBytes" "labelHeapMaxResidencyUnit1"
      labelHeapAllocTotal   <- getHeapLabels "labelHeapAllocTotal"        "labelHeapAllocTotalUnit"
                                             "labelHeapAllocTotalBytes"   "labelHeapAllocTotalUnit1"
      labelHeapAllocRate    <- getHeapLabels "labelHeapAllocRate"         "labelHeapAllocRateUnit"
                                             "labelHeapAllocRateBytes"    "labelHeapAllocRateUnit1"
      labelHeapMaxSlop      <- getHeapLabels "labelHeapMaxSlop"           "labelHeapMaxSlopUnit"
                                             "labelHeapMaxSlopBytes"      "labelHeapMaxSlopUnit1"
      tableHeap             <- getWidget castToWidget "tableHeap"
  
      labelGcCopied         <- getHeapLabels "labelGcCopied"      "labelGcCopiedUnit"
                                             "labelGcCopiedBytes" "labelGcCopiedUnit1"
      labelGcParWorkBalance <- getWidget castToLabel "labelGcParWorkBalance"
      storeGcStats          <- listStoreNew []
      tableGc               <- getWidget castToWidget "tableGC"
  
      storeSparkStats       <- listStoreNew []
  
      let summaryView = SummaryView{..}
  
      treeviewGcStats <- getWidget castToTreeView "treeviewGcStats"
      treeViewSetModel treeviewGcStats storeGcStats
      let addGcColumn = addColumn treeviewGcStats storeGcStats
      addGcColumn "Generation" $ \(GcStatsEntry gen _ _ _ _ _) ->
        [ cellText := if gen == -1 then "GC Total" else "Gen " ++ show gen ]
      addGcColumn "Collections"     $ \(GcStatsEntry _ colls _ _ _ _) ->
        [ cellText := show colls ]
      addGcColumn "Par collections" $ \(GcStatsEntry _ _ pcolls _ _ _) ->
        [ cellText := show pcolls ]
      addGcColumn "Elapsed time"    $ \(GcStatsEntry _ _ _ time _ _) ->
        [ cellText := (printf "%5.2fs" (timeToSecondsDbl time) :: String) ]
      addGcColumn "Avg pause"       $ \(GcStatsEntry _ _ _ _ avgpause _) ->
        [ cellText := (printf "%3.4fs" avgpause :: String) ]
      addGcColumn "Max pause"       $ \(GcStatsEntry _ _ _ _ _ maxpause) ->
        [ cellText := (printf "%3.4fs" maxpause :: String) ]
  
      treeviewSparkStats <- getWidget castToTreeView "treeviewSparkStats"
      treeViewSetModel treeviewSparkStats storeSparkStats
      let addSparksColumn = addColumn treeviewSparkStats storeSparkStats
      addSparksColumn "HEC" $ \(hec, _) ->
        [ cellText := if hec == -1 then "Total" else "HEC " ++ show hec ]
      addSparksColumn "Total" $ \(_, SparkCounts total _ _ _ _ _) ->
        [ cellText := show total ]
      addSparksColumn "Converted" $ \(_, SparkCounts _ conv _ _ _ _) ->
        [ cellText := show conv ]
      addSparksColumn "Overflowed" $ \(_, SparkCounts _ _ ovf _ _ _) ->
        [ cellText := show ovf ]
      addSparksColumn "Dud" $ \(_, SparkCounts _ _ _ dud _ _) ->
        [ cellText := show dud ]
      addSparksColumn "GC'd" $ \(_, SparkCounts _ _ _ _ gc _) ->
        [ cellText := show gc ]
      addSparksColumn "Fizzled" $ \(_, SparkCounts _ _ _ _ _ fiz) ->
        [ cellText := show fiz ]
  
      return summaryView
  
    where
      addColumn view store title mkAttrs = do
        col  <- treeViewColumnNew
        cell <- cellRendererTextNew
        treeViewColumnSetTitle col title
        treeViewColumnPackStart col cell False
        treeViewAppendColumn view col
        cellLayoutSetAttributes col cell store mkAttrs
  
  
  ------------------------------------------------------------------------------
  
  summaryViewSetEvents :: SummaryView -> Maybe (Array Int CapEvent) -> IO ()
  summaryViewSetEvents view@SummaryView{cacheEventsStats} Nothing = do
      writeIORef cacheEventsStats Nothing
      setSummaryStatsEmpty view
  
  summaryViewSetEvents view@SummaryView{cacheEventsStats} (Just events) = do
      let stats = summaryStats events Nothing
        -- this is an almost certain indicator that there
        -- are no heap events in the eventlog:
          hasHeapEvents = heapMaxSize (summHeapStats stats) /= Just 0
      writeIORef cacheEventsStats (Just (events, stats, hasHeapEvents))
      setSummaryStats view stats hasHeapEvents
  
  
  summaryViewSetInterval :: SummaryView -> Maybe Interval -> IO ()
  summaryViewSetInterval view@SummaryView{cacheEventsStats} Nothing = do
      cache <- readIORef cacheEventsStats
      case cache of
        Nothing                  -> return ()
        Just (_, stats, hasHeap) -> setSummaryStats view stats hasHeap
  
  summaryViewSetInterval view@SummaryView{cacheEventsStats} (Just interval) = do
      cache <- readIORef cacheEventsStats
      case cache of
        Nothing                   -> return ()
        Just (events, _, hasHeap) -> setSummaryStats view stats hasHeap
          where stats = summaryStats events (Just interval)
  
  ------------------------------------------------------------------------------
  
  setSummaryStats :: SummaryView -> SummaryStats -> Bool -> IO ()
  setSummaryStats view SummaryStats{..} hasHeapEvents = do
      setTimeStats  view summTimeStats
      if hasHeapEvents
        then do setHeapStatsAvailable view True
                setHeapStats  view summHeapStats
                setGcStats    view summGcStats
        else    setHeapStatsAvailable view False
      setSparkStats view summSparkStats
  
  setTimeStats :: SummaryView -> TimeStats -> IO ()
  setTimeStats SummaryView{..} TimeStats{..} =
    mapM_ (\(label, text) -> set label [ labelText := text ])
      [ (labelTimeTotal       , showFFloat (Just 2) (timeToSecondsDbl timeTotal) "s")
      , (labelTimeMutator     , showFFloat (Just 2) (timeToSecondsDbl timeMutator) "s")
      , (labelTimeGC          , showFFloat (Just 2) (timeToSecondsDbl timeGC) "s")
      , (labelTimeProductivity, showFFloat (Just 1) (timeProductivity * 100) "% of mutator vs total")
      ]
  
  setHeapStats :: SummaryView -> HeapStats -> IO ()
  setHeapStats SummaryView{..} HeapStats{..} = do
      setHeapStatLabels labelHeapMaxSize      heapMaxSize      "" ""
      setHeapStatLabels labelHeapMaxResidency heapMaxResidency "" ""
      setHeapStatLabels labelHeapAllocTotal   heapTotalAlloc   "" ""
      setHeapStatLabels labelHeapAllocRate    heapAllocRate    "/s" " per second (of mutator time)"
      setHeapStatLabels labelHeapMaxSlop      heapMaxSlop      "" ""
      setHeapStatLabels labelGcCopied         heapCopiedDuringGc "" ""
    where
      setHeapStatLabels labels stat unitSuffix unitSuffixLong =
        let texts = case stat of
              Nothing -> ("N/A", "", "", "")
              Just b  -> ( formatBytesInUnit b u, formatUnit u ++ unitSuffix
                         , formatBytes b, "bytes" ++ unitSuffixLong)
                where u = getByteUnit b
        in setLabels labels texts
  
      setLabels (short,shortunit,long,longunit) (short', shortunit', long', longunit') = do
        mapM_ (\(label, text) -> set label [ labelText := text ])
              [ (short, short'), (shortunit, shortunit')
              , (long, long'),   (longunit, longunit') ]
  
  
  setGcStats :: SummaryView -> GcStats -> IO ()
  setGcStats SummaryView{..} GcStats{..} = do
    let balText = maybe "N/A"
                        (printf "%.2f%% (serial 0%%, perfect 100%%)")
                        gcParWorkBalance
    set labelGcParWorkBalance [ labelText := balText ]
    listStoreClear storeGcStats
    mapM_ (listStoreAppend storeGcStats) (gcTotalStats:gcGenStats)
  
  setSparkStats :: SummaryView -> SparkStats -> IO ()
  setSparkStats SummaryView{..} SparkStats{..} = do
    listStoreClear storeSparkStats
    mapM_ (listStoreAppend storeSparkStats) ((-1,totalSparkStats):capSparkStats)
  
  data ByteUnit = TiB | GiB | MiB | KiB | B deriving Show
  
  byteUnitVal :: ByteUnit -> Word64
  byteUnitVal TiB = 2^40
  byteUnitVal GiB = 2^30
  byteUnitVal MiB = 2^20
  byteUnitVal KiB = 2^10
  byteUnitVal   B = 1
  
  getByteUnit :: Word64 -> ByteUnit
  getByteUnit b
    | b >= 2^40 = TiB
    | b >= 2^30 = GiB
    | b >= 2^20 = MiB
    | b >= 2^10 = KiB
    | otherwise = B
  
  formatBytesInUnit :: Word64 -> ByteUnit -> String
  formatBytesInUnit n u =
      formatFixed (fromIntegral n / fromIntegral (byteUnitVal u))
    where
      formatFixed x = showFFloat (Just 1) x ""
  
  formatUnit :: ByteUnit -> String
  formatUnit = show
  
  formatBytes :: Word64 -> String
  formatBytes b = ppWithCommas b
  
  ppWithCommas :: Word64 -> String
  ppWithCommas =
    let spl [] = []
        spl l  = let (c3, cs) = L.splitAt 3 l
                 in c3 : spl cs
    in L.reverse . L.intercalate "," . spl . L.reverse . show
  
  setSummaryStatsEmpty :: SummaryView -> IO ()
  setSummaryStatsEmpty SummaryView{..} = do
    mapM_ (\label -> set label [ labelText := ""
                               , widgetTooltipText
                                 := (Nothing :: Maybe String) ]) $
      [ labelTimeTotal, labelTimeMutator
      , labelTimeGC, labelTimeProductivity ] ++
      [ w
      | (a,b,c,d) <- [ labelHeapMaxSize, labelHeapMaxResidency
                     , labelHeapAllocTotal, labelHeapAllocRate
                     , labelHeapMaxSlop, labelGcCopied ]
      , w <- [ a,b,c,d] ]
    listStoreClear storeGcStats
    listStoreClear storeSparkStats
  
  setHeapStatsAvailable :: SummaryView -> Bool -> IO ()
  setHeapStatsAvailable SummaryView{..} available
    | available = do
        forM_ unavailableWidgets $ \widget ->
          set widget [ widgetTooltipText := (Nothing :: Maybe String)
                     , widgetSensitive := True ]
  
    | otherwise = do
        forM_ allLabels $ \label -> set label [ labelText := "" ]
        listStoreClear storeGcStats
  
        forM_ unavailableLabels  $ \label  ->
          set label  [ labelText := "(unavailable)" ]
  
        forM_ unavailableWidgets $ \widget ->
          set widget [ widgetTooltipText := Just msgInfoUnavailable, widgetSensitive := False ]
  
    where
      allLabels =
        [ labelTimeMutator, labelTimeGC
        , labelTimeProductivity, labelGcParWorkBalance ] ++
        [ w | (a,b,c,d) <- [ labelHeapMaxSize, labelHeapMaxResidency
                           , labelHeapAllocTotal, labelHeapAllocRate
                           , labelHeapMaxSlop, labelGcCopied ]
            , w <- [ a,b,c,d] ]
      unavailableLabels =
        [ labelTimeMutator, labelTimeGC
        , labelTimeProductivity, labelGcParWorkBalance
        , case labelGcCopied of (w,_,_,_) -> w ] ++
        [ c | (_,_,c,_) <- [ labelHeapMaxSize, labelHeapMaxResidency
                           , labelHeapAllocTotal, labelHeapAllocRate
                           , labelHeapMaxSlop ] ]
      unavailableWidgets = [ toWidget labelTimeMutator, toWidget labelTimeGC
                           , toWidget labelTimeProductivity
                           , tableHeap, tableGc ]
      msgInfoUnavailable = "This eventlog does not contain heap or GC information."
  
  ------------------------------------------------------------------------------
  -- Calculating the stats we want to display
  --
  
  data SummaryStats = SummaryStats {
         summTimeStats  :: TimeStats,
         summHeapStats  :: HeapStats,
         summGcStats    :: GcStats,
         summSparkStats :: SparkStats
       }
  
  data TimeStats = TimeStats {
         timeTotal        :: !Word64, -- we really should have a better type for elapsed time
         timeGC           :: !Word64,
         timeMutator      :: !Word64,
         timeProductivity :: !Double
       }
  
  data HeapStats = HeapStats {
         heapMaxSize        :: Maybe Word64,
         heapMaxResidency   :: Maybe Word64,
         heapMaxSlop        :: Maybe Word64,
         heapTotalAlloc     :: Maybe Word64,
         heapAllocRate      :: Maybe Word64,
         heapCopiedDuringGc :: Maybe Word64
       }
  
  data GcStats = GcStats {
         gcNumThreads     :: !Int,
         gcParWorkBalance :: !(Maybe Double),
         gcGenStats       :: [GcStatsEntry],
         gcTotalStats     :: !GcStatsEntry
       }
  data GcStatsEntry = GcStatsEntry !Int !Int !Int !Word64 !Double !Double
  
  data SparkStats = SparkStats {
         capSparkStats   :: [(Cap, SparkCounts)],
         totalSparkStats :: !SparkCounts
       }
  data SparkCounts = SparkCounts !Word64 !Word64 !Word64 !Word64 !Word64 !Word64
  
  
  -- | Take the events, and optionally some sub-range, and generate the summary
  -- stats for that range.
  --
  -- We take a two-step approach:
  --  * a single pass over the events, accumulating into an intermediate
  --    'StatsAccum' record,
  --  * then look at that 'StatsAccum' record and construct the various final
  --    stats that we want to present.
  --
  summaryStats :: Array Int CapEvent -> Maybe Interval -> SummaryStats
  summaryStats events minterval =
      SummaryStats {
         summHeapStats  = hs,
         summGcStats    = gs,
         summSparkStats = ss,
         summTimeStats  = ts
       }
    where
      !statsAccum = accumStats events minterval
  
      gs = gcStats    statsAccum
      ss = sparkStats statsAccum
      ts = timeStats  events minterval gs
      hs = heapStats  statsAccum ts
  
  
  -- | Linearly accumulate the stats from the events array,
  -- either the full thing or some sub-range.
  accumStats :: Array Int CapEvent -> Maybe Interval -> StatsAccum
  accumStats events minterval =
      foldl' accumEvent start [ events ! i | i <- range eventsRange ]
    where
      eventsRange = selectEventRange events minterval
  
      -- If we're starting from time zero then we know many of the stats
      -- also start at from, where as from other points it's just unknown
      start | fst eventsRange == 0 = zeroStatsAccum
            | otherwise            = emptyStatsAccum
  
  -- | Given the event array and a time interval, return the range of array
  -- indicies containing that interval. The Nothing interval means to select
  -- the whole array range.
  --
  selectEventRange :: Array Int CapEvent -> Maybe Interval -> (Int, Int)
  selectEventRange arr Nothing             = bounds arr
  selectEventRange arr (Just (start, end)) = (lbound, ubound)
    where
      !lbound = either snd id $ findArrayRange cmp arr start
      !ubound = either fst id $ findArrayRange cmp arr end
      cmp ts (CapEvent _ (Event ts' _)) = compare ts ts'
  
      findArrayRange :: (key -> val -> Ordering)
                     -> Array Int val -> key -> Either (Int,Int) Int
      findArrayRange cmp arr key =
          binarySearch a0 b0 key
        where
          (a0,b0) = bounds arr
  
          binarySearch a b key
            | a > b     = Left (b,a)
            | otherwise = case cmp key (arr ! mid) of
                LT -> binarySearch a (mid-1) key
                EQ -> Right mid
                GT -> binarySearch (mid+1) b key
            where mid = (a + b) `div` 2
  
  ------------------------------------------------------------------------------
  -- Final step where we convert from StatsAccum to various presentation forms
  
  timeStats :: Array Int CapEvent -> Maybe Interval -> GcStats -> TimeStats
  timeStats events minterval
            GcStats { gcTotalStats = GcStatsEntry _ _ _ timeGC _ _ } =
      TimeStats {..}
    where
      timeTotal        = intervalEnd - intervalStart
      timeMutator      = timeTotal   - timeGC
      timeProductivity = timeToSecondsDbl timeMutator
                       / timeToSecondsDbl timeTotal
  
      (intervalStart, intervalEnd) =
        case minterval of
          Just (s,e) -> (s, e)
          Nothing    -> (0, timeOf (events ! ub))
            where
              (_lb, ub) = bounds events
              timeOf (CapEvent _ (Event t _)) = t
  
  
  heapStats :: StatsAccum -> TimeStats -> HeapStats
  heapStats StatsAccum{..} TimeStats{timeMutator} =
      HeapStats {
        heapMaxSize        = dmaxMemory,
        heapMaxResidency   = dmaxResidency,
        heapMaxSlop        = dmaxSlop,
        heapTotalAlloc     = if totalAlloc == 0
                               then Nothing
                               else Just totalAlloc,
        heapAllocRate      = if timeMutator == 0 || totalAlloc == 0
                                then Nothing
                                else Just $ truncate (fromIntegral totalAlloc / timeToSecondsDbl timeMutator),
        heapCopiedDuringGc = if dcopied == Just 0
                                then Nothing
                                else dcopied
      }
    where
      totalAlloc = sum [ end - start
                       | (end,start) <- IM.elems dallocTable ]
  
  
  gcStats :: StatsAccum -> GcStats
  gcStats StatsAccum{..} =
      GcStats {
        gcNumThreads     = nThreads,
        gcParWorkBalance,
        gcGenStats       = [ mkGcStatsEntry gen (gcGather gen)
                           | gen <- gens ],
        gcTotalStats     = mkGcStatsEntry gcGenTot (gcGather gcGenTot)
      }
    where
      nThreads = fromMaybe 1 dmaxParNThreads
  
      gcParWorkBalance | nThreads <= 1
                         || fromMaybe 0 dparMaxCopied <= 0 = Nothing
                       | otherwise =
        Just $
          100 * ((maybe 0 fromIntegral dparTotCopied
                  / maybe 0 fromIntegral dparMaxCopied) - 1)
                / (fromIntegral nThreads - 1)
  
      gens = [0..maxGeneration]
        where
          -- Does not work for generationless GCs, but works reasonably
          -- for > 2 gens and perfectly for 2 gens.
          maxGeneration = maximum $ 1
                                  : [ maxGen
                                    | RtsGC { gcGenStat } <- IM.elems dGCTable
                                    , not (IM.null gcGenStat)
                                    , let (maxGen, _) = IM.findMax gcGenStat ]
  
      gcGather :: Gen -> GenStat
      gcGather gen = gcSum gen $ map gcGenStat $ IM.elems dGCTable
      -- TODO: Consider per-HEC display of GC stats and then use
      -- the values summed over all generations at key gcGenTot at each cap.
  
      gcSum :: Gen -> [IM.IntMap GenStat] -> GenStat
      gcSum gen l =
          GenStat (sumPr gcAll) (sumPr gcPar)
                  (gcElapsed mainGen) (gcMaxPause mainGen)
        where
          l_genGC = map (IM.findWithDefault emptyGenStat gen) l
          sumPr proj = sum $ map proj l_genGC
          _maxPr proj = L.maximum $ map proj l_genGC
          _minPr proj = L.minimum $ filter (> 0) $ map proj l_genGC
          -- This would be the most balanced way of aggregating gcElapsed,
          -- if only the event times were accurate.
          _avgPr proj = let vs = filter (> 0) $ map proj l_genGC
                        in sum vs `div` fromIntegral (length vs)
          -- But since the times include scheduling noise,
          -- we only use the times from the main cap for each GC
          -- and so get readings almost identical to +RTS -s.
          mainGen = IM.findWithDefault emptyGenStat gen mainStat
  
      mainStat = gcGenStat (fromMaybe (defaultGC 0) dGCMain)
  
      mkGcStatsEntry :: Gen -> GenStat -> GcStatsEntry
      mkGcStatsEntry gen GenStat{..} =
          GcStatsEntry gen gcAll gcPar gcElapsedS gcAvgPauseS gcMaxPauseS
        where
          gcElapsedS  = gcElapsed
          gcMaxPauseS = timeToSecondsDbl gcMaxPause
          gcAvgPauseS
            | gcAll == 0 = 0
            | otherwise  = timeToSeconds $
                             fromIntegral gcElapsed / fromIntegral gcAll
  
  
  sparkStats :: StatsAccum -> SparkStats
  sparkStats StatsAccum{dsparkTable} =
      SparkStats {
        capSparkStats =
          [ (cap, mkSparkStats sparkCounts)
          | (cap, sparkCounts) <- capsSparkCounts ],
  
        totalSparkStats =
          mkSparkStats $
          foldl' (binopSparks (+)) zeroSparks
            [ sparkCounts | (_cap, sparkCounts) <- capsSparkCounts ]
      }
    where
      capsSparkCounts =
        [ (cap,  sparkCounts)
        | (cap, (countsEnd, countsStart)) <- IM.assocs dsparkTable
        , let sparkCounts = binopSparks (-) countsEnd countsStart ]
  
      mkSparkStats RtsSpark {sparkCreated, sparkDud, sparkOverflowed,
                             sparkConverted, sparkFizzled, sparkGCd} =
        -- in our final presentation we show the total created,
        -- and the breakdown of that into outcomes:
        SparkCounts (sparkCreated + sparkDud + sparkOverflowed)
                    sparkConverted sparkOverflowed
                    sparkDud sparkGCd sparkFizzled
  
  
  ------------------------------------------------------------------------------
  
  timeToSecondsDbl :: Integral a => a -> Double
  timeToSecondsDbl t = timeToSeconds $ fromIntegral t
  
  timeToSeconds :: Double -> Double
  timeToSeconds t = t / tIME_RESOLUTION
   where tIME_RESOLUTION = 1000000
  
  ------------------------------------------------------------------------------
  -- The single-pass stats accumulation stuff
  --
  
  -- | Data collected and computed gradually while events are scanned.
  data StatsAccum = StatsAccum
    { dallocTable     :: !(IM.IntMap (Word64, Word64))  -- indexed by caps
    , dcopied         :: !(Maybe Word64)
    , dmaxResidency   :: !(Maybe Word64)
    , dmaxSlop        :: !(Maybe Word64)
    , dmaxMemory      :: !(Maybe Word64)
  --, dmaxFrag        :: Maybe Word64  -- not important enough
    , dGCTable        :: !(IM.IntMap RtsGC)  -- indexed by caps
    -- Here we store the official +RTS -s timings of GCs,
    -- that is times aggregated from the main caps of all GCs.
    -- For now only gcElapsed and gcMaxPause are needed, so the rest
    -- of the fields stays at default values.
    , dGCMain         :: !(Maybe RtsGC)
    , dparMaxCopied   :: !(Maybe Word64)
    , dparTotCopied   :: !(Maybe Word64)
    , dmaxParNThreads :: !(Maybe Int)
  --, dtaskTable      -- of questionable usefulness, hard to get
    , dsparkTable     :: !(IM.IntMap (RtsSpark, RtsSpark))  -- indexed by caps
  --, dInitExitT      -- TODO. At least init time can be included in the total
                      -- time registered in the eventlog. Can we measure this
                      -- as the time between some initial events?
  --, dGCTime         -- Is better computed after all events are scanned,
                      -- e.g., because the same info can be used to calculate
                      -- per-cap GCTime and other per-cap stats.
  --, dtotalTime      -- TODO: can we measure this excluding INIT or EXIT times?
    }
  
  data RtsSpark = RtsSpark
   { sparkCreated, sparkDud, sparkOverflowed
   , sparkConverted, sparkFizzled, sparkGCd :: !Word64
   }
  
  zeroSparks :: RtsSpark
  zeroSparks = RtsSpark 0 0 0 0 0 0
  
  binopSparks :: (Word64 -> Word64 -> Word64) -> RtsSpark -> RtsSpark -> RtsSpark
  binopSparks op (RtsSpark crt1 dud1 ovf1 cnv1 fiz1 gcd1)
                 (RtsSpark crt2 dud2 ovf2 cnv2 fiz2 gcd2) =
        RtsSpark (crt1 `op` crt2) (dud1 `op` dud2) (ovf1 `op` ovf2)
                 (cnv1 `op` cnv2) (fiz1 `op` fiz2) (gcd1 `op` gcd2)
  
  type Gen = Int
  
  type Cap = Int
  
  data GcMode =
    ModeInit | ModeStart | ModeSync Cap | ModeGHC Cap Gen | ModeEnd | ModeIdle
    deriving Eq
  
  data RtsGC = RtsGC
    { gcMode      :: !GcMode
    , gcStartTime :: !Timestamp
    , gcGenStat   :: !(IM.IntMap GenStat)  -- indexed by generations
    }
  
  -- Index at the @gcGenStat@ map at which we store the sum of stats over all
  -- generations, or the single set of stats for non-genenerational GC models.
  gcGenTot :: Gen
  gcGenTot = -1
  
  data GenStat = GenStat
    { -- Sum over all seqential and pararell GC invocations.
      gcAll      :: !Int
    , -- Only parallel GCs. For GC models without stop-the-world par, always 0.
      gcPar      :: !Int
    , gcElapsed  :: !Timestamp
    , gcMaxPause :: !Timestamp
    }
  
  emptyStatsAccum :: StatsAccum
  emptyStatsAccum = StatsAccum
    { dallocTable     = IM.empty
    , dcopied         = Nothing
    , dmaxResidency   = Nothing
    , dmaxSlop        = Nothing
    , dmaxMemory      = Nothing
    , dGCTable        = IM.empty
    , dGCMain         = Nothing
    , dparMaxCopied   = Nothing
    , dparTotCopied   = Nothing
    , dmaxParNThreads = Nothing
    , dsparkTable     = IM.empty
    }
  
  -- | At the beginning of a program run, we know for sure several of the
  -- stats start at zero:
  zeroStatsAccum :: StatsAccum
  zeroStatsAccum = emptyStatsAccum {
      dcopied       = Just 0,
      dmaxResidency = Just 0,
      dmaxSlop      = Just 0,
      dmaxMemory    = Just 0,
      dallocTable   = -- a hack: we assume no more than 999 caps
                      IM.fromDistinctAscList $ zip [0..999] $ repeat (0, 0)
                      -- FIXME: but also, we should have a way to init to 0 for all caps.
    }
  
  defaultGC :: Timestamp -> RtsGC
  defaultGC time = RtsGC
    { gcMode      = ModeInit
    , gcStartTime = time
    , gcGenStat   = IM.empty
    }
  
  emptyGenStat :: GenStat
  emptyGenStat = GenStat
    { gcAll      = 0
    , gcPar      = 0
    , gcElapsed  = 0
    , gcMaxPause = 0
    }
  
  -- Fail only when assertions are turned on.
  errorAs :: String -> a -> a
  errorAs msg a = assert (error msg) a
  
  accumEvent :: StatsAccum -> CapEvent -> StatsAccum
  accumEvent !statsAccum (CapEvent mcap ev) =
    let -- For events that contain a counter with a running sum.
        -- Eventually we'll subtract the last found
        -- event from the first. Intervals beginning at time 0
        -- are a special case, because morally the first event should have
        -- value 0, but it may be absent, so we start with @Just (0, 0)@.
        alterCounter n Nothing = Just (n, n)
        alterCounter n (Just (_previous, first)) = Just (n, first)
        -- For events that contain discrete increments. We assume the event
        -- is emitted close to the end of the process it measures,
        -- so we ignore the first found event, because most of the process
        -- could have happened before the start of the current inverval.
        -- This is consistent with @alterCounter@. For interval beginning
        -- at time 0, we start with @Just 0@.
        alterIncrement _ Nothing = Just 0
        alterIncrement n (Just k) = Just (k + n)
        -- For events that contain sampled values, where a max is sought.
        alterMax n Nothing = Just n
        alterMax n (Just k) | n > k = Just n
        alterMax _ jk = jk
        -- Scan events, updating summary data.
        scan cap !sd@StatsAccum{..} Event{time, spec} =
          let capGC = IM.findWithDefault (defaultGC time) cap dGCTable
          in case spec of
            -- TODO: check EventBlock elsewhere; define {map,fold}EventBlock
            EventBlock{cap = bcap, block_events} ->
              L.foldl' (scan bcap) sd block_events
            HeapAllocated{allocBytes} ->
              sd { dallocTable =
                     IM.alter (alterCounter allocBytes) cap dallocTable }
            HeapLive{liveBytes} ->
              sd { dmaxResidency = alterMax liveBytes dmaxResidency}
            HeapSize{sizeBytes} ->
              sd { dmaxMemory = alterMax sizeBytes dmaxMemory}
            StartGC ->
              assert (gcMode capGC `elem` [ModeInit, ModeEnd, ModeIdle]) $
              let newGC = capGC { gcMode = ModeStart
                                , gcStartTime = time
                                }
              -- TODO: Index with generations, not caps?
              in sd { dGCTable = IM.insert cap newGC dGCTable }
            GlobalSyncGC ->
              -- All caps must be stopped. Those that take part in the GC
              -- are in ModeInit or ModeStart, those that do not
              -- are in ModeInit, ModeEnd or ModeIdle.
              assert (L.all (notModeGHCEtc . gcMode) (IM.elems dGCTable)) $
              sd { dGCTable = IM.mapWithKey setSync dGCTable }
               where
                notModeGHCEtc ModeGHC{}  = False
                notModeGHCEtc ModeSync{} = False
                notModeGHCEtc _          = True
                someInit = L.any ((== ModeInit) . gcMode) (IM.elems dGCTable)
                setSync capKey dGC@RtsGC{gcGenStat}
                  | someInit =
                  -- If even one cap could possibly have started GC before
                  -- the start of the selected interval, skip the GC on all caps.
                  -- We don't verify the overwritten modes in this case.
                  -- TODO: we could be smarter and defer the decision to EndGC,
                  -- when we can deduce if the suspect caps take part in GC
                  -- or not at all.
                  dGC { gcMode = ModeInit }
                  | otherwise =
                  let totGC = IM.findWithDefault emptyGenStat gcGenTot gcGenStat
                  in case gcMode dGC of
                    -- Cap takes part in the GC (not known if seq or par).
                    -- Here is the moment where all caps taking place in the GC
                    -- are identified and we can aggregate all their data
                    -- at once (currently we just increment a counter for each).
                    -- The EndGC events can come much later for some caps and at
                    -- that time other caps are already inside their new GC.
                    ModeStart ->
                      dGC { gcMode = ModeSync cap
                          , gcGenStat =
                              if capKey == cap
                              then IM.insert gcGenTot
                                     totGC{ gcAll = gcAll totGC + 1 }
                                     gcGenStat
                              else gcGenStat
                          }
                    -- Cap is not in the GC. Mark it as idle to complete
                    -- the identification of caps that take part
                    -- in the current GC. Without overwriting the mode,
                    -- the cap could be processed later on as if
                    -- it took part in the GC, giving wrong results.
                    ModeEnd  -> dGC { gcMode = ModeIdle }
                    ModeIdle -> dGC
                    -- Impossible.
                    ModeInit   -> errorAs "scanEvents: GlobalSyncGC ModeInit" dGC
                    ModeSync{} -> errorAs "scanEvents: GlobalSyncGC ModeSync" dGC
                    ModeGHC{}  -> -- error "scanEvents: GlobalSyncGC ModeGHC"
                                  dGC  -- workaround for #46
            GCStatsGHC{..} ->
              -- All caps must be stopped. Those that take part in the GC
              -- are in ModeInit or ModeSync, those that do not
              -- are in ModeInit or ModeIdle.
              assert (L.all (notModeStartEtc . gcMode) (IM.elems dGCTable)) $
              sd { dcopied  = alterIncrement copied dcopied  -- sum over caps
                 , dmaxSlop = alterMax slop dmaxSlop  -- max over all caps
                 , dGCTable = IM.mapWithKey setParSeq dGCTable
                 , dparMaxCopied = alterIncrement parMaxCopied dparMaxCopied
                 , dparTotCopied = alterIncrement parTotCopied dparTotCopied
                 , dmaxParNThreads = alterMax parNThreads dmaxParNThreads
                 }
               where
                notModeStartEtc ModeStart = False
                notModeStartEtc ModeGHC{} = False
                notModeStartEtc ModeEnd   = False
                notModeStartEtc _         = True
                someInit = L.any ((== ModeInit) . gcMode) (IM.elems dGCTable)
                setParSeq capKey dGC@RtsGC{gcGenStat}
                  | someInit =
                  -- Just starting the selected interval, so skip the GC.
                  dGC
                  | otherwise =
                  let genGC = IM.findWithDefault emptyGenStat gen gcGenStat
                      totGC = IM.findWithDefault emptyGenStat gcGenTot gcGenStat
                  in case gcMode dGC of
                    -- Cap takes part in seq GC.
                    ModeSync capSync | parNThreads == 1 ->
                      assert (cap == capSync) $
                      dGC { gcMode = ModeGHC cap gen
                          , gcGenStat =
                            -- Already inserted into gcGenTot in GlobalSyncGC,
                            -- so only inserting into gen.
                            if capKey == cap
                            then IM.insert gen
                                   genGC{ gcAll = gcAll genGC + 1 }
                                   gcGenStat
                            else gcGenStat
                          }
                    -- Cap takes part in par GC.
                    ModeSync capSync ->
                      assert (cap == capSync) $
                      assert (parNThreads > 1) $
                      dGC { gcMode = ModeGHC cap gen
                          , gcGenStat =
                            if capKey == cap
                            then IM.insert gen
                                   genGC{ gcAll = gcAll genGC + 1
                                        , gcPar = gcPar genGC + 1
                                        }
                                   (IM.insert gcGenTot
                                     -- Already incremented gcAll in SyncGC.
                                     totGC{ gcPar = gcPar totGC + 1 }
                                     gcGenStat)
                            else gcGenStat
                          }
                    -- Cap not in the current GC, leave it alone.
                    ModeIdle -> dGC
                    -- Impossible.
                    ModeInit  -> errorAs "scanEvents: GCStatsGHC ModeInit" dGC
                    ModeGHC{} -> -- error "scanEvents: GCStatsGHC ModeGHC"
                                 dGC  -- workaround for #46
                    -- The last two cases are copied from case @GlobalSyncGC@
                    -- to work around low-resolution timestamps (#35).
                    -- Normally, these states would be impossible here, because
                    -- @GlobalSyncGC@ would already transition away from these
                    -- states. But if @GlobalSyncGC@ comes too early, the states
                    -- can appear here. The computed stats are usually only
                    -- slightly different than if @GlobalSyncGC@ made the state
                    -- transitions, because the timestamps of @GCStatsGHC@
                    -- and @GlobalSyncGC@ are normally only slightly different.
                    --
                    -- Cap takes part in the GC (not known if seq or par).
                    -- Here is the moment where all caps taking place in the GC
                    -- are identified and we can aggregate all their data
                    -- at once (currently we just increment a counter for each).
                    -- The EndGC events can come much later for some caps and at
                    -- that time other caps are already inside their new GC.
                    ModeStart ->
                      dGC { gcMode = ModeSync cap
                          , gcGenStat =
                              if capKey == cap
                              then IM.insert gcGenTot
                                     totGC{ gcAll = gcAll totGC + 1 }
                                     gcGenStat
                              else gcGenStat
                          }
                    -- Cap is not in the GC. Mark it as idle to complete
                    -- the identification of caps that take part
                    -- in the current GC. Without overwritin the mode,
                    -- the cap could be processed later on as if
                    -- it took part in the GC, giving wrong results.
                    ModeEnd  -> dGC { gcMode = ModeIdle }
            EndGC ->
              assert (gcMode capGC `notElem` [ModeEnd, ModeIdle]) $
              let endedGC = capGC { gcMode = ModeEnd }
                  duration = time - gcStartTime capGC
                  timeGC gen gstat =
                    let genGC =
                          IM.findWithDefault emptyGenStat gen (gcGenStat gstat)
                        newGenGC =
                          genGC { gcElapsed = gcElapsed genGC + duration
                                , gcMaxPause = max (gcMaxPause genGC) duration
                                }
                    in gstat { gcGenStat = IM.insert gen newGenGC
                                               (gcGenStat gstat) }
                  timeGenTot = timeGC gcGenTot endedGC
                  updateMainCap mainCap _          dgm | mainCap /= cap = dgm
                  updateMainCap _       currentGen dgm =
                    -- We are at the EndGC event of the main cap of current GC.
                    -- The timings from this cap are the only that +RTS -s uses.
                    -- We will record them in the dGCMain field to be able
                    -- to display a look-alike of +RTS -s.
                    timeGC currentGen dgm
              in case gcMode capGC of
                   -- We don't know the exact timing of this GC started before
                   -- the selected interval, so we skip it and clear its mode.
                   ModeInit -> sd { dGCTable = IM.insert cap endedGC dGCTable }
                   -- There is no GlobalSyncGC nor GCStatsGHC for this GC.
                   -- Consequently, we can't determine the main cap,
                   -- so skip it and and clear its mode.
                   ModeStart -> sd { dGCTable = IM.insert cap endedGC dGCTable }
                   -- There is no GCStatsGHC for this GC. Gather partial data.
                   ModeSync mainCap ->
                     let dgm = fromMaybe (defaultGC time) dGCMain
                         mainGenTot = updateMainCap mainCap gcGenTot dgm
                     in sd { dGCTable = IM.insert cap timeGenTot dGCTable
                           , dGCMain = Just mainGenTot
                           }
                   -- All is known, so we update the times.
                   ModeGHC mainCap gen ->
                     let newTime = timeGC gen timeGenTot
                         dgm = fromMaybe (defaultGC time) dGCMain
                         mainGenTot = updateMainCap mainCap gcGenTot dgm
                         newMain = updateMainCap mainCap gen mainGenTot
                     in sd { dGCTable = IM.insert cap newTime dGCTable
                           , dGCMain = Just newMain
                           }
                   ModeEnd   -> errorAs "scanEvents: EndGC ModeEnd" sd
                   ModeIdle  -> errorAs "scanEvents: EndGC ModeIdle"
                                $ sd { dGCTable = IM.insert cap endedGC dGCTable }
            SparkCounters crt dud ovf cnv fiz gcd _rem ->
              -- We are guranteed the first spark counters event has all zeroes,
              -- do we don't need to rig the counters for maximal interval.
              let current = RtsSpark crt dud ovf cnv fiz gcd
              in sd { dsparkTable =
                        IM.alter (alterCounter current) cap dsparkTable }
            _ -> sd
      in scan (fromMaybe (error "Error: missing cap; use 'ghc-events validate' to verify the eventlog") mcap) statsAccum ev
  