hp2any-graph 0.5.2 → 0.5.3
raw patch · 6 files changed
+33/−31 lines, 6 filesdep ~parseargsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: parseargs
API changes (from Hackage documentation)
Files
- CHANGES +4/−0
- hp2any-graph.cabal +5/−7
- src/Graph.hs +10/−10
- src/HandleArgs.hs +4/−4
- src/Profiling/Heap/OpenGL.hs +2/−2
- src/Relay.hs +8/−8
CHANGES view
@@ -1,3 +1,7 @@+0.5.3 - 110413+* updated for the latest parseargs+* cleaned up warnings+ 0.5.2 - 091121 * updated for the latest OpenGL
hp2any-graph.cabal view
@@ -1,5 +1,5 @@ Name: hp2any-graph-Version: 0.5.2+Version: 0.5.3 Cabal-Version: >= 1.2 Synopsis: Real-time heap graphing utility and profile stream server with a reusable graphing module. Category: profiling, development, utils@@ -12,8 +12,8 @@ as well in the form of a library module. Author: Patai Gergely-Maintainer: Patai Gergely (patai@iit.bme.hu)-Copyright: (c) 2009, Patai Gergely+Maintainer: Patai Gergely (patai.gergely@gmail.com)+Copyright: (c) 2009-2011, Patai Gergely Homepage: http://www.haskell.org/haskellwiki/Hp2any License: BSD3 License-File: LICENSE@@ -33,19 +33,17 @@ Profiling.Heap.OpenGL Executable hp2any-graph- Executable: hp2any-graph HS-Source-Dirs: src Main-IS: Graph.hs GHC-Options: -Wall -O2 Extra-Libraries: glut Build-Depends: base >= 4 && < 5, process, directory, filepath, containers,- bytestring, hp2any-core, parseargs, network,+ bytestring, hp2any-core, parseargs >= 0.1.3.1, network, OpenGL, GLUT Executable hp2any-relay- Executable: hp2any-relay HS-Source-Dirs: src Main-IS: Relay.hs Build-Depends: base >= 4 && < 5, process, directory, filepath, containers,- bytestring, hp2any-core, parseargs, network+ bytestring, hp2any-core, parseargs >= 0.1.3.1, network GHC-Options: -Wall -O2
src/Graph.hs view
@@ -21,7 +21,7 @@ import Control.Applicative import Control.Concurrent-import Control.Concurrent.MVar+--import Control.Concurrent.MVar import Control.Monad import Control.Monad.Fix --import qualified Data.ByteString.Char8 as S@@ -33,13 +33,13 @@ import Foreign.Storable --import Graphics.UI.GLFW import Graphics.UI.GLUT-import Graphics.Rendering.OpenGL hiding (Arg)+--import Graphics.Rendering.OpenGL hiding (Arg) import Network import Profiling.Heap.OpenGL import Profiling.Heap.Read import Profiling.Heap.Process import Profiling.Heap.Types-import System.IO+--import System.IO import HandleArgs @@ -71,10 +71,10 @@ main = withSocketsDo $ do profInfo <- graphArgs - initialize "hp2any-graph" []+ _ <- initialize "hp2any-graph" [] initialDisplayMode $= [RGBMode, DoubleBuffered] initialWindowSize $= Size 800 600- createWindow "hp2any live graph"+ _ <- createWindow "hp2any live graph" clearColor $= Color4 1 1 1 1 lineWidth $= 4@@ -143,9 +143,9 @@ profileCallback procData (putMVar profData) >>= \cbres -> case cbres of Just (stop,_) -> do closeCallback $== stop- + -- Looping as long as the other process is running.- forkIO $ fix $ \consume -> do+ _ <- forkIO $ fix $ \consume -> do prof <- takeMVar profData keepGoing <- glProtect $ accumGraph graphData prof when keepGoing consume@@ -155,7 +155,7 @@ Nothing -> putStrLn "Error starting profile reader thread. Did you enable heap profiling?" -- RGB values under the mouse cursor.-hoverColour (Position x y) = allocaBytes 4 $ \colData -> do +hoverColour (Position x y) = allocaBytes 4 $ \colData -> do Size _ h <- get windowSize readPixels (Position x (fromIntegral h-y)) (Size 1 1) (PixelData RGBA UnsignedByte colData) r <- peekElemOff colData 0@@ -192,12 +192,12 @@ renderGraph (uisGraphMode uis) graph let magn = 1- + loadIdentity Size w h <- get windowSize scale2 (magn/fromIntegral w) (magn/fromIntegral h) translate2 0 (fromIntegral h/magn-16)- + color3 0 0 0 currentRasterPosition $= Vertex4 0 0 0 1 renderString Fixed8By13 (fromMaybe "" (IM.lookup (uisCcid uis) (graphNames graph)))
src/HandleArgs.hs view
@@ -25,7 +25,7 @@ return (exec,dir,argsRest args) graphArgs = do- args <- parseArgsIO ArgsTrailing+ args <- parseArgsIO (ArgsTrailing "rest") [ Arg Exec (Just 'e') (Just "exec") (argDataOptional "executable" ArgtypeString) "Executable to profile."@@ -36,7 +36,7 @@ (argDataOptional "address:port" ArgtypeString) "Server to connect to." ]- + let port = getArgString args Port (exec,dir,params) <- commonArgs args @@ -56,7 +56,7 @@ return retval relayArgs = do- args <- parseArgsIO ArgsTrailing+ args <- parseArgsIO (ArgsTrailing "rest") [ Arg Exec (Just 'e') (Just "exec") (argDataRequired "executable" ArgtypeString) "Executable to profile."@@ -67,7 +67,7 @@ (argDataRequired "portnum" ArgtypeString) "Number of server port to listen on." ]- + let Just port = getArgString args Port (exec,dir,params) <- commonArgs args
src/Profiling/Heap/OpenGL.hs view
@@ -13,7 +13,7 @@ In other words, these functions fill the unit square at the origin. -} -module Profiling.Heap.OpenGL +module Profiling.Heap.OpenGL ( colours , backgroundColour , otherColour@@ -39,7 +39,7 @@ import qualified Data.IntMap as IM import Data.List import Graphics.Rendering.OpenGL hiding (samples)-import Graphics.Rendering.OpenGL.GL.DisplayLists+--import Graphics.Rendering.OpenGL.GL.DisplayLists import Profiling.Heap.Types {-| Two heap profile samples which contain the exact same cost centres
src/Relay.hs view
@@ -1,8 +1,8 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} import Control.Concurrent-import Control.Concurrent.Chan-import Control.Concurrent.MVar+--import Control.Concurrent.Chan+--import Control.Concurrent.MVar import Control.Monad import Control.Monad.Fix import qualified Data.IntMap as IM@@ -22,7 +22,7 @@ (portNum,exec,dir,params) <- relayArgs let procData = processToProfile exec dir params []- port = PortNumber $ fromIntegral portNum + port = PortNumber $ fromIntegral portNum profChan <- newChan stopServer <- newEmptyMVar@@ -33,7 +33,7 @@ writeChan profChan p -- Cleaning up the master channel that's not read by -- anyone.- readChan profChan+ _ <- readChan profChan case p of SinkId ccid ccname -> modifyIORef names (IM.insert ccid ccname)@@ -46,18 +46,18 @@ -- A rather lazy way of avoiding the need to maintain an explicit -- client list and perform additional synchronisation... ownChan <- dupChan profChan- + -- Start by sending the currently known name mapping. ccmap <- readIORef names mapM_ (sendMsg chdl . putStream . uncurry SinkId) (IM.toList ccmap)- + -- Forward stream to the client. fix $ \sendLoop -> do prof <- readChan ownChan ok <- flip catch (const (return False)) $ do sendMsg chdl . putStream $ prof return (prof /= SinkStop)- + when ok sendLoop return ()@@ -74,5 +74,5 @@ -- There might be some ugly race conditions here, where clients might -- be left without a message before leaving the runServer subroutine.- waitForStop+ _ <- waitForStop killThread tid