timeplot 0.2.13 → 0.2.14
raw patch · 3 files changed
+43/−28 lines, 3 filesdep ~strptime
Dependency ranges changed: strptime
Files
- Graphics/Rendering/Chart/Event.hs +13/−3
- Tools/TimePlot.hs +28/−23
- timeplot.cabal +2/−2
Graphics/Rendering/Chart/Event.hs view
@@ -10,6 +10,7 @@ plot_event_long_linestyle, plot_event_pulse_linestyle, plot_event_track_linestyle,+ plot_event_label, ) where import qualified Graphics.Rendering.Cairo as C@@ -18,6 +19,7 @@ import Data.Colour.Names import Data.Accessor import Data.Accessor.Template+import Control.Monad data Event t e = LongEvent t t e -- ^ An event that has a beginning and an end | PulseEvent t e -- ^ A zero-length event@@ -37,7 +39,8 @@ -- | Fillstyle with which interiors of rectangles for long events will be filled plot_event_long_fillstyle_ :: e -> CairoFillStyle, -- | Linestyle with which the "track line" will be drawn- plot_event_track_linestyle_ :: CairoLineStyle+ plot_event_track_linestyle_ :: CairoLineStyle,+ plot_event_label_ :: e -> String } defaultPlotEvent = PlotEvent {@@ -46,7 +49,8 @@ plot_event_pulse_linestyle_ = const $ solidLine 2 (opaque red), plot_event_long_linestyle_ = const $ solidLine 1 (opaque black), plot_event_long_fillstyle_ = const $ solidFillStyle (opaque lightgray),- plot_event_track_linestyle_ = solidLine 1 (opaque black)+ plot_event_track_linestyle_ = solidLine 1 (opaque black),+ plot_event_label_ = const "" } instance ToPlot PlotEvent where@@ -67,7 +71,7 @@ framedRect ls r = setLineStyle ls >> strokePath (rectPath r) barHeight = 7-pulseHeight = 7+pulseHeight = 15 renderPlotEvent :: PlotEvent t e -> PointMapFn t e -> CRender () renderPlotEvent p pmap = do@@ -94,6 +98,12 @@ moveTo (Point x (y-pulseHeight/2)) lineTo (Point x (y+pulseHeight/2)) c $ C.stroke+ let label = plot_event_label_ p e+ when (not (null label)) $ do+ extents <- c $ C.textExtents label+ moveTo (Point x (y - pulseHeight/2 - C.textExtentsHeight extents - C.textExtentsYbearing extents - 1))+ setLineStyle $ solidLine 2 (opaque black)+ c $ C.showText label drawEventFrame (LongEvent t1 t2 e) = do let (Point x1 cy) = pmap (LValue t1, LValue e) let (Point x2 cy') = pmap (LValue t2, LValue e) -- Assume cy' == cy (pmap is coordinate-wise)
Tools/TimePlot.hs view
@@ -36,23 +36,23 @@ import Data.Colour import Data.Colour.Names -newtype Status = Status String deriving (Eq, Show, Ord)+data Status = Status {statusColor :: String, statusLabel :: String} deriving (Eq, Show, Ord) instance PlotValue Status where toValue = const 0- fromValue = const (Status "")+ fromValue = const (Status "" "") autoAxis = const unitStatusAxis unitStatusAxis :: AxisData Status unitStatusAxis = AxisData { axis_viewport_ = \(x0,x1) _ -> (x0+x1)/2,- axis_tropweiv_ = \_ _ -> Status "",- axis_ticks_ = [(Status "", 0)],- axis_labels_ = [[(Status "", "")]],+ axis_tropweiv_ = \_ _ -> Status "" "",+ axis_ticks_ = [(Status "" "", 0)],+ axis_labels_ = [[(Status "" "", "")]], axis_grid_ = [] } -data Edge = Rise | Fall | Pulse | SetTo Status deriving (Eq,Show)+data Edge = Rise | Fall | Pulse {pulseLabel :: String} | SetTo Status deriving (Eq,Show) data InEvent = InEdge Edge | InValue Double@@ -214,11 +214,17 @@ case c of '>' -> return (t, strict rest, InEdge Rise ) '<' -> return (t, strict rest, InEdge Fall )- '!' -> return (t, strict rest, InEdge Pulse)+ '!' -> do+ let (track, val') = B.break (==' ') rest+ if B.null val'+ then return (t, strict track, InEdge (Pulse ""))+ else do+ (_,val) <- B.uncons val'+ return (t, strict track, InEdge . Pulse . B.unpack $ val) '@' -> do let (track, val') = B.break (==' ') rest (_,val) <- B.uncons val'- return (t, strict track, InEdge . SetTo . Status . B.unpack $ val)+ return (t, strict track, InEdge $ SetTo (Status {statusColor = B.unpack $ val, statusLabel = ""})) '=' -> do let (track, val') = B.break (==' ') rest (_,val) <- B.uncons val'@@ -313,9 +319,12 @@ vs = M.keys $ M.fromList $ [(a,()) | (_,a) <- as] plotTrackEvent name es = layoutWithTitle (toPlot plot) name- where plot = plot_event_data ^= edges2events (edges es) $ - plot_event_long_fillstyle ^= toFillStyle $ defaultPlotEvent- toFillStyle (Status s) = solidFillStyle . opaque $ fromMaybe lightgray (readColourName s)+ where plot = plot_event_data ^= edges2events (edges es) $ + plot_event_long_fillstyle ^= toFillStyle $ + plot_event_label ^= toLabel $ + defaultPlotEvent+ toFillStyle s = solidFillStyle . opaque $ fromMaybe lightgray (readColourName (statusColor s))+ toLabel s = statusLabel s plotTrackQuantile name es qs bs = layoutWithTitle (plotBars plot) name where plot = plot_bars_values ^= toBars (byTimeBins (getQuantiles qs) bs t0 (values es)) $@@ -393,15 +402,10 @@ merge (l@(LongEvent t1 t2 _):ls) (p@(PulseEvent t _):ps) | t1<t = l:merge ls (p:ps) | True = p:merge (l:ls) ps- pulses = [PulseEvent t (Status "") | (t,Pulse) <- tes]- edges = [(t,e) | (t,e) <- tes, e /= Pulse]- longs = longs' (Status "") Nothing 0 (error "Unreachable") edges+ pulses = [PulseEvent t (Status {statusColor="", statusLabel=s}) | (t,Pulse s) <- tes]+ edges = [(t,e) | (t,e) <- tes, case e of { Pulse _ -> False; _ -> True } ]+ longs = longs' (Status "" "") Nothing 0 (error "Unreachable") edges where- -- arg 1: current status- -- arg 2: start time of bar or nothing- -- arg 3: bar height- -- arg 4: ???- -- arg 5: events longs' s _ 0 _ [] = [] longs' s (Just t0) _ t [] = [LongEvent t0 t s] longs' s Nothing 0 _ ((t,Rise):tes) = longs' s (Just t) 1 t tes@@ -421,11 +425,11 @@ gather nmax nopen npulse ((t,e):tes) (t1:t2:ts) | t<t1 = error "Times are not in ascending order" | t>=t2 = ((t1,t2),nmax):gather nopen nopen 0 ((t,e):tes) (t2:ts)- gather nmax nopen npulse ((t,Rise ):tes) (t1:t2:ts)+ gather nmax nopen npulse ((t,Rise ):tes) (t1:t2:ts) = gather (nmax `max` (nopen+npulse+1)) (nopen+1) npulse tes (t1:t2:ts)- gather nmax nopen npulse ((t,Fall ):tes) (t1:t2:ts)+ gather nmax nopen npulse ((t,Fall ):tes) (t1:t2:ts) = gather nmax (nopen-1) npulse tes (t1:t2:ts)- gather nmax nopen npulse ((t,Pulse):tes) (t1:t2:ts)+ gather nmax nopen npulse ((t,Pulse _):tes) (t1:t2:ts) = gather (nmax `max` (nopen+npulse+1)) nopen (npulse+1) tes (t1:t2:ts) gather nmax nopen npulse ((t,SetTo s):tes) (t1:t2:ts) = gather nmax nopen npulse tes (t1:t2:ts)@@ -522,13 +526,14 @@ "1234 >A - at time 1234, activity A has begun", "1234 <A - at time 1234, activity A has ended", "1234 !B - at time 1234, pulse event B has occured",+ "1234 !B TEXT - at time 1234, pulse event B has occured with label TEXT", "1234 @B COLOR - at time 1234, the status of B became such that it is appropriate to draw it with color COLOR :)", "1234 =C VAL - at time 1234, parameter C had numeric value VAL (for example, HTTP response time)", "1234 =D `EVENT - at time 1234, event EVENT occured in process D (for example, HTTP response code)", "It is assumed that many events of the same kind may occur at once.", "Diagram kinds:", " 'none' - do not plot this track",- " 'event' is for event diagrams: activities are drawn like --[===]--- , pulse events like --|--",+ " 'event' is for event diagrams: activities are drawn like --[===]--- , pulse events like --|-- with a label over '|'", " 'duration XXXX' - plot any kind of diagram over the *durations* of events on a track (delimited by > ... <)", " for example 'duration quantile 300 0.25,0.5,0.75' will plot these quantiles of durations of the events.", " This is useful where your log looks like 'Started processing' ... 'Finished processing': you can plot",
timeplot.cabal view
@@ -1,5 +1,5 @@ Name: timeplot-Version: 0.2.13+Version: 0.2.14 License: BSD3 License-file: LICENSE Copyright: Eugene Kirpichov, 2009@@ -35,7 +35,7 @@ if flag(gtk) cpp-options: -DHAVE_GTK=1 - Build-Depends: Chart >= 0.14, cairo, bytestring, bytestring-lexing, strptime >= 0.1.5, time, + Build-Depends: Chart >= 0.14, cairo, bytestring, bytestring-lexing, strptime >= 0.1.7, time, containers, colour, data-accessor == 0.2.*, data-accessor-template >= 0.2.1.1 && < 0.3, haskell98, regex-tdfa Main-Is: Tools/TimePlot.hs