diff --git a/GUI/EventsView.hs b/GUI/EventsView.hs
--- a/GUI/EventsView.hs
+++ b/GUI/EventsView.hs
@@ -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)
diff --git a/GUI/Histogram.hs b/GUI/Histogram.hs
--- a/GUI/Histogram.hs
+++ b/GUI/Histogram.hs
@@ -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 +RTS -lf to generate them."
+ (_ :: String) <- layoutSetMarkup layout $
+ "No detailed spark events in this eventlog.\n"
+ ++ "Re-run with +RTS -lf to generate them."
-- Program the callback for the capability drawingArea
on histogramDrawingArea exposeEvent $
diff --git a/GUI/ProgressView.hs b/GUI/ProgressView.hs
--- a/GUI/ProgressView.hs
+++ b/GUI/ProgressView.hs
@@ -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
diff --git a/GUI/SummaryView.hs b/GUI/SummaryView.hs
--- a/GUI/SummaryView.hs
+++ b/GUI/SummaryView.hs
@@ -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
diff --git a/GUI/Timeline.hs b/GUI/Timeline.hs
--- a/GUI/Timeline.hs
+++ b/GUI/Timeline.hs
@@ -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
diff --git a/GUI/Timeline/Render.hs b/GUI/Timeline/Render.hs
--- a/GUI/Timeline/Render.hs
+++ b/GUI/Timeline/Render.hs
@@ -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 ->
diff --git a/threadscope.cabal b/threadscope.cabal
--- a/threadscope.cabal
+++ b/threadscope.cabal
@@ -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.