threadscope 0.2.12 → 0.2.13
raw patch · 10 files changed
+128/−60 lines, 10 filesdep ~ghc-eventsdep ~time
Dependency ranges changed: ghc-events, time
Files
- CHANGELOG.md +47/−0
- Events/HECs.hs +3/−2
- Events/TestEvents.hs +1/−0
- GUI/BookmarkView.hs +6/−5
- GUI/EventsView.hs +16/−12
- GUI/Main.hs +3/−1
- GUI/StartupInfoView.hs +19/−15
- GUI/Timeline/HEC.hs +27/−14
- README.md +2/−8
- threadscope.cabal +4/−3
+ CHANGELOG.md view
@@ -0,0 +1,47 @@+# Revision history for threadscope++## 2020-04-06 - v0.2.13++* Add changelog to extra-source-files ([#105](https://github.com/haskell/ThreadScope/pull/105))+* Fix broken GitHub Releases deployment ([#106](https://github.com/haskell/ThreadScope/pull/106))+* Update ghc-events to 0.13.0 ([#107](https://github.com/haskell/ThreadScope/pull/107))+* Relax upper version bound for time++## 2020-03-04 - v0.2.12++* Remove unused events entry box ([#93](https://github.com/haskell/ThreadScope/pull/93))+* Make the app work even if it fails to load the logo ([#96](https://github.com/haskell/ThreadScope/pull/96))+* Support GHC 8.8 ([#99](https://github.com/haskell/ThreadScope/pull/99))+* Support ghc-events 0.12.0 ([#101](https://github.com/haskell/ThreadScope/pull/101))+* Stop using gtk-mac-integration and fix broken CI ([#103](https://github.com/haskell/ThreadScope/pull/103))+ * This causes a visual regression. The logo won't be displayed in Dock.++## 2018-07-12 - v0.2.11.1++* Relax upper version bounds for containers and ghc-events (#88)++## 2018-06-08 - v0.2.11++* Relax upper version bounds for template-haskell and temporary+* Fix build failure with gtk-0.14.9+* Modernise AppVeyor CI script++## 2018-02-16 - v0.2.10++* Add instructions to install gtk2 in the README+* Do not include windows_cconv.h on non mingw32 systems (#79)+* Relax upper version bound for ghc-events (#80)+* Relax upper version bound for time++## 2017-09-02 - v0.2.9++* Render GC waiting periods in light orange (#70)+* Fix inappropriate calling convention on Windows x86 (#71)+* Enable GitHub Releases (#75)++## 2017-07-17 - v0.2.8++* Add macOS support (#56)+* Update ghc-events to 0.6.0 (#61)+* CI builds for Linux/Windows/macOS (#64, #65)+* Set upper version bounds for dependencies
Events/HECs.hs view
@@ -16,6 +16,7 @@ import GHC.RTS.Events import Data.Array+import Data.Text (Text) import qualified Data.List as L #if MIN_VERSION_containers(0,5,0)@@ -37,7 +38,7 @@ maxXHistogram :: Int, maxYHistogram :: Timestamp, durHistogram :: [(Timestamp, Int, Timestamp)],- perfNames :: IM.IntMap String+ perfNames :: IM.IntMap Text } -----------------------------------------------------------------------------@@ -60,7 +61,7 @@ mid = l + (r - l) `quot` 2 tmid = evTime (arr!mid) -extractUserMarkers :: HECs -> [(Timestamp, String)]+extractUserMarkers :: HECs -> [(Timestamp, Text)] extractUserMarkers hecs = [ (ts, mark) | (Event ts (UserMarker mark) _) <- elems (hecEventArray hecs) ]
Events/TestEvents.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module Events.TestEvents (testTrace) where
GUI/BookmarkView.hs view
@@ -15,13 +15,14 @@ import Graphics.UI.Gtk import qualified Graphics.UI.Gtk.ModelView.TreeView.Compat as Compat import Numeric+import Data.Text (Text) --------------------------------------------------------------------------- -- | Abstract bookmark view object. -- data BookmarkView = BookmarkView {- bookmarkStore :: ListStore (Timestamp, String)+ bookmarkStore :: ListStore (Timestamp, Text) } -- | The actions to take in response to TraceView events.@@ -30,12 +31,12 @@ bookmarkViewAddBookmark :: IO (), bookmarkViewRemoveBookmark :: Int -> IO (), bookmarkViewGotoBookmark :: Timestamp -> IO (),- bookmarkViewEditLabel :: Int -> String -> IO ()+ bookmarkViewEditLabel :: Int -> Text -> IO () } --------------------------------------------------------------------------- -bookmarkViewAdd :: BookmarkView -> Timestamp -> String -> IO ()+bookmarkViewAdd :: BookmarkView -> Timestamp -> Text -> IO () bookmarkViewAdd BookmarkView{bookmarkStore} ts label = do listStoreAppend bookmarkStore (ts, label) return ()@@ -49,11 +50,11 @@ bookmarkViewClear BookmarkView{bookmarkStore} = listStoreClear bookmarkStore -bookmarkViewGet :: BookmarkView -> IO [(Timestamp, String)]+bookmarkViewGet :: BookmarkView -> IO [(Timestamp, Text)] bookmarkViewGet BookmarkView{bookmarkStore} = listStoreToList bookmarkStore -bookmarkViewSetLabel :: BookmarkView -> Int -> String -> IO ()+bookmarkViewSetLabel :: BookmarkView -> Int -> Text -> IO () bookmarkViewSetLabel BookmarkView{bookmarkStore} n label = do (ts,_) <- listStoreGetValue bookmarkStore n listStoreSetValue bookmarkStore n (ts, label)
GUI/EventsView.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} module GUI.EventsView ( EventsView, eventsViewNew,@@ -18,9 +19,14 @@ import Control.Monad.Reader import Data.Array+import Data.Monoid import Data.IORef import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB+import qualified Data.Text.Lazy.Builder.Int as TB (decimal) import Numeric+import Prelude ------------------------------------------------------------------------------- @@ -55,8 +61,8 @@ stateRef <- newIORef undefined let getWidget cast = builderGetObject builder cast- drawArea <- getWidget castToWidget "eventsDrawingArea"- vScrollbar <- getWidget castToVScrollbar "eventsVScroll"+ drawArea <- getWidget castToWidget ("eventsDrawingArea" :: T.Text)+ vScrollbar <- getWidget castToVScrollbar ("eventsVScroll" :: T.Text) adj <- get vScrollbar rangeAdjustment -- make the background white@@ -339,16 +345,14 @@ where showEventTime (Event time _spec _) = showFFloat (Just 6) (fromIntegral time / 1000000) "s"- showEventDescr :: Event -> String- showEventDescr (Event _time spec cap) =- (case cap of- Nothing -> ""- Just c -> "HEC " ++ show c ++ ": ")- ++ case spec of- UnknownEvent{ref} -> "unknown event; " ++ show ref- Message msg -> msg- UserMessage msg -> msg- _ -> showEventInfo spec+ showEventDescr :: Event -> T.Text+ showEventDescr (Event _time spec cap) = TL.toStrict $ TB.toLazyText $+ maybe "" (\c -> "HEC " <> TB.decimal c <> ": ") cap+ <> case spec of+ UnknownEvent{ref} -> "unknown event; " <> TB.decimal ref+ Message msg -> TB.fromText msg+ UserMessage msg -> TB.fromText msg+ _ -> buildEventInfo spec -------------------------------------------------------------------------------
GUI/Main.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-} module GUI.Main (runGUI) where -- Imports for GTK@@ -16,6 +17,7 @@ import Control.Exception import Data.Array import Data.Maybe+import Data.Text (Text) -- Imports for ThreadScope import qualified GUI.App as App@@ -108,7 +110,7 @@ | EventBookmarkAdd | EventBookmarkRemove Int- | EventBookmarkEdit Int String+ | EventBookmarkEdit Int Text | EventUserError String SomeException -- can add more specific ones if necessary
GUI/StartupInfoView.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-} module GUI.StartupInfoView ( StartupInfoView, startupInfoViewNew,@@ -14,13 +16,15 @@ import Data.Maybe import Data.Time import Data.Time.Clock.POSIX+import Data.Text (Text)+import qualified Data.Text as T ------------------------------------------------------------------------------- data StartupInfoView = StartupInfoView { labelProgName :: Label- , storeProgArgs :: ListStore String- , storeProgEnv :: ListStore (String, String)+ , storeProgArgs :: ListStore Text+ , storeProgEnv :: ListStore (Text, Text) , labelProgStartTime :: Label , labelProgRtsId :: Label }@@ -28,11 +32,11 @@ data StartupInfoState = StartupInfoEmpty | StartupInfoLoaded- { progName :: Maybe String- , progArgs :: Maybe [String]- , progEnv :: Maybe [(String, String)]+ { progName :: Maybe Text+ , progArgs :: Maybe [Text]+ , progEnv :: Maybe [(Text, Text)] , progStartTime :: Maybe UTCTime- , progRtsId :: Maybe String+ , progRtsId :: Maybe Text } -------------------------------------------------------------------------------@@ -42,11 +46,11 @@ let getWidget cast = builderGetObject builder cast - labelProgName <- getWidget castToLabel "labelProgName"- treeviewProgArgs <- getWidget castToTreeView "treeviewProgArguments"- treeviewProgEnv <- getWidget castToTreeView "treeviewProgEnvironment"- labelProgStartTime <- getWidget castToLabel "labelProgStartTime"- labelProgRtsId <- getWidget castToLabel "labelProgRtsIdentifier"+ labelProgName <- getWidget castToLabel ("labelProgName" :: Text)+ treeviewProgArgs <- getWidget castToTreeView ("treeviewProgArguments" :: Text)+ treeviewProgEnv <- getWidget castToTreeView ("treeviewProgEnvironment" :: Text)+ labelProgStartTime <- getWidget castToLabel ("labelProgStartTime" :: Text)+ labelProgRtsId <- getWidget castToLabel ("labelProgRtsIdentifier" :: Text) storeProgArgs <- listStoreNew [] columnArgs <- treeViewColumnNew@@ -126,7 +130,7 @@ accum info _ = info -- convert ["foo=bar", ...] to [("foo", "bar"), ...]- parseEnv env = [ (var, value) | (var, '=':value) <- map (span (/='=')) env ]+ parseEnv env = [ (var, value) | (var, T.drop 1 -> value) <- map (T.span (/='=')) env ] updateStartupInfo :: StartupInfoView -> StartupInfoState -> IO () updateStartupInfo StartupInfoView{..} StartupInfoLoaded{..} = do@@ -139,8 +143,8 @@ mapM_ (listStoreAppend storeProgEnv) (fromMaybe [] progEnv) updateStartupInfo StartupInfoView{..} StartupInfoEmpty = do- set labelProgName [ labelText := "" ]- set labelProgStartTime [ labelText := "" ]- set labelProgRtsId [ labelText := "" ]+ set labelProgName [ labelText := ("" :: Text) ]+ set labelProgStartTime [ labelText := ("" :: Text) ]+ set labelProgRtsId [ labelText := ("" :: Text) ] listStoreClear storeProgArgs listStoreClear storeProgEnv
GUI/Timeline/HEC.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module GUI.Timeline.HEC ( renderHEC, renderInstantHEC,@@ -19,9 +20,16 @@ import Control.Monad import qualified Data.IntMap as IM import Data.Maybe+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB+import qualified Data.Text.Lazy.Builder.Int as TB (decimal)+import Prelude renderHEC :: ViewParameters -> Timestamp -> Timestamp- -> IM.IntMap String -> (DurationTree,EventTree)+ -> IM.IntMap Text -> (DurationTree,EventTree) -> Render () renderHEC params@ViewParameters{..} start end perfNames (dtree,etree) = do renderDurations params start end dtree@@ -33,7 +41,7 @@ return () renderInstantHEC :: ViewParameters -> Timestamp -> Timestamp- -> IM.IntMap String -> EventTree+ -> IM.IntMap Text -> EventTree -> Render () renderInstantHEC params@ViewParameters{..} start end perfNames (EventTree ltime etime tree) = do@@ -78,7 +86,7 @@ -> Timestamp -- start time of this tree node -> Timestamp -- end time of this tree node -> Timestamp -> Timestamp -> Double- -> IM.IntMap String -> EventNode+ -> IM.IntMap Text -> EventNode -> Render Bool renderEvents params@ViewParameters{..} !_s !_e !startPos !endPos ewidth@@ -200,7 +208,7 @@ -- Optionally write the reason for the thread being stopped -- depending on the zoom value labelAt labelsMode endTime $- show t ++ " " ++ showThreadStopStatus s+ T.pack $ show t ++ " " ++ showThreadStopStatus s where rectWidth = truncate (fromIntegral (endTime - startTime) / scaleValue) -- as pixels tStr = show t@@ -226,7 +234,7 @@ (endTime - startTime) -- w (hecBarHeight `div` 2) -- h -labelAt :: Bool -> Timestamp -> String -> Render ()+labelAt :: Bool -> Timestamp -> Text -> Render () labelAt labelsMode t str | not labelsMode = return () | otherwise = do@@ -238,7 +246,7 @@ showText str restore -drawEvent :: ViewParameters -> Double -> IM.IntMap String -> GHC.Event+drawEvent :: ViewParameters -> Double -> IM.IntMap Text -> GHC.Event -> Render Bool drawEvent params@ViewParameters{..} ewidth perfNames event = let renderI = renderInstantEvent params perfNames event ewidth@@ -270,7 +278,7 @@ _ -> return False -renderInstantEvent :: ViewParameters -> IM.IntMap String -> GHC.Event+renderInstantEvent :: ViewParameters -> IM.IntMap Text -> GHC.Event -> Double -> Color -> Render Bool renderInstantEvent ViewParameters{..} perfNames event ewidth color = do@@ -278,16 +286,21 @@ setLineWidth (ewidth * scaleValue) let t = evTime event draw_line (t, hecBarOff-4) (t, hecBarOff+hecBarHeight+4)- let numToLabel PerfCounter{perfNum, period} | period == 0 =+ let numToLabel :: EventInfo -> Maybe Text+ numToLabel PerfCounter{perfNum, period} | period == 0 = IM.lookup (fromIntegral perfNum) perfNames- numToLabel PerfCounter{perfNum, period} =- fmap (++ " <" ++ show (period + 1) ++ " times>") $- IM.lookup (fromIntegral perfNum) perfNames- numToLabel PerfTracepoint{perfNum} =- fmap ("tracepoint: " ++) $ IM.lookup (fromIntegral perfNum) perfNames+ numToLabel PerfCounter{perfNum, period} = do+ name <- IM.lookup (fromIntegral perfNum) perfNames+ return $ toText $+ TB.fromText name <> " <" <> TB.decimal (period + 1) <> " times>"+ numToLabel PerfTracepoint{perfNum} = do+ name <- IM.lookup (fromIntegral perfNum) perfNames+ return $ toText $ "tracepoint: " <> TB.fromText name numToLabel _ = Nothing- showLabel espec = fromMaybe (showEventInfo espec) (numToLabel espec)+ showLabel espec = fromMaybe (toText $ buildEventInfo espec) (numToLabel espec) labelAt labelsMode t $ showLabel (evSpec event) return True+ where+ toText = TL.toStrict . TB.toLazyText -------------------------------------------------------------------------------
README.md view
@@ -15,12 +15,6 @@ GTK+2 needs to be installed for those binaries to work. -On OS X, [`gtk-mac-integration`](https://github.com/jralls/gtk-mac-integration) also needs to be installed:--```sh-brew install gtk+ gtk-mac-integration-```- On Windows, the [MSYS2](http://www.msys2.org) is the recommended way to install GTK+2. In MSYS2 MINGW64 shell: ```sh@@ -56,10 +50,10 @@ ### OS X -GTK+, gtk-mac-integration and GCC 9 are required:+GTK+ and GCC 9 are required: ```sh-brew install gtk+ gtk-mac-integration gcc@9+brew install gtk+ gcc@9 ``` Then you can build threadscope using cabal:
threadscope.cabal view
@@ -1,5 +1,5 @@ Name: threadscope-Version: 0.2.12+Version: 0.2.13 Category: Development, Profiling, Trace Synopsis: A graphical tool for profiling parallel Haskell programs. Description: ThreadScope is a graphical viewer for thread profile@@ -35,6 +35,7 @@ Data-files: threadscope.ui, threadscope.png Extra-source-files: include/windows_cconv.h README.md+ CHANGELOG.md Tested-with: GHC == 8.2.2 GHC == 8.4.4 GHC == 8.6.5@@ -55,11 +56,11 @@ array < 0.6, mtl < 2.3, filepath < 1.5,- ghc-events >= 0.5 && < 0.13,+ ghc-events >= 0.13 && < 0.14, containers >= 0.2 && < 0.7, deepseq >= 1.1, text < 1.3,- time >= 1.1 && < 1.10,+ time >= 1.1 && < 1.11, bytestring < 0.11, file-embed < 0.1, template-haskell < 2.16,