diff --git a/GUI/App.hs b/GUI/App.hs --- a/GUI/App.hs +++ b/GUI/App.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} ------------------------------------------------------------------------------- -- | Module : GUI.App @@ -12,6 +13,7 @@ #if defined(darwin_HOST_OS) import qualified Graphics.UI.Gtk as Gtk import qualified Graphics.UI.Gtk.OSX as OSX +import GUI.DataFiles (loadLogo) #endif ------------------------------------------------------------------------------- @@ -25,6 +27,8 @@ app <- OSX.applicationNew menuBar <- Gtk.menuBarNew OSX.applicationSetMenuBar app menuBar + logo <- $loadLogo + OSX.applicationSetDockIconPixbuf app (Just logo) OSX.applicationReady app #else diff --git a/GUI/DataFiles.hs b/GUI/DataFiles.hs new file mode 100644 --- /dev/null +++ b/GUI/DataFiles.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE TemplateHaskell #-} +module GUI.DataFiles + ( ui + , loadLogo + ) where +import System.IO + +import Data.FileEmbed +import Graphics.UI.Gtk (Pixbuf, pixbufNewFromFile) +import Language.Haskell.TH +import System.IO.Temp +import qualified Data.ByteString as B +import qualified Data.Text.Encoding as TE + +uiFile :: FilePath +uiFile = "threadscope.ui" + +logoFile :: FilePath +logoFile = "threadscope.png" + +-- | Textual representaion of the UI file +ui :: Q Exp +ui = [| TE.decodeUtf8 $(makeRelativeToProject uiFile >>= embedFile) |] + +renderLogo :: B.ByteString -> IO Pixbuf +renderLogo bytes = + withSystemTempFile logoFile $ \path h -> do + B.hPut h bytes + hClose h + pixbufNewFromFile path + +-- | Load the logo file as a 'Pixbuf'. +loadLogo :: Q Exp +loadLogo = [| renderLogo $(makeRelativeToProject logoFile >>= embedFile) |] diff --git a/GUI/Dialogs.hs b/GUI/Dialogs.hs --- a/GUI/Dialogs.hs +++ b/GUI/Dialogs.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} module GUI.Dialogs where -import Paths_threadscope (getDataFileName, version) +import GUI.DataFiles (loadLogo) +import Paths_threadscope (version) import Graphics.UI.Gtk @@ -13,8 +15,7 @@ aboutDialog :: WindowClass window => window -> IO () aboutDialog parent = do dialog <- aboutDialogNew - logoPath <- getDataFileName "threadscope.png" - logo <- pixbufNewFromFile logoPath + logo <- $loadLogo set dialog [ aboutDialogName := "ThreadScope", aboutDialogVersion := showVersion version, diff --git a/GUI/GtkExtras.hs b/GUI/GtkExtras.hs --- a/GUI/GtkExtras.hs +++ b/GUI/GtkExtras.hs @@ -20,6 +20,8 @@ import Control.Monad #endif +#include "windows_cconv.h" + waitGUI :: IO () waitGUI = do resultVar <- newEmptyMVar @@ -94,7 +96,7 @@ 1 -- SW_SHOWNORMAL return True -foreign import ccall unsafe "shlobj.h ShellExecuteA" +foreign import WINDOWS_CCONV unsafe "shlobj.h ShellExecuteA" c_ShellExecuteA :: Ptr () -- HWND hwnd -> CString -- LPCTSTR lpOperation -> CString -- LPCTSTR lpFile diff --git a/GUI/KeyView.hs b/GUI/KeyView.hs --- a/GUI/KeyView.hs +++ b/GUI/KeyView.hs @@ -63,6 +63,8 @@ "Indicates a period of time spent running Haskell code (not GC, not blocked/idle)") , ("GC", KDuration, gcColour, "Indicates a period of time spent by the RTS performing garbage collection (GC)") + , ("GC waiting", KDuration, gcWaitColour, + "Indicates a period of time spent by the RTS waiting to initiate or finish garbage collection (GC)") , ("create thread", KEvent, createThreadColour, "Indicates a new Haskell thread has been created") , ("seq GC req", KEvent, seqGCReqColour, diff --git a/GUI/Main.hs b/GUI/Main.hs --- a/GUI/Main.hs +++ b/GUI/Main.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} module GUI.Main (runGUI) where -- Imports for GTK @@ -16,13 +17,12 @@ import Data.Array import Data.Maybe -import Paths_threadscope - -- Imports for ThreadScope import qualified GUI.App as App import qualified GUI.MainWindow as MainWindow import GUI.Types import Events.HECs hiding (Event) +import GUI.DataFiles (ui) import GUI.Dialogs import Events.ReadEvents import GUI.EventsView @@ -117,7 +117,7 @@ constructUI = failOnGError $ do builder <- Gtk.builderNew - Gtk.builderAddFromFile builder =<< getDataFileName "threadscope.ui" + Gtk.builderAddFromString builder $ui eventQueue <- Chan.newChan let post = postEvent eventQueue diff --git a/GUI/MainWindow.hs b/GUI/MainWindow.hs --- a/GUI/MainWindow.hs +++ b/GUI/MainWindow.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TemplateHaskell #-} module GUI.MainWindow ( MainWindow, mainWindowNew, @@ -10,12 +11,10 @@ ) where -import Paths_threadscope - --- Imports for GTK import Graphics.UI.Gtk as Gtk import qualified System.Glib.GObject as Glib +import GUI.DataFiles (loadLogo) ------------------------------------------------------------------------------- @@ -146,8 +145,8 @@ ------------------------------------------------------------------------ - logoPath <- getDataFileName "threadscope.png" - windowSetIconFromFile mainWindow logoPath + logo <- $loadLogo + set mainWindow [ windowIcon := Just logo ] ------------------------------------------------------------------------ -- Status bar functionality diff --git a/GUI/ViewerColours.hs b/GUI/ViewerColours.hs --- a/GUI/ViewerColours.hs +++ b/GUI/ViewerColours.hs @@ -18,11 +18,14 @@ gcColour :: Color gcColour = orange +gcWaitColour :: Color +gcWaitColour = lightOrange + gcStartColour, gcWorkColour, gcIdleColour, gcEndColour :: Color -gcStartColour = orange +gcStartColour = lightOrange gcWorkColour = orange -gcIdleColour = white -gcEndColour = orange +gcIdleColour = lightOrange +gcEndColour = lightOrange createThreadColour :: Color createThreadColour = lightBlue @@ -108,6 +111,9 @@ orange :: Color orange = Color 0xE000 0x7000 0x0000 -- orange + +lightOrange :: Color +lightOrange = Color 0xE000 0xD000 0xB000 -- orange profileBackground :: Color profileBackground = Color 0xFFFF 0xFFFF 0xFFFF diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,79 @@ +# ThreadScope +[![Hackage](https://img.shields.io/hackage/v/threadscope.svg)](https://hackage.haskell.org/package/threadscope) +[![Hackage-Deps](https://img.shields.io/hackage-deps/v/threadscope.svg)](http://packdeps.haskellers.com/feed?needle=threadscope) +[![Build Status](https://travis-ci.org/haskell/ThreadScope.svg?branch=master)](https://travis-ci.org/haskell/ThreadScope) +[![Build status](https://ci.appveyor.com/api/projects/status/tiwkb7k6p38dde03/branch/master?svg=true)](https://ci.appveyor.com/project/maoe/threadscope-44t6e/branch/master) + +## Using pre-built binaries + +Currently [pre-built binaries](https://github.com/haskell/ThreadScope/releases) for the following platforms are provided: + +* Ubuntu Trusty (64-bit) +* OS X +* Windows (x64) + +GTK+2 needs to be installed for those binaries to work. On OS X, `gtk-mac-integration` also needs to be installed. + +## Building from source + +### Linux + +GTK+2 is required to be installed. On Ubuntu-like systems: + +```sh +sudo apt install libgtk2.0-dev +``` + +Then you can build threadscope using cabal: +```sh +cabal new-build +``` + +Or using stack: +```sh +stack setup +stack install +``` + +### OS X + +GTK+ and gtk-mac-integration are required. + +```sh +brew install gtk+ gtk-mac-integration +``` + +Then you can build threadscope using cabal: +```sh +cabal new-build --constraint="gtk +have-quartz-gtk" +``` + +Or using stack: +```sh +stack setup +stack install --flag gtk:have-quartz-gtk +``` + +### Windows + +stack is the recommended tool to build threadscope on Windows. + +CAVEAT: Currently gtk2 needs to be installed twice: one for stack's MSYS2 environment and another for local MSYS2 environment. + +In command prompt: +```sh +stack setup +stack exec -- pacman --needed -Sy bash pacman pacman-mirrors msys2-runtime msys2-runtime-devel +stack exec -- pacman -Syu +stack exec -- pacman -Syuu +stack exec -- pacman -S base-devel mingw-w64-x86_64-pkg-config mingw-w64-x86_64-toolchain mingw-w64-x86_64-gtk2 +stack install +``` + +Then in MSYS2 MINGW64 shell: +```sh +pacman -S $MINGW_PACKAGE_PREFIX-gtk2 +echo 'export PATH=$APPDATA/local/bin:$PATH' >> .profile +source .profile +threadscope +``` diff --git a/include/windows_cconv.h b/include/windows_cconv.h new file mode 100644 --- /dev/null +++ b/include/windows_cconv.h @@ -0,0 +1,12 @@ +#ifndef __WINDOWS_CCONV_H +#define __WINDOWS_CCONV_H + +#if defined(i386_HOST_ARCH) +# define WINDOWS_CCONV stdcall +#elif defined(x86_64_HOST_ARCH) +# define WINDOWS_CCONV ccall +#else +# error Unknown mingw32 arch +#endif + +#endif diff --git a/threadscope.cabal b/threadscope.cabal --- a/threadscope.cabal +++ b/threadscope.cabal @@ -1,5 +1,5 @@ Name: threadscope -Version: 0.2.8 +Version: 0.2.9 Category: Development, Profiling, Trace Synopsis: A graphical tool for profiling parallel Haskell programs. Description: ThreadScope is a graphical viewer for thread profile @@ -33,6 +33,8 @@ Build-Type: Simple Cabal-version: >= 1.6 Data-files: threadscope.ui, threadscope.png +Extra-source-files: include/windows_cconv.h + README.md Tested-with: GHC == 7.6.3, GHC == 7.8.3, GHC == 7.10.2, @@ -58,10 +60,15 @@ containers >= 0.2 && < 0.6, deepseq >= 1.1, text < 1.3, - time >= 1.1 && < 1.9 + time >= 1.1 && < 1.9, + bytestring < 0.11, + file-embed < 0.1, + template-haskell < 2.13, + temporary >= 1.1 && < 1.3 if os(osx) - build-depends: gtk-mac-integration + build-depends: gtk-mac-integration < 0.4 + include-dirs: include Extensions: RecordWildCards, NamedFieldPuns, BangPatterns, PatternGuards Other-Modules: Events.HECs, Events.EventDuration, @@ -74,6 +81,7 @@ GUI.Main, GUI.MainWindow, GUI.EventsView, + GUI.DataFiles, GUI.Dialogs, GUI.SaveAs, GUI.Timeline,