diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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 diff --git a/Events/HECs.hs b/Events/HECs.hs --- a/Events/HECs.hs +++ b/Events/HECs.hs @@ -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) ] diff --git a/Events/TestEvents.hs b/Events/TestEvents.hs --- a/Events/TestEvents.hs +++ b/Events/TestEvents.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Events.TestEvents (testTrace) where diff --git a/GUI/BookmarkView.hs b/GUI/BookmarkView.hs --- a/GUI/BookmarkView.hs +++ b/GUI/BookmarkView.hs @@ -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) diff --git a/GUI/EventsView.hs b/GUI/EventsView.hs --- a/GUI/EventsView.hs +++ b/GUI/EventsView.hs @@ -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 ------------------------------------------------------------------------------- diff --git a/GUI/Main.hs b/GUI/Main.hs --- a/GUI/Main.hs +++ b/GUI/Main.hs @@ -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 diff --git a/GUI/StartupInfoView.hs b/GUI/StartupInfoView.hs --- a/GUI/StartupInfoView.hs +++ b/GUI/StartupInfoView.hs @@ -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 diff --git a/GUI/Timeline/HEC.hs b/GUI/Timeline/HEC.hs --- a/GUI/Timeline/HEC.hs +++ b/GUI/Timeline/HEC.hs @@ -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 ------------------------------------------------------------------------------- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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: diff --git a/threadscope.cabal b/threadscope.cabal --- a/threadscope.cabal +++ b/threadscope.cabal @@ -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,