threadscope 0.2.4 → 0.2.5
raw patch · 7 files changed
+48/−24 lines, 7 filesdep +textdep ~gtk
Dependencies added: text
Dependency ranges changed: gtk
Files
- GUI/EventsView.hs +9/−3
- GUI/Histogram.hs +8/−6
- GUI/ProgressView.hs +2/−2
- GUI/SummaryView.hs +13/−10
- GUI/Timeline.hs +5/−0
- GUI/Timeline/Render.hs +8/−1
- threadscope.cabal +3/−2
GUI/EventsView.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module GUI.EventsView ( EventsView, eventsViewNew,@@ -18,6 +19,7 @@ import Control.Monad.Reader import Data.Array import Data.IORef+import qualified Data.Text as T import Numeric -------------------------------------------------------------------------------@@ -40,9 +42,9 @@ data EventsState = EventsEmpty | EventsLoaded {- cursorPos :: !Int,- mrange :: !(Maybe (Int, Int)),- eventsArr :: Array Int CapEvent+ cursorPos :: !Int,+ mrange :: !(Maybe (Int, Int)),+ eventsArr :: Array Int CapEvent } -------------------------------------------------------------------------------@@ -113,7 +115,11 @@ return True key <- eventKeyName+#if MIN_VERSION_gtk(0,13,0)+ case T.unpack key of+#else case key of+#endif "Up" -> scroll (\_page _end pos -> pos-1) "Down" -> scroll (\_page _end pos -> pos+1) "Page_Up" -> scroll (\ page _end pos -> pos-page)
GUI/Histogram.hs view
@@ -1,4 +1,5 @@-module GUI.Histogram (+{-# LANGUAGE ScopedTypeVariables #-}+ module GUI.Histogram ( HistogramView, histogramViewNew, histogramViewSetHECs,@@ -10,16 +11,16 @@ import GUI.Timeline.Render.Constants import GUI.Types -import Graphics.UI.Gtk import qualified Graphics.Rendering.Cairo as C+import Graphics.UI.Gtk import qualified GUI.GtkExtras as GtkExt import Data.IORef data HistogramView = HistogramView- { hecsIORef :: IORef (Maybe HECs)- , mintervalIORef :: IORef (Maybe Interval)+ { hecsIORef :: IORef (Maybe HECs)+ , mintervalIORef :: IORef (Maybe Interval) , histogramDrawingArea :: DrawingArea , histogramYScaleArea :: DrawingArea }@@ -74,8 +75,9 @@ pangoCtx <- widgetGetPangoContext histogramDrawingArea style <- get histogramDrawingArea widgetStyle layout <- layoutEmpty pangoCtx- layoutSetMarkup layout $ "No detailed spark events in this eventlog.\n"- ++ "Re-run with <tt>+RTS -lf</tt> to generate them."+ (_ :: String) <- layoutSetMarkup layout $+ "No detailed spark events in this eventlog.\n"+ ++ "Re-run with <tt>+RTS -lf</tt> to generate them." -- Program the callback for the capability drawingArea on histogramDrawingArea exposeEvent $
GUI/ProgressView.hs view
@@ -9,9 +9,9 @@ startPulse, ) where +import Graphics.Rendering.Cairo import Graphics.UI.Gtk as Gtk import GUI.GtkExtras-import Graphics.Rendering.Cairo import qualified Control.Concurrent as Concurrent import Control.Exception@@ -89,7 +89,7 @@ windowSkipTaskbarHint := True ] - progText <- labelNew Nothing+ progText <- labelNew (Nothing :: Maybe String) set progText [ miscXalign := 0, labelUseMarkup := True
GUI/SummaryView.hs view
@@ -11,14 +11,14 @@ 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 Data.List as L-import qualified Data.IntMap as IM-import Control.Monad-import Control.Exception (assert) import Numeric (showFFloat) import Text.Printf @@ -104,11 +104,11 @@ addGcColumn "Par collections" $ \(GcStatsEntry _ _ pcolls _ _ _) -> [ cellText := show pcolls ] addGcColumn "Elapsed time" $ \(GcStatsEntry _ _ _ time _ _) ->- [ cellText := printf "%5.2fs" (timeToSecondsDbl time) ]+ [ cellText := (printf "%5.2fs" (timeToSecondsDbl time) :: String) ] addGcColumn "Avg pause" $ \(GcStatsEntry _ _ _ _ avgpause _) ->- [ cellText := printf "%3.4fs" avgpause ]+ [ cellText := (printf "%3.4fs" avgpause :: String) ] addGcColumn "Max pause" $ \(GcStatsEntry _ _ _ _ _ maxpause) ->- [ cellText := printf "%3.4fs" maxpause ]+ [ cellText := (printf "%3.4fs" maxpause :: String) ] treeviewSparkStats <- getWidget castToTreeView "treeviewSparkStats" treeViewSetModel treeviewSparkStats storeSparkStats@@ -266,7 +266,9 @@ setSummaryStatsEmpty :: SummaryView -> IO () setSummaryStatsEmpty SummaryView{..} = do- mapM_ (\label -> set label [ labelText := "", widgetTooltipText := Nothing ]) $+ mapM_ (\label -> set label [ labelText := ""+ , widgetTooltipText+ := (Nothing :: Maybe String) ]) $ [ labelTimeTotal, labelTimeMutator , labelTimeGC, labelTimeProductivity ] ++ [ w@@ -281,7 +283,8 @@ setHeapStatsAvailable SummaryView{..} available | available = do forM_ unavailableWidgets $ \widget ->- set widget [ widgetTooltipText := Nothing, widgetSensitive := True ]+ set widget [ widgetTooltipText := (Nothing :: Maybe String)+ , widgetSensitive := True ] | otherwise = do forM_ allLabels $ \label -> set label [ labelText := "" ]@@ -921,4 +924,4 @@ in sd { dsparkTable = IM.alter (alterCounter current) cap dsparkTable } _ -> sd- in scan (fromJust mcap) statsAccum ev+ in scan (fromMaybe (error "Error: missing cap; use 'ghc-events validate' to verify the eventlog") mcap) statsAccum ev
GUI/Timeline.hs view
@@ -38,6 +38,7 @@ import Data.IORef import Control.Monad+import qualified Data.Text as T ----------------------------------------------------------------------------- -- The CPUs view@@ -252,7 +253,11 @@ in withMouseState whenNoMouse >> return True keyName <- eventKeyName keyVal <- eventKeyVal+#if MIN_VERSION_gtk(0,13,0)+ case (T.unpack keyName, keyToChar keyVal, keyVal) of+#else case (keyName, keyToChar keyVal, keyVal) of+#endif ("Right", _, _) -> liftNoMouse $ scrollRight timelineState ("Left", _, _) -> liftNoMouse $ scrollLeft timelineState (_ , Just '+', _) -> liftNoMouse $ timelineZoomIn timelineWin
GUI/Timeline/Render.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module GUI.Timeline.Render ( renderView, renderTraces,@@ -50,6 +51,7 @@ import Data.IORef import Control.Monad+import qualified Data.Text as T ------------------------------------------------------------------------------- @@ -390,7 +392,12 @@ layoutSetWidth layout (Just $ xoffset - 50) -- Note: the following does not always work, see the HACK in Timeline.hs layoutSetAttributes layout [AttrSize minBound maxBound 8,- AttrFamily minBound maxBound "sans serif"]+ AttrFamily minBound maxBound+#if MIN_VERSION_gtk(0,13,0)+ (T.pack "sans serif")]+#else+ "sans serif"]+#endif showLayout layout case traceMaxSpark maxSpkValue maxSparkPool maxYHistogram trace of Just v ->
threadscope.cabal view
@@ -1,5 +1,5 @@ Name: threadscope-Version: 0.2.4+Version: 0.2.5 Category: Development, Profiling, Trace Synopsis: A graphical tool for profiling parallel Haskell programs. Description: ThreadScope is a graphical viewer for thread profile@@ -46,6 +46,7 @@ ghc-events >= 0.4.2, containers >= 0.2 && < 0.6, deepseq >= 1.1,+ text, time >= 1.1 Extensions: RecordWildCards, NamedFieldPuns, BangPatterns, PatternGuards Other-Modules: Events.HECs,@@ -82,7 +83,7 @@ GUI.Timeline.Render.Constants, GUI.GtkExtras - ghc-options: -Wall -fwarn-tabs+ ghc-options: -Wall -fwarn-tabs -rtsopts -fno-warn-type-defaults -fno-warn-name-shadowing -fno-warn-unused-do-bind -- Note: we do not want to use -threaded with gtk2hs.