├── .gitignore ├── .travis.yml ├── Graphics └── Rendering │ └── Chart │ └── Event.hs ├── LICENSE ├── README ├── Setup.hs ├── Tools ├── TimePlot.hs └── TimePlot │ ├── Conf.hs │ ├── Incremental.hs │ ├── Plots.hs │ ├── Render.hs │ ├── Source.hs │ └── Types.hs ├── stack.yaml ├── timeplot.cabal └── tutorial-data ├── README ├── commit.png ├── commit.trace └── tplot-tutorial.log /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | 3 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # Based on http://docs.haskellstack.org/en/stable/travis_ci.html 2 | # and http://docs.haskellstack.org/en/stable/GUIDE.html#travis-with-caching 3 | sudo: false 4 | 5 | # Caching so the next build will be fast too. 6 | cache: 7 | directories: 8 | - $HOME/.stack 9 | 10 | # Choose a lightweight base image; we provide our own build tools. 11 | language: c 12 | 13 | # GHC depends on GMP. You can add other dependencies here as well. 14 | addons: 15 | apt: 16 | packages: 17 | - libgmp-dev 18 | - libcairo2 19 | - libcairo2-dev 20 | 21 | before_install: 22 | # Download and unpack the stack executable 23 | - mkdir -p ~/.local/bin 24 | - export PATH=$HOME/.local/bin:$PATH 25 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 26 | 27 | # --no-terminal works around some quirks in Travis's terminal implementation. 28 | script: 29 | - stack $ARGS --no-terminal --install-ghc install alex happy 30 | - stack $ARGS --no-terminal --install-ghc install gtk2hs-buildtools 31 | - stack $ARGS --no-terminal --install-ghc build 32 | 33 | notifications: 34 | email: true 35 | 36 | -------------------------------------------------------------------------------- /Graphics/Rendering/Chart/Event.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE CPP #-} 3 | module Graphics.Rendering.Chart.Event ( 4 | PlotEvent(..), 5 | Event(..), 6 | 7 | eventStart, 8 | eventEnd, 9 | 10 | plot_event_title, 11 | plot_event_data, 12 | plot_event_long_fillstyle, 13 | plot_event_long_linestyle, 14 | plot_event_pulse_linestyle, 15 | plot_event_track_linestyle, 16 | plot_event_label, 17 | ) where 18 | 19 | import Control.Lens 20 | import Graphics.Rendering.Chart 21 | import Data.Colour 22 | import Data.Colour.Names 23 | import Data.Default 24 | import Control.Monad 25 | 26 | #if ! MIN_VERSION_Chart(1,7,0) 27 | -- legacy map for Chart<1.7 28 | # define BackendProgram ChartBackend 29 | #endif 30 | 31 | data Event t e = LongEvent (t,Bool) (t,Bool) e -- ^ An event that has a beginning and an end. 32 | -- True = "known explicitly", False = "implicit" (e.g. imposed by axis bounds) 33 | | PulseEvent t e -- ^ A zero-length event 34 | deriving (Show) 35 | 36 | eventStart :: Event t e -> t 37 | eventStart (LongEvent (t0,_) (_,_) _) = t0 38 | eventStart (PulseEvent t _) = t 39 | 40 | eventEnd :: Event t e -> t 41 | eventEnd (LongEvent (_,_) (t1,_) _) = t1 42 | eventEnd (PulseEvent t _) = t 43 | 44 | -- | A chart that depict events. 45 | -- There are two kinds of events: long and impulse events. A long event 46 | -- is drawn like "--[=====]---" and has a beginning and ending moment, and 47 | -- an impulse event is drawn like "---|----" and has an occurence moment. 48 | data PlotEvent t e = PlotEvent { 49 | _plot_event_title :: String, 50 | _plot_event_data :: [Event t e], 51 | -- | Linestyle with which marks for pulse events will be drawn 52 | _plot_event_pulse_linestyle :: e -> LineStyle, 53 | -- | Linestyle with which borders of rectangles for long events will be drawn 54 | _plot_event_long_linestyle :: e -> LineStyle, 55 | -- | Fillstyle with which interiors of rectangles for long events will be filled 56 | _plot_event_long_fillstyle :: e -> FillStyle, 57 | -- | Linestyle with which the "track line" will be drawn 58 | _plot_event_track_linestyle :: LineStyle, 59 | _plot_event_label :: e -> String 60 | } 61 | makeLenses ''PlotEvent 62 | 63 | instance Default (PlotEvent t e) where 64 | def = PlotEvent { 65 | _plot_event_title = "", 66 | _plot_event_data = [], 67 | _plot_event_pulse_linestyle = const $ solidLine 2 (opaque red), 68 | _plot_event_long_linestyle = const $ solidLine 1 (opaque black), 69 | _plot_event_long_fillstyle = const $ solidFillStyle (opaque lightgray), 70 | _plot_event_track_linestyle = solidLine 1 (opaque black), 71 | _plot_event_label = const "" 72 | } 73 | 74 | instance ToPlot PlotEvent where 75 | toPlot p = Plot { 76 | _plot_render = renderPlotEvent p, 77 | _plot_legend = [(_plot_event_title p, renderPlotLegendEvent p)], 78 | _plot_all_points = plotAllPointsEvent p 79 | } 80 | 81 | renderPlotLegendEvent :: PlotEvent t e -> Rect -> BackendProgram () 82 | renderPlotLegendEvent p r = return () 83 | 84 | 85 | filledRect :: FillStyle -> Rect -> BackendProgram () 86 | filledRect fs r = withFillStyle fs $ fillPath (rectPath r) 87 | 88 | framedRect :: LineStyle -> Rect -> BackendProgram () 89 | framedRect ls r = withLineStyle ls $ strokePath (rectPath r) 90 | 91 | barHeight = 7 92 | pulseHeight = 15 93 | 94 | renderPlotEvent :: PlotEvent t e -> PointMapFn t e -> BackendProgram () 95 | renderPlotEvent p pmap = do 96 | withLineStyle (p ^. plot_event_track_linestyle) $ do 97 | strokePointPath [Point x0 cy, Point x1 cy] 98 | mapM_ drawEventFill (p ^. plot_event_data) 99 | mapM_ drawEventFrame (p ^. plot_event_data) 100 | where 101 | (Point x0 y0) = pmap (LMin,LMin) 102 | (Point x1 y1) = pmap (LMax,LMax) 103 | (cx,cy) = ((x0+x1)/2, (y0+y1)/2) 104 | 105 | drawEventFill (PulseEvent t e) = return () 106 | drawEventFill (LongEvent (t1,_) (t2,_) e) = do 107 | let (Point x1 cy) = pmap (LValue t1, LValue e) 108 | let (Point x2 cy') = pmap (LValue t2, LValue e) -- Assume cy' == cy (pmap is coordinate-wise) 109 | filledRect (p ^. plot_event_long_fillstyle $ e) $ Rect 110 | (Point x1 (cy-barHeight/2)) (Point x2 (cy+barHeight/2)) 111 | 112 | drawEventFrame (PulseEvent t e) = do 113 | withLineStyle (p ^. plot_event_pulse_linestyle $ e) $ do 114 | let (Point x y) = pmap (LValue t, LValue e) 115 | strokePointPath [Point x (y-pulseHeight/2), Point x (y+pulseHeight/2)] 116 | let label = p ^. plot_event_label $ e 117 | unless (null label) $ do 118 | textSize <- textSize label 119 | withLineStyle (solidLine 2 $ opaque black) $ do 120 | drawText (Point x (y - pulseHeight/2 - textSizeHeight textSize - textSizeYBearing textSize - 1)) label 121 | drawEventFrame (LongEvent (t1,_) (t2,_) e) = do 122 | let (Point x1 cy) = pmap (LValue t1, LValue e) 123 | let (Point x2 cy') = pmap (LValue t2, LValue e) -- Assume cy' == cy (pmap is coordinate-wise) 124 | framedRect (p ^. plot_event_long_linestyle $ e) $ Rect 125 | (Point x1 (cy-barHeight/2)) (Point x2 (cy+barHeight/2)) 126 | 127 | plotAllPointsEvent :: PlotEvent t e -> ([t], [e]) 128 | plotAllPointsEvent p = (concat ts, es) 129 | where 130 | decomp (PulseEvent t e) = ([t], e) 131 | decomp (LongEvent (t1,_) (t2,_) e) = ([t1,t2], e) 132 | (ts, es) = unzip $ p ^.. plot_event_data . traverse . to decomp 133 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2009, Eugene Kirpichov 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * The names of contributors may not be used to endorse or promote 18 | products derived from this software without specific prior 19 | written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | This tool, together with splot (http://github.com/jkff/splot), aims to make tasks of visualizing/analyzing system behavior based on log files into shell one-liners. 2 | 3 | See documentation, distributions etc. at http://jkff.info/software/timeplotters/ 4 | 5 | Also see hackage package: http://hackage.haskell.org/package/timeplot -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | module Main where 4 | 5 | import Distribution.Simple 6 | 7 | main :: IO () 8 | main = defaultMain 9 | -------------------------------------------------------------------------------- /Tools/TimePlot.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables, TypeFamilies, ParallelListComp, CPP, BangPatterns, TemplateHaskell #-} 2 | module Main where 3 | 4 | import Paths_timeplot (version) 5 | import Data.Version (showVersion) 6 | import Distribution.VcsRevision.Git 7 | import Language.Haskell.TH.Syntax 8 | 9 | import Control.Lens 10 | import Control.Monad 11 | import Data.Default 12 | import Data.List 13 | import Data.Ord 14 | import qualified Data.Map as M 15 | import qualified Data.ByteString.Char8 as S 16 | 17 | import System.Environment 18 | import System.Exit 19 | 20 | import Data.Time hiding (parseTime) 21 | 22 | import Graphics.Rendering.Chart 23 | import Graphics.Rendering.Chart.Backend.Cairo 24 | 25 | import Tools.TimePlot.Types 26 | import Tools.TimePlot.Conf 27 | import Tools.TimePlot.Source 28 | import Tools.TimePlot.Plots 29 | import Tools.TimePlot.Render 30 | import qualified Tools.TimePlot.Incremental as I 31 | 32 | -- Assume events are sorted. 33 | -- Pass 1: 34 | -- * Compute min/max times 35 | -- * Compute unique track names 36 | -- 37 | -- Then map track names to plotters (track types). 38 | -- 39 | -- Pass 2: 40 | -- * Generate plot data (one-pass multiplexed to tracks) 41 | -- 42 | makeChart :: (S.ByteString -> [(ChartKind LocalTime, S.ByteString)]) -> 43 | IO (ParseResult LocalTime) -> 44 | Maybe LocalTime -> Maybe LocalTime -> 45 | (LocalTime -> String -> String) -> 46 | IO (Renderable ()) 47 | makeChart chartKindF parseEvents minT maxT transformLabel = do 48 | ParseResult events unparseable <- parseEvents 49 | when (not (null unparseable)) $ do 50 | putStrLn $ "Unparseable lines found" ++ (if null (drop 10 unparseable) then ":" else " (showing first 10):") 51 | mapM_ (putStrLn . S.unpack) (take 10 unparseable) 52 | if null events 53 | then return emptyRenderable 54 | else do 55 | let dropLateEvents es = case maxT of Just t -> takeWhile (( es 56 | -- Pass 1: find out min/max time and final track names. 57 | let i2o t (KindNone, _) = [] 58 | i2o t (KindWithin mapName sk, suf) = [(S.append (mapName t) suf, sk)] 59 | i2o t (k, suf) = [(S.append t suf, k)] 60 | let i2oTracks t = concatMap (i2o t) (chartKindF t) 61 | let t0 = fst (head events) 62 | let (minTime, maxTime, outTracks) = foldl' 63 | (\(!mi,!ma,!ts) (t,e) -> (min t mi, max t ma, foldr (uncurry M.insert) ts (i2oTracks $ evt_track e))) 64 | (t0, t0, M.empty) 65 | (dropLateEvents events) 66 | 67 | let minOutTime = case minT of Just t -> t ; Nothing -> minTime 68 | let maxOutTime = case maxT of Just t -> t ; Nothing -> maxTime 69 | let transformLabels axis = axis & axis_labels %~ map (map (\(t, s) -> (t, transformLabel t s))) 70 | let commonTimeAxis = transformLabels $ autoAxis [minOutTime, maxOutTime] 71 | 72 | -- Pass 2 73 | events' <- (dropLateEvents . parsedData) `fmap` parseEvents 74 | let eventsToTracks = [(outTrack, (t,e)) | (t,e) <- events', (outTrack,_) <- i2oTracks (evt_track e)] 75 | 76 | let initPlot track = initGen (outTracks M.! track) (S.unpack track) minTime maxTime 77 | let plots = I.runStreamSummary (I.byKey initPlot) eventsToTracks 78 | 79 | -- Render 80 | return $ renderStackedLayouts $ 81 | slayouts_layouts .~ map (dataToPlot commonTimeAxis (minOutTime,maxOutTime)) (M.elems plots) $ 82 | def 83 | 84 | showHelp = mapM_ putStrLn [ "", 85 | "tplot - a tool for drawing timing diagrams.", 86 | " See http://www.haskell.org/haskellwiki/Timeplot", 87 | "Usage: tplot [-o OFILE] [-of {png|pdf|ps|svg}] [-or 640x480]", 88 | " -if IFILE [-tf TF] ", 89 | " [{+|-}k Pat1 '[+Suf1] Kind1' {+|-}k Pat2 '[+Suf2] Kind2' ...] [{+|-}dk '[+Suf] KindN']", 90 | " [-fromTime TIME] [-toTime TIME] [-baseTime TIME]", 91 | " --version - show version information", 92 | " --help - show this help", 93 | " -o OFILE - output file", 94 | " -of - output format (default: extension of -o)", 95 | " -or - output resolution (default 640x480)", 96 | " -if IFILE - input file; '-' means 'read from stdin'", 97 | " NOTE: for large datasets, use actual files, not stdin,", 98 | " as tplot can operate on them in streaming mode, which", 99 | " allows it to use a lot less memory and work on virtually", 100 | " unbounded datasets", 101 | " -tf TF - time format: -tf 'date PATTERN' means that times are dates in the format", 102 | " specified by PATTERN - see http://linux.die.net/man/3/strptime, ", 103 | " for example, -tf 'date [%Y-%m-%d %H:%M:%S]' parses dates like ", 104 | " '[2009-10-20 16:52:43]'.", 105 | " We also support %OS for fractional seconds (i.e. %OS will", 106 | " parse 12.4039 or 12,4039) and %^[+-][N]s for ten-powers ", 107 | " of seconds since epoch, for example %^-3s is ms since epoch.", 108 | " -tf elapsed means times are fractional seconds since an unknown moment.", 109 | " Default: 'date %Y-%m-%d %H:%M:%OS'", 110 | " {+|-}dk - set default diagram kind", 111 | " {+|-}k P K - set diagram kind for tracks matching regex P (in the format", 112 | " of regex-tdfa, which is at least POSIX-compliant and", 113 | " supports some GNU extensions) to K", 114 | " EXPLANATION:", 115 | " -k clauses are matched till first success, +k are all", 116 | " matched: a track is drawn acc. to all matching +k, to +dk", 117 | " AND ALSO to the first matching -k, or -dk if none of -k", 118 | " match", 119 | " EXPLANATION OF SUF:", 120 | " If '+Suf' is present (e.g. +k request '+frequency freq 60'),", 121 | " then '.Suf' is appended to the input track name while mapping it", 122 | " to the output track. This is so that a single input track can", 123 | " participate in many output tracks - tplot can have only one output", 124 | " track with a particular name, so you can't have one track named", 125 | " 'request' which draws 'freq 60' and another one for 'hist 60' - ", 126 | " you should use +k request '+frequency freq 60' +k request '+histogram hist 60'", 127 | " and you'll get output tracks 'request.frequency' and 'request.histogram'", 128 | " -fromTime - filter records whose time is >= this time", 129 | " (formatted according to -tf)", 130 | " -toTime - filter records whose time is < this time", 131 | " (formatted according to -tf)", 132 | " -baseTime - display time difference with this value instead of absolute time", 133 | " (formatted according to -tf)", 134 | "", 135 | "Input format: lines of the following form:", 136 | "1234 >A - at time 1234, activity A has begun", 137 | "1234 ... <), for example 'duration quantile", 153 | " 300 0.25,0.5,0.75' will plot these quantiles of durations of the", 154 | " events. This is useful where your log looks like 'Started processing'", 155 | " ... 'Finished processing': you can plot processing durations without", 156 | " computing them yourself. Very useful inside 'within'!", 157 | " If you use 'drop', then names of the original input tracks will be dropped", 158 | " before putting the events onto the output track, e.g. an event rtime.14e3ac1", 159 | " when used by 'within[.] duration drop dots', will be put onto the output track", 160 | " 'rtime', with input track 'rtime'. When used by 'within[.] duration dots',", 161 | " its input track will still be rtime.14e3ac1. The difference is whether", 162 | " the output of 'duration' appears to 'XXXX' as a single or multiple input tracks.", 163 | " E.g. if you're measuring durations of processing unique requests with rtime.REQID,", 164 | " then use 'drop'; if it's durations of processing at certain stages with rtime.STAGE", 165 | " then don't.", 166 | " 'within[C] XXXX' - draw plot XXXX over events grouped by their track's name ", 167 | " before separator C. For example, if you have processes", 168 | " named 'MACHINE-PID' (i.e. UNIT027-8532) say 'begin something' / ", 169 | " 'end something' and you're interested in the properties of per-machine", 170 | " durations, use within[-] duration dots; or if you've got jobs starting", 171 | " and finishing tasks on different machines, and you want to plot a diagram", 172 | " showing the number of utilized machines and how this number is composed of", 173 | " utilization by different jobs, make your trace say '>job-JOBID'...' customer, John), ", 178 | " group the events by supertrack and for each supertrack draw a graphical track", 179 | " using the plot type SOMETHING. It's up to SOMETHING to do something with these", 180 | " events, e.g. 'lines' will simply draw several line plots, one per subtrack.", 181 | " 'acount N' is for activity counts: a histogram is drawn with granularity", 182 | " of N time units, where the bin corresponding to [t..t+N) has value", 183 | " 'what was the average number of active events or impulses in that", 184 | " interval'. When used inside 'within', the histogram is a stacked one,", 185 | " with one vertical bar per subtrack in each bin.", 186 | " 'count N' is same as 'acount N' but scaled by the bin size, i.e. rather than ", 187 | " activity rate per time unit, it's activity count per time bin. ", 188 | " 'apercent N B' is for activity percentages of a basis: like 'acount N',", 189 | " but instead of X you get 100*X/B", 190 | " 'afreq N' is for activity frequencies: it's like acount, but relative", 191 | " rather than absolute - it only makes sense inside 'within', because", 192 | " otherwise it would just always show a filled one-coloured bar in every bin.", 193 | " 'freq N [TYPE]' is for event frequency histograms: a histogram of type", 194 | " TYPE (stacked or clustered, default clustered) is drawn for each time", 195 | " bin of size N, about the *frequency* of various ` events", 196 | " 'hist N [TYPE]' is for event count histograms: a histogram of type TYPE", 197 | " (stacked or clustered, default clustered) is drawn for each time bin", 198 | " of size N, about the *counts* of various ` events", 199 | " 'quantile N q1,q2,..' (example: quantile 100 0.25,0.5,0.75) - a bar chart", 200 | " of corresponding quantiles in time bins of size N", 201 | " 'binf N v1,v2,..' (example: binf 100 1,2,5,10) - a histogram of frequency", 202 | " of values falling into bins min..v1, v1..v2, .., v2..max in time bins", 203 | " of size N", 204 | " 'binh N v1,v2,..' (example: binf 100 1,2,5,10) - a histogram of counts of", 205 | " values falling into bins min..v1, v1..v2, .., v2..max in time bins of", 206 | " size N", 207 | " 'lines' - a simple line plot of numeric values. When used in 'within', ", 208 | " gives one plot per subtrack.", 209 | " 'dots' - a simple dot plot of numeric values. When used in 'within', ", 210 | " gives one plot per subtrack.", 211 | " 'dots ALPHA' - a simple dot plot of numeric values. When used in 'within', ", 212 | " gives one plot per subtrack. All dots are drawn with opacity ALPHA,", 213 | " where 0 means transparent and 1 means opaque. Useful when you're suffering", 214 | " from overplotting (dots overlapping each other too much)", 215 | " 'cumsum N [TYPE]' - a simple line plot of the running sum of the numeric values,", 216 | " over bins of size N - as if you plotted 'sum N', but sums are accumulated over time", 217 | " When used in 'within', produce 1 subplot per subtrack. TYPE can be: ", 218 | " 'overlayed' -> just lay the subplots over one another.", 219 | " 'stacked' -> add them up at each point to see how subtracks contribute", 220 | " to the total cumulative sum (default; only makes sense inside 'within')", 221 | " 'sum N [TYPE]' - a simple line plot of the sum of the numeric values in time", 222 | " bins of size N. N is measured in units or in seconds.", 223 | " When used in 'within', produce 1 subplot per subtrack. TYPE used in same ", 224 | " way as in cumsum." 225 | ] 226 | 227 | showGitVersion = $(do 228 | v <- qRunIO getRevision 229 | lift $ case v of 230 | Nothing -> "" 231 | Just (hash,True) -> hash ++ " (with local modifications)" 232 | Just (hash,False) -> hash) 233 | 234 | main = do 235 | args <- getArgs 236 | mainWithArgs args 237 | mainWithArgs args = do 238 | when (null args || args == ["--help"]) $ showHelp >> exitSuccess 239 | when (null args || args == ["--version"]) $ do 240 | putStrLn ("This is timeplot-" ++ showVersion version ++ " (git " ++ showGitVersion ++ ")") >> exitSuccess 241 | let !conf = readConf args 242 | let format = case outFormat conf of { 243 | OutPNG -> PNG 244 | ; OutPDF -> PDF 245 | ; OutPS -> PS 246 | ; OutSVG -> SVG 247 | } 248 | let render r w h f = renderableToFile (fo_size .~ (w, h) $ fo_format .~ format $ def) f r 249 | case conf of 250 | ConcreteConf { 251 | parseTime=parseTime, inFile=inFile, chartKindF=chartKindF, 252 | outFile=outFile, outResolution=outResolution, 253 | fromTime=fromTime, toTime=toTime, transformLabel=transformLabel } -> do 254 | source <- case inFile of 255 | "-" -> do 256 | putStrLn "Warning: working in non-streaming mode (for very large datasets, supply input from a file)" 257 | events <- readSource parseTime inFile 258 | return (return events) 259 | _ -> return (readSource parseTime inFile) 260 | chart <- makeChart chartKindF source fromTime toTime transformLabel 261 | let (w,h) = outResolution 262 | render chart w h outFile 263 | -------------------------------------------------------------------------------- /Tools/TimePlot/Conf.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP, FlexibleContexts#-} 2 | module Tools.TimePlot.Conf ( 3 | ConcreteConf(..), 4 | Conf, 5 | readConf 6 | ) where 7 | 8 | import Text.Regex.TDFA 9 | import Text.Regex.TDFA.ByteString 10 | import Data.Time hiding (parseTime) 11 | import Data.Time.Parse 12 | import Data.List 13 | import Graphics.Rendering.Chart 14 | import qualified Data.ByteString.Char8 as S 15 | import Data.ByteString.Lex.Fractional 16 | 17 | import Unsafe.Coerce 18 | 19 | import Tools.TimePlot.Types 20 | 21 | data ConcreteConf t = 22 | ConcreteConf { 23 | inFile :: !FilePath, 24 | parseTime :: !(S.ByteString -> Maybe (t, S.ByteString)), 25 | -- Input track -> (chart kind, suffix to append to track name for N:1 out:in mapping) 26 | chartKindF :: !(S.ByteString -> [(ChartKind t, S.ByteString)]), 27 | 28 | fromTime :: !(Maybe t), 29 | toTime :: !(Maybe t), 30 | transformLabel :: !(t -> String -> String), 31 | 32 | outFile :: !FilePath, 33 | outFormat :: !OutFormat, 34 | outResolution :: !(Int,Int) 35 | } 36 | 37 | type Conf = ConcreteConf LocalTime 38 | 39 | data KindChoiceOperator = Cut | Accumulate 40 | 41 | readConf :: [String] -> Conf 42 | readConf args = readConf' parseTime 43 | where 44 | pattern = case (words $ single "time format" "-tf" ("%Y-%m-%d %H:%M:%OS")) of 45 | "date":f -> S.pack (unwords f) 46 | f -> S.pack (unwords f) 47 | Just (ourBaseTime,_) = strptime "%Y-%m-%d %H:%M:%OS" "1900-01-01 00:00:00" 48 | {-# NOINLINE ourStrptime #-} 49 | ourStrptime :: S.ByteString -> Maybe (LocalTime, S.ByteString) 50 | ourStrptime = if pattern == S.pack "elapsed" 51 | then \s -> do 52 | (d, s') <- readSigned readDecimal s 53 | return (fromSeconds d ourBaseTime `add` ourBaseTime, s') 54 | else strptime pattern 55 | parseTime s = ourStrptime s 56 | 57 | int2double = fromIntegral :: Int -> Double 58 | single desc name def = case (getArg name 1 args) of 59 | [[r]] -> r 60 | [] -> def 61 | _ -> error $ "Single argument expected for: "++desc++" ("++name++")" 62 | 63 | readConf' :: (S.ByteString -> Maybe (LocalTime, S.ByteString)) -> ConcreteConf LocalTime 64 | readConf' parseTime = ConcreteConf {inFile=inFile, outFile=outFile, outFormat=outFormat, outResolution=outRes, 65 | chartKindF=chartKindF, parseTime=parseTime, fromTime=fromTime, toTime=toTime, 66 | transformLabel=transformLabel} 67 | where 68 | inFile = single "input file" "-if" (error "No input file (-if) specified") 69 | outFile = single "output file" "-o" (error "No output file (-o) specified") 70 | outFormat = maybe OutPNG id $ lookup (single "output format" "-of" (name2format outFile)) $ 71 | [("png",OutPNG), ("pdf",OutPDF), ("ps",OutPS), ("svg",OutSVG)] 72 | where 73 | name2format = reverse . takeWhile (/='.') . reverse 74 | outRes = parseRes $ single "output resolution" "-or" "640x480" 75 | where 76 | parseRes s = case break (=='x') s of (h,_:v) -> (read h,read v) 77 | forceList :: [a] -> () 78 | forceList = foldr seq () 79 | chartKindF = forceList [forceList plusKinds, forceList minusKinds, forceList defaultKindsPlus, defaultKindMinus `seq` ()] `seq` kindByRegex $ 80 | [(Cut, matches regex, parseKind0 (words kind)) | [regex,kind] <- getArg "-k" 2 args] ++ 81 | [(Accumulate, matches regex, parseKind0 (words kind)) | [regex,kind] <- getArg "+k" 2 args] 82 | where 83 | plusKinds = [parseKind0 (words kind) | [regex, kind] <- getArg "+k" 2 args] 84 | minusKinds = [parseKind0 (words kind) | [regex, kind] <- getArg "-k" 2 args] 85 | kindByRegex rks s = if null specifiedKinds then [defaultKindMinus] else specifiedKinds 86 | where 87 | specifiedKinds = defaultKindsPlus ++ 88 | [k | (Accumulate, p, k) <- rks, p s] ++ 89 | case [k | (Cut, p, k) <- rks, p s] of {k:_ -> [k]; _ -> []} 90 | matches regex = matchTest (makeRegexOpts defaultCompOpt (ExecOption {captureGroups = False}) regex) 91 | 92 | fromTime = fst `fmap` (parseTime . S.pack $ single "minimum time (inclusive)" "-fromTime" "") 93 | toTime = fst `fmap` (parseTime . S.pack $ single "maximum time (exclusive)" "-toTime" "") 94 | baseTime = if pattern == S.pack "elapsed" 95 | then Just ourBaseTime 96 | else (fst `fmap` (parseTime . S.pack $ single "base time" "-baseTime" "")) 97 | 98 | transformLabel t s = case baseTime of 99 | Nothing -> s 100 | Just bt -> showDelta t bt 101 | 102 | parseKind0 (('+':suffix):k) = (parseKind k, S.pack "." `S.append` S.pack suffix) 103 | parseKind0 k = (parseKind k, S.empty) 104 | 105 | parseKind :: [String] -> ChartKind LocalTime 106 | parseKind ["acount", n ] = KindACount {binSize=read n} 107 | parseKind ("acount":_) = error "acount requires a single numeric argument, bin size, e.g.: -dk 'acount 1'" 108 | parseKind ["count", n ] = KindCount {binSize=read n} 109 | parseKind ("count":_) = error "count requires a single numeric argument, bin size, e.g.: -dk 'count 1'" 110 | parseKind ["apercent",n,b] = KindAPercent {binSize=read n,baseCount=read b} 111 | parseKind ("apercent":_) = error "apercent requires two numeric arguments: bin size and base value, e.g.: -dk 'apercent 1 480'" 112 | parseKind ["afreq", n ] = KindAFreq {binSize=read n} 113 | parseKind ("afreq":_) = error "afreq requires a single numeric argument, bin size, e.g.: -dk 'afreq 1'" 114 | parseKind ["freq", n ] = KindFreq {binSize=read n,style=BarsStacked} 115 | parseKind ["freq", n,s] = KindFreq {binSize=read n,style=parseStyle s} 116 | parseKind ("freq":_) = error $ "freq requires a single numeric argument, bin size, e.g.: -dk 'freq 1', " ++ 117 | "or two arguments, e.g.: -dk 'freq 1 clustered'" 118 | parseKind ["hist", n ] = KindHistogram {binSize=read n,style=BarsStacked} 119 | parseKind ["hist", n,s] = KindHistogram {binSize=read n,style=parseStyle s} 120 | parseKind ("hist":_) = error $ "hist requires a single numeric argument, bin size, e.g.: -dk 'hist 1', " ++ 121 | "or two arguments, e.g.: -dk 'hist 1 clustered'" 122 | parseKind ["event" ] = KindEvent 123 | parseKind ("event":_) = error "event requires no arguments" 124 | parseKind ["quantile",b,q] = KindQuantile {binSize=read b, quantiles=read ("["++q++"]")} 125 | parseKind ("quantile":_) = error $ "quantile requres two arguments: bin size and comma-separated " ++ 126 | "(without spaces!) quantiles, e.g.: -dk 'quantile 1 0.5,0.75,0.9'" 127 | parseKind ["binf", b,q] = KindBinFreq {binSize=read b, delims =read ("["++q++"]")} 128 | parseKind ("binf":_) = error $ "binf requres two arguments: bin size and comma-separated " ++ 129 | "(without spaces!) threshold values, e.g.: -dk 'binf 1 10,50,100,200,500'" 130 | parseKind ["binh", b,q] = KindBinHist {binSize=read b, delims =read ("["++q++"]")} 131 | parseKind ("binh":_) = error $ "binh requres two arguments: bin size and comma-separated " ++ 132 | "(without spaces!) threshold values, e.g.: -dk 'binh 1 10,50,100,200,500'" 133 | parseKind ["lines" ] = KindLines 134 | parseKind ("lines":_) = error "lines requires no arguments" 135 | parseKind ["dots" ] = KindDots { alpha = 1 } 136 | parseKind ["dots", a ] = KindDots { alpha = read a } 137 | parseKind ("dots":_) = error "dots requires 0 or 1 arguments (the argument is alpha value: 0 = transparent, 1 = opaque, default 1)" 138 | parseKind ["cumsum", b ] = KindCumSum {binSize=read b, subtrackStyle=SumStacked} 139 | parseKind ["cumsum", b,s] = KindCumSum {binSize=read b, subtrackStyle=parseSubtrackStyle s} 140 | parseKind ("cumsum":_) = error $ "cumsum requires 1 or 2 arguments (bin size and subtrack style), e.g.: " ++ 141 | "-dk 'cumsum 10' or -dk 'cumsum 10 stacked'" 142 | parseKind ["sum", b ] = KindSum {binSize=read b, subtrackStyle=SumStacked} 143 | parseKind ["sum", b,s] = KindSum {binSize=read b, subtrackStyle=parseSubtrackStyle s} 144 | parseKind ("sum":_) = error $ "sum requires one or two arguments: bin size and optionally " ++ 145 | "subtrack style, e.g.: -dk 'sum 1' or -dk 'sum 1 stacked'" 146 | parseKind ("duration":"drop":ws) = KindDuration {subKind=parseKind ws, dropSubtrack=True} 147 | parseKind ("duration":ws) = KindDuration {subKind=parseKind ws, dropSubtrack=False} 148 | parseKind (('w':'i':'t':'h':'i':'n':'[':sep:"]"):ws) 149 | = KindWithin {subKind=parseKind ws, mapName = fst . S.break (==sep)} 150 | parseKind ["none" ] = KindNone 151 | parseKind ("none":_) = error "none requires no arguments" 152 | parseKind ["unspecified" ] = KindUnspecified 153 | parseKind ("unspecified":_)= error "unspecified requires no arguments" 154 | parseKind ws = error ("Unknown diagram kind " ++ unwords ws) 155 | 156 | defaultKindMinus = parseKind0 $ words $ single "default kind" "-dk" "unspecified" 157 | defaultKindsPlus = map (parseKind0 . words . head) $ getArg "+dk" 1 args 158 | 159 | parseStyle "stacked" = BarsStacked 160 | parseStyle "clustered" = BarsClustered 161 | 162 | parseSubtrackStyle "stacked" = SumStacked 163 | parseSubtrackStyle "overlayed" = SumOverlayed 164 | 165 | 166 | -- getArg "-a" 2 ["-b", "1", "-a", "2", "q", "r", "-c", "3", "-a", "x"] = 167 | -- [["2", "q"], ["x"]] 168 | getArg :: String -> Int -> [String] -> [[String]] 169 | getArg name arity args = [take arity as | (t:as) <- tails args, t==name] 170 | 171 | -------------------------------------------------------------------------------- /Tools/TimePlot/Incremental.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs, BangPatterns #-} 2 | module Tools.TimePlot.Incremental where 3 | 4 | import Data.Time 5 | import qualified Data.List as L 6 | import qualified Data.Map as M 7 | import Control.Applicative 8 | 9 | data StreamSummary a r where 10 | Summary :: { insert :: a -> StreamSummary a r, finalize :: r } -> StreamSummary a r 11 | 12 | instance Functor (StreamSummary a) where 13 | fmap f (Summary insert res) = Summary (fmap f . insert) (f res) 14 | 15 | instance Applicative (StreamSummary a) where 16 | pure r = Summary (\_ -> pure r) r 17 | (!fs) <*> (!xs) = Summary (\a -> insert fs a <*> insert xs a) (finalize fs $ finalize xs) 18 | 19 | runStreamSummary :: StreamSummary a r -> [a] -> r 20 | runStreamSummary !s [] = finalize s 21 | runStreamSummary !s (a:as) = runStreamSummary (insert s a) as 22 | 23 | stateful :: s -> (a -> s -> s) -> (s -> r) -> StreamSummary a r 24 | stateful init insert finalize = go init 25 | where 26 | go !s = Summary (\a -> go (insert a s)) (finalize s) 27 | 28 | filterMap :: (a -> Maybe b) -> StreamSummary b r -> StreamSummary a r 29 | filterMap p s@(Summary insert res) = Summary insert' res 30 | where 31 | insert' a = case p a of { Nothing -> filterMap p s ; Just b -> filterMap p (insert b) } 32 | 33 | mapInput :: (a -> b) -> StreamSummary b r -> StreamSummary a r 34 | mapInput f (Summary insert res) = Summary (mapInput f . insert . f) res 35 | 36 | collect :: StreamSummary a [a] 37 | collect = stateful [] (:) reverse 38 | 39 | byTimeBins :: (Ord t) => [t] -> StreamSummary (t,[a]) r -> StreamSummary (t,a) r 40 | byTimeBins ts s = stateful init' insert' finalize' 41 | where 42 | init' = (ts, [], s) 43 | insert' (t,a) (t1:t2:ts, curBin, !s) 44 | | t < t1 = error "Times are not in ascending order" 45 | | t < t2 = (t1:t2:ts, a:curBin, s) 46 | | True = insert' (t, a) (t2:ts, [], insert s (t1, reverse curBin)) 47 | finalize' (t1:t2:ts, curBin, s) = finalize (insert s (t1,reverse curBin)) 48 | 49 | 50 | byKey :: (Ord k) => (k -> StreamSummary v r) -> StreamSummary (k,v) (M.Map k r) 51 | byKey initByKey = stateful init' insert' finalize' 52 | where 53 | init' = M.empty 54 | insert' (k,v) m = case M.lookup k m of 55 | Nothing -> M.insert k (insert (initByKey k) v) m 56 | Just !s -> M.insert k (insert s v) m 57 | finalize' = fmap finalize 58 | -------------------------------------------------------------------------------- /Tools/TimePlot/Plots.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ParallelListComp, ScopedTypeVariables, BangPatterns, Rank2Types, TupleSections #-} 2 | module Tools.TimePlot.Plots ( 3 | initGen 4 | ) where 5 | 6 | import qualified Control.Monad.Trans.State.Strict as St 7 | import Control.Arrow 8 | import Control.Applicative 9 | import Data.List (foldl', sort) 10 | import Data.Maybe 11 | import qualified Data.Map as M 12 | import qualified Data.Map.Strict as MS 13 | import qualified Data.Set as Set 14 | import qualified Data.ByteString.Char8 as S 15 | 16 | import Data.Time 17 | 18 | import Graphics.Rendering.Chart 19 | import Graphics.Rendering.Chart.Event 20 | 21 | import Data.Colour 22 | import Data.Colour.Names 23 | 24 | import Tools.TimePlot.Types 25 | import qualified Tools.TimePlot.Incremental as I 26 | 27 | type PlotGen = String -> LocalTime -> LocalTime -> I.StreamSummary (LocalTime, InEvent) PlotData 28 | 29 | initGen :: ChartKind LocalTime -> PlotGen 30 | initGen (KindACount bs) = genActivity (\sns n -> n) bs 31 | initGen (KindCount bs) = genActivity (\sns n -> n*toSeconds bs (undefined::LocalTime)) bs 32 | initGen (KindAPercent bs b) = genActivity (\sns n -> 100*n/b) bs 33 | initGen (KindAFreq bs) = genActivity (\sns n -> if n == 0 then 0 else (n / sum (M.elems sns))) bs 34 | initGen (KindFreq bs k) = genAtoms atoms2freqs bs k 35 | where atoms2freqs as m = let s = sum [c | (a,c) <- M.toList m] 36 | in if s==0 then [0] else 0:[fromIntegral (M.findWithDefault 0 a m)/fromIntegral s | a <- as] 37 | initGen (KindHistogram bs k) = genAtoms atoms2hist bs k 38 | where atoms2hist as m = 0:[fromIntegral (M.findWithDefault 0 a m) | a <- as] 39 | initGen KindEvent = genEvent 40 | initGen (KindQuantile bs vs) = genQuantile bs vs 41 | initGen (KindBinFreq bs vs) = genBinFreqs bs vs 42 | initGen (KindBinHist bs vs) = genBinHist bs vs 43 | initGen KindLines = genLines 44 | initGen (KindDots alpha) = genDots alpha 45 | initGen (KindSum bs ss) = genSum bs ss 46 | initGen (KindCumSum bs ss) = genCumSum bs ss 47 | initGen (KindDuration sk dropSubtrack) = genDuration sk dropSubtrack 48 | initGen (KindWithin _ _) = \name -> error $ 49 | "KindWithin should not be plotted (this is a bug): track " ++ show name 50 | initGen KindNone = \name -> error $ 51 | "KindNone should not be plotted (this is a bug): track " ++ show name 52 | initGen KindUnspecified = \name -> error $ 53 | "Kind not specified for track " ++ show name ++ " (have you misspelled -dk or any of -k arguments?)" 54 | 55 | -- Auxiliary functions for two common plot varieties 56 | 57 | plotTrackBars :: [(LocalTime,[Double])] -> [String] -> String -> [Colour Double] -> PlotData 58 | plotTrackBars vals titles name colors = PlotBarsData { 59 | plotName = name, 60 | barsStyle = BarsStacked, 61 | barsValues = vals, 62 | barsStyles = [ (solidFillStyle c, Nothing) 63 | | c <- transparent:map opaque colors 64 | | _ <- "":titles], 65 | barsTitles = "":titles 66 | } 67 | 68 | plotLines :: String -> [(S.ByteString, [(LocalTime,Double)])] -> PlotData 69 | plotLines name vss = PlotLinesData { 70 | plotName = name, 71 | linesData = [vs | (_, vs) <- vss], 72 | linesStyles = [solidLine 1 color | _ <- vss | color <- map opaque colors], 73 | linesTitles = [S.unpack subtrack | (subtrack, _) <- vss] 74 | } 75 | 76 | ------------------------------------------------------------- 77 | -- Plot generators 78 | ------------------------------------------------------------- 79 | 80 | -- Wrappers for I.filterMap 81 | values (t,InValue s v) = Just (t,s,v) 82 | values _ = Nothing 83 | 84 | valuesDropTrack (t, InValue s v) = Just (t,v) 85 | valuesDropTrack _ = Nothing 86 | 87 | atomsDropTrack (t, InAtom s a) = Just (t,a) 88 | atomsDropTrack _ = Nothing 89 | 90 | edges (t,InEdge s e) = Just (t,s,e) 91 | edges _ = Nothing 92 | 93 | ------------------- Lines ---------------------- 94 | genLines :: PlotGen 95 | genLines name t0 t1 = I.filterMap values $ (data2plot . groupByTrack) <$> I.collect 96 | where 97 | data2plot vss = PlotLinesData { 98 | plotName = name, 99 | linesData = [vs | (_,vs) <- vss], 100 | linesStyles = [solidLine 1 color | _ <- vss | color <- map opaque colors], 101 | linesTitles = [S.unpack subtrack | (subtrack, _) <- vss] 102 | } 103 | 104 | ------------------- Dots ---------------------- 105 | genDots :: Double -> PlotGen 106 | genDots alpha name t0 t1 = I.filterMap values $ (data2plot . groupByTrack) <$> I.collect 107 | where 108 | data2plot vss = PlotDotsData { 109 | plotName = name, 110 | dotsData = [vs | (_,vs) <- vss], 111 | dotsTitles = [S.unpack subtrack | (subtrack, _) <- vss], 112 | dotsColors = if alpha == 1 then map opaque colors else map (`withOpacity` alpha) colors 113 | } 114 | 115 | ------------------- Binned graphs ---------------------- 116 | summaryByFixedTimeBins t0 binSize = I.byTimeBins (iterate (add binSize) t0) 117 | 118 | -- Arguments of f will be: value bin boundaries, values in the current time bin 119 | genByBins :: ([Double] -> [Double] -> [Double]) -> NominalDiffTime -> [Double] -> PlotGen 120 | genByBins f timeBinSize valueBinBounds name t0 t1 = I.filterMap valuesDropTrack $ 121 | summaryByFixedTimeBins t0 timeBinSize $ 122 | I.mapInput (\(t,xs) -> (t, 0:f valueBinBounds xs)) $ 123 | (\tfs -> plotTrackBars tfs binTitles name colors) <$> 124 | I.collect 125 | where 126 | binTitles = [low]++[showDt v1++".."++showDt v2 127 | | v1 <- valueBinBounds 128 | | v2 <- tail valueBinBounds]++ 129 | [high] 130 | where 131 | low = "<"++showDt (head valueBinBounds) 132 | high = ">"++showDt (last valueBinBounds) 133 | 134 | -- 0.1s but 90ms, etc. 135 | showDt t | t < 0.0000001 = show (t*1000000000) ++ "ns" 136 | | t < 0.0001 = show (t*1000000) ++ "us" 137 | | t < 0.1 = show (t*1000) ++ "ms" 138 | | True = show t ++ "s" 139 | 140 | genBinHist :: NominalDiffTime -> [Double] -> PlotGen 141 | genBinFreqs :: NominalDiffTime -> [Double] -> PlotGen 142 | (genBinHist,genBinFreqs) = (genByBins values2binHist, genByBins values2binFreqs) 143 | where 144 | values2binHist bins = values2binHist' bins . sort 145 | 146 | values2binHist' [] xs = [fromIntegral (length xs)] 147 | values2binHist' (a:as) xs = fromIntegral (length xs0) : values2binHist' as xs' 148 | where (xs0,xs') = span ( [Double] -> PlotGen 157 | genQuantile binSize qs name t0 t1 = I.filterMap valuesDropTrack $ 158 | summaryByFixedTimeBins t0 binSize $ 159 | I.mapInput (second (diffs . getQuantiles qs)) $ 160 | fmap (\tqs -> plotTrackBars tqs quantileTitles name colors) $ 161 | I.collect 162 | where 163 | quantileTitles = [show p1++".."++show p2++"%" | p1 <- percents | p2 <- tail percents] 164 | percents = map (floor . (*100.0)) $ [0.0] ++ qs ++ [1.0] 165 | diffs xs = zipWith (-) xs (0:xs) 166 | 167 | getQuantiles :: (Ord a) => [Double] -> [a] -> [a] 168 | getQuantiles qs = quantiles' . sort 169 | where 170 | qs' = sort qs 171 | quantiles' [] = [] 172 | quantiles' xs = index (0:ns++[n-1]) 0 xs 173 | where 174 | n = length xs 175 | ns = map (floor . (*(fromIntegral n-1))) qs' 176 | 177 | index _ _ [] = [] 178 | index [] _ _ = [] 179 | index [i] j (x:xs) 180 | | ij = index (i:i':is) (j+1) xs 186 | | i==i' = x:index (i':is) j (x:xs) 187 | | True = x:index (i':is) (j+1) xs 188 | 189 | genAtoms :: ([S.ByteString] -> M.Map S.ByteString Int -> [Double]) -> 190 | NominalDiffTime -> PlotBarsStyle -> PlotGen 191 | genAtoms f binSize k name t0 t1 = I.filterMap atomsDropTrack (h <$> unique (\(t,atom) -> atom) <*> fInBins) 192 | where 193 | fInBins :: I.StreamSummary (LocalTime, S.ByteString) [(LocalTime, M.Map S.ByteString Int)] 194 | fInBins = summaryByFixedTimeBins t0 binSize $ I.mapInput (second counts) I.collect 195 | counts = foldl' insert M.empty 196 | where 197 | insert m a = case M.lookup a m of 198 | Nothing -> M.insert a 1 m 199 | Just !n -> M.insert a (n+1) m 200 | 201 | h :: [S.ByteString] -> [(LocalTime, M.Map S.ByteString Int)] -> PlotData 202 | h as tfs = (plotTrackBars (map (second (f as)) tfs) (map show as) name colors) { barsStyle = k } 203 | 204 | unique :: (Ord a) => (x -> a) -> I.StreamSummary x [a] 205 | unique f = I.stateful M.empty (\a -> M.insert (f a) ()) M.keys 206 | 207 | uniqueSubtracks :: I.StreamSummary (LocalTime,S.ByteString,a) [S.ByteString] 208 | uniqueSubtracks = unique (\(t,s,a) -> s) 209 | 210 | genSum :: NominalDiffTime -> SumSubtrackStyle -> PlotGen 211 | genSum binSize ss name t0 t1 = I.filterMap values (h <$> uniqueSubtracks <*> sumsInBins t0 binSize) 212 | where 213 | h :: [S.ByteString] -> [(LocalTime, M.Map S.ByteString Double)] -> PlotData 214 | h tracks binSums = plotLines name rows 215 | where 216 | rowsT' = case ss of 217 | SumOverlayed -> map (second M.toList) binSums 218 | SumStacked -> map (second stack) binSums 219 | 220 | stack :: M.Map S.ByteString Double -> [(S.ByteString, Double)] 221 | stack ss = zip tracks (scanl1 (+) (map (\x -> M.findWithDefault 0 x ss) tracks)) 222 | 223 | rows :: [(S.ByteString, [(LocalTime, Double)])] 224 | rows = M.toList $ fmap sort $ M.fromListWith (++) $ 225 | [(track, [(t,sum)]) | (t, m) <- rowsT', (track, sum) <- m] 226 | 227 | sumsInBins :: LocalTime -> NominalDiffTime -> I.StreamSummary (LocalTime,S.ByteString,Double) [(LocalTime, M.Map S.ByteString Double)] 228 | sumsInBins t0 bs = I.mapInput (\(t,s,v) -> (t,(s,v))) $ 229 | summaryByFixedTimeBins t0 bs $ 230 | I.mapInput (second (fromListWith' (+))) $ 231 | I.collect 232 | 233 | genCumSum :: NominalDiffTime -> SumSubtrackStyle -> PlotGen 234 | genCumSum bs ss name t0 t1 = I.filterMap values (accumulate <$> uniqueSubtracks <*> sumsInBins t0 bs) 235 | where 236 | accumulate :: [S.ByteString] -> [(LocalTime, M.Map S.ByteString Double)] -> PlotData 237 | accumulate tracks tss = plotLines name [(track, [(t, ss M.! track) | (t,ss) <- cumsums]) | track <- tracks] 238 | where 239 | cumsums = scanl' f (t0, M.fromList $ zip tracks (repeat 0)) (map normalize tss) 240 | normalize (t,binSums) = (t, M.fromList [ (track, M.findWithDefault 0 track binSums) | track <- tracks ]) 241 | 242 | f (_,bases) (t,binSums) = (t,) $ M.fromList $ zip tracks $ zipWith (+) trackBases $ case ss of 243 | SumOverlayed -> trackSums 244 | SumStacked -> trackAccSums 245 | where 246 | trackSums = [ binSums M.! track | track <- tracks ] 247 | trackBases = [ bases M.! track | track <- tracks ] 248 | trackAccSums = scanl1' (+) trackSums 249 | scanl1' f (x:xs) = scanl' f x xs 250 | scanl' f !x0 [] = [x0] 251 | scanl' f !x0 (x:xs) = x0:scanl' f (f x0 x) xs 252 | 253 | genActivity :: (M.Map S.ByteString Double -> Double -> Double) -> NominalDiffTime -> PlotGen 254 | genActivity f bs name t0 t1 = I.filterMap edges (h <$> uniqueSubtracks <*> binAreas) 255 | where 256 | binAreas :: I.StreamSummary (LocalTime,S.ByteString,Edge) [(LocalTime, M.Map S.ByteString Double)] 257 | binAreas = fmap (map (\((t1,t2),m) -> (t1,m))) $ edges2binsSummary bs t0 t1 258 | 259 | h tracks binAreas = (plotTrackBars barsData (map S.unpack tracks) name colors) { barsStyle = BarsStacked } 260 | where 261 | barsData = [(t, 0:map (f m . flip (M.findWithDefault 0) m) tracks) | (t,m) <- binAreas] 262 | 263 | edges2binsSummary :: (Ord t,HasDelta t,Show t) => 264 | Delta t -> t -> t -> 265 | I.StreamSummary (t,S.ByteString,Edge) [((t,t), M.Map S.ByteString Double)] 266 | edges2binsSummary binSize tMin tMax = I.stateful (M.empty, iterate (add binSize) tMin, []) step flush 267 | where 268 | -- State: (m, ts, r) where: 269 | -- * m = subtrack => state of current bin: 270 | -- (area, starting time, level = rise-fall, num pulse events) 271 | -- * ts = infinite list of time bin boundaries 272 | -- * r = reversed list of results per bins 273 | modState s t (!m, ts,r) f = (m', ts, r) 274 | where 275 | m' = MS.insertWith (\new !old -> f old) s (f (0,t,0,0)) m 276 | 277 | flushBin st@(m,t1:t2:ts,!r) = (m', t2:ts, r') 278 | where 279 | states = M.toList m 280 | binSizeSec = deltaToSeconds t2 t1 281 | binValue (area,start,nopen,npulse) = 282 | (fromIntegral npulse + area + deltaToSeconds t2 start*nopen) / binSizeSec 283 | !r' = ((t1,t2), M.fromList [(s, binValue bin) | (s, bin) <- states]) : r 284 | !m' = fmap (\(_,_,nopen,_) -> (0,t2,nopen,0)) m 285 | 286 | step ev@(t, s, e) st@(m, t1:t2:ts, r) 287 | | t < t1 = error $ "Times are not in ascending order, first violating is " ++ show t 288 | | t >= t2 = step ev (flushBin st) 289 | | True = step'' ev st 290 | 291 | step'' ev@(t,s,e) st@(m, t1:t2:ts, r) = if (t < t1 || t >= t2) then error "Outside bin" else step' ev st 292 | step' (t, s, SetTo _) st = st 293 | step' (t, s, Pulse _) st = modState s t st $ 294 | \(!area, !start, !nopen, !npulse) -> (area, t, nopen, npulse+1) 295 | step' (t, s, Rise) st = modState s t st $ 296 | \(!area, !start, !nopen, !npulse) -> (area+deltaToSeconds t start*nopen, t, nopen+1, npulse) 297 | step' (t, s, Fall) st = modState s t st $ 298 | \(!area, !start, !nopen, !npulse) -> (area+deltaToSeconds t start*nopen, t, nopen-1, npulse) 299 | flush st@(m, t1:t2:ts, r) 300 | | t2 <= tMax = flush (flushBin st) 301 | | True = reverse r 302 | 303 | type StreamTransformer a b = forall r . I.StreamSummary b r -> I.StreamSummary a r 304 | 305 | edges2eventsSummary :: forall t . (Ord t) => 306 | t -> t -> StreamTransformer (t,S.ByteString,Edge) (S.ByteString, Event t Status) 307 | edges2eventsSummary t0 t1 s = I.stateful (M.empty,s) step flush 308 | where 309 | -- State: (m, sum) where 310 | -- * m = subtrack => (event start, level = rise-fall, status) 311 | -- * sum = summary of accumulated events so far 312 | tellSummary e (ts,!sum) = (ts,I.insert sum e) 313 | 314 | getTrack s (!ts,sum) = M.findWithDefault (t0, 0, emptyStatus) s ts 315 | putTrack s t (!ts,sum) = (M.insert s t ts, sum) 316 | killTrack s (!ts,sum) = (M.delete s ts, sum) 317 | trackCase s whenZero withNonzero st 318 | | numActive == 0 = whenZero 319 | | True = withNonzero t0 numActive status 320 | where (t0, numActive, status) = getTrack s st 321 | 322 | emptyStatus = Status "" "" 323 | 324 | step (t,s,Pulse st) state = tellSummary (s, PulseEvent t st) state 325 | step (t,s,SetTo st) state = trackCase s 326 | (putTrack s (t, 1, st) state) 327 | (\t0 !n st0 -> putTrack s (t,n,st) $ tellSummary (s, LongEvent (t0,True) (t,True) st0) state) 328 | state 329 | step (t,s,Rise) state = trackCase s 330 | (putTrack s (t, 1, emptyStatus) state) 331 | (\t0 !n st -> putTrack s (t, n+1, st) state) 332 | state 333 | step (t,s,Fall) state 334 | | numActive == 1 = killTrack s $ tellSummary (s, LongEvent (t0,True) (t,True) st) state 335 | | True = putTrack s (t0, max 0 (numActive-1), st) state 336 | where 337 | (t0, numActive, st) = getTrack s state 338 | 339 | flush (ts,sum) = I.finalize $ foldl' addEvent sum $ M.toList ts 340 | where 341 | addEvent sum (s,(t0,_,st)) = I.insert sum (s, LongEvent (t0,True) (t1,False) st) 342 | 343 | edges2durationsSummary :: forall t . (Ord t, HasDelta t) => 344 | t -> t -> Maybe String -> StreamTransformer (t,S.ByteString,Edge) (t,InEvent) 345 | edges2durationsSummary t0 t1 commonTrack = edges2eventsSummary t0 t1 . I.filterMap genDurations 346 | where 347 | genDurations (track, e) = case e of 348 | LongEvent (t1,True) (t2,True) _ -> Just (t2, InValue (case commonTrack of 349 | Nothing -> track 350 | _ -> commonTrackBS) 351 | (deltaToSeconds t2 t1)) 352 | _ -> Nothing 353 | commonTrackBS = S.pack (fromJust commonTrack) 354 | 355 | genEvent :: PlotGen 356 | genEvent name t0 t1 = I.filterMap edges $ 357 | fmap (\evs -> PlotEventData { plotName = name, eventData = map snd evs }) $ 358 | edges2eventsSummary t0 t1 I.collect 359 | -- TODO Multiple tracks 360 | 361 | genDuration :: ChartKind LocalTime -> Bool -> PlotGen 362 | genDuration sk dropSubtrack name t0 t1 = I.filterMap edges $ 363 | edges2durationsSummary t0 t1 (if dropSubtrack then Just name else Nothing) (initGen sk name t0 t1) 364 | 365 | fromListWith' f kvs = foldl' insert M.empty kvs 366 | where 367 | insert m (k,v) = case M.lookup k m of 368 | Nothing -> M.insert k v m 369 | Just !v' -> M.insert k (f v' v) m 370 | 371 | colors = cycle [green,blue,red,brown,yellow,orange,grey,purple,violet,lightblue] 372 | 373 | groupByTrack xs = M.toList $ sort `fmap` M.fromListWith (++) [(s, [(t,v)]) | (t,s,v) <- xs] 374 | -------------------------------------------------------------------------------- /Tools/TimePlot/Render.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ParallelListComp #-} 2 | module Tools.TimePlot.Render ( 3 | dataToPlot 4 | ) where 5 | 6 | import Graphics.Rendering.Chart 7 | import Graphics.Rendering.Chart.Event 8 | import Control.Lens 9 | import Data.Time 10 | import Data.Colour 11 | import Data.Colour.Names 12 | import Data.Default 13 | import Data.Maybe 14 | 15 | import Tools.TimePlot.Types 16 | import Tools.TimePlot.Plots 17 | 18 | dataToPlot :: AxisData LocalTime -> (LocalTime,LocalTime) -> PlotData -> StackedLayout LocalTime 19 | dataToPlot commonTimeAxis tr pd = dataToPlot' commonTimeAxis $ constrainTime tr pd 20 | 21 | constrainTime :: (LocalTime,LocalTime) -> PlotData -> PlotData 22 | constrainTime tr@(t0,t1) p@PlotBarsData{} = p {barsValues = filter (inRange tr . fst) (barsValues p)} 23 | constrainTime tr@(t0,t1) p@PlotEventData{} = p {eventData = filter (any (inRange tr) . eventTimes) (eventData p)} 24 | constrainTime tr@(t0,t1) p@PlotLinesData{} = p {linesData = map (filter (inRange tr . fst)) (linesData p)} 25 | constrainTime tr@(t0,t1) p@PlotDotsData{} = p {dotsData = map (filter (inRange tr . fst)) (dotsData p)} 26 | 27 | inRange (t0,t1) t = t>=t0 && t<=t1 28 | eventTimes e = [eventStart e, eventEnd e] 29 | 30 | dataToPlot' :: AxisData LocalTime -> PlotData -> StackedLayout LocalTime 31 | dataToPlot' commonTimeAxis p@PlotBarsData{} = StackedLayout $ layoutWithTitle commonTimeAxis [plotBars plot] (plotName p) (length (barsTitles p) > 1) 32 | where plot = plot_bars_values .~ barsValues p $ 33 | plot_bars_item_styles .~ barsStyles p $ 34 | plot_bars_style .~ barsStyle p $ 35 | plot_bars_titles .~ barsTitles p $ 36 | ourPlotBars 37 | dataToPlot' commonTimeAxis p@PlotEventData{} = StackedLayout $ layoutWithTitle commonTimeAxis [toPlot plot] (plotName p) False 38 | where plot = plot_event_data .~ eventData p $ 39 | plot_event_long_fillstyle .~ toFillStyle $ 40 | plot_event_label .~ toLabel $ 41 | def 42 | toFillStyle s = solidFillStyle . opaque $ fromMaybe lightgray (readColourName (statusColor s)) 43 | toLabel s = statusLabel s 44 | dataToPlot' commonTimeAxis p@PlotLinesData{} = StackedLayout $ layoutWithTitle commonTimeAxis (map toPlot plots) (plotName p) (length (linesData p) > 1) 45 | where plots = [plot_lines_values .~ [vs] $ 46 | plot_lines_title .~ title $ 47 | plot_lines_style .~ lineStyle $ 48 | def 49 | | vs <- linesData p 50 | | title <- linesTitles p 51 | | lineStyle <- linesStyles p] 52 | dataToPlot' commonTimeAxis p@PlotDotsData{} = StackedLayout $ layoutWithTitle commonTimeAxis (map toPlot plots) (plotName p) (length (dotsData p) > 1) 53 | where plots = [plot_points_values .~ vs $ 54 | plot_points_style .~ hollowCircles 4 1 color $ 55 | plot_points_title .~ subtrack $ 56 | def 57 | | subtrack <- dotsTitles p 58 | | color <- dotsColors p 59 | | vs <- dotsData p] 60 | 61 | layoutWithTitle :: (PlotValue a, Show a) => AxisData LocalTime -> [Plot LocalTime a] -> String -> Bool -> Layout LocalTime a 62 | layoutWithTitle commonTimeAxis plots name showLegend = 63 | layout_title .~ "" $ 64 | layout_plots .~ plots $ 65 | (if showLegend then id else (layout_legend .~ Nothing)) $ 66 | layout_x_axis . laxis_generate .~ (\_ -> commonTimeAxis) $ 67 | layout_y_axis . laxis_title .~ name $ 68 | layout_margin .~ 0 $ 69 | layout_grid_last .~ True $ 70 | def 71 | 72 | ourPlotBars :: (BarsPlotValue a) => PlotBars LocalTime a 73 | ourPlotBars = plot_bars_spacing .~ BarsFixGap 0 0 $ 74 | plot_bars_style .~ BarsStacked $ 75 | plot_bars_alignment .~ BarsLeft $ 76 | def 77 | -------------------------------------------------------------------------------- /Tools/TimePlot/Source.hs: -------------------------------------------------------------------------------- 1 | module Tools.TimePlot.Source ( 2 | readSource 3 | ) where 4 | 5 | import qualified Data.ByteString.Char8 as S 6 | import qualified Data.ByteString.Lazy.Char8 as B 7 | import Data.ByteString.Lex.Fractional 8 | import Tools.TimePlot.Types 9 | 10 | readSource :: (Show t) => (S.ByteString -> Maybe (t, S.ByteString)) -> FilePath -> IO (ParseResult t) 11 | readSource readTime f = (toParseResult . map (parseLine . B.toStrict) . filter (not . B.null) . blines) `fmap` 12 | (if f == "-" then B.getContents else B.readFile f) 13 | where 14 | blines = map pruneLF . B.split '\n' 15 | pruneLF b | not (B.null b) && (B.last b == '\r') = B.init b 16 | | otherwise = b 17 | toParseResult [] = ParseResult [] [] 18 | toParseResult (Left e:es) = let ~(ParseResult pd up) = toParseResult es in ParseResult (e:pd) up 19 | toParseResult (Right s:es) = let ~(ParseResult pd up) = toParseResult es in ParseResult pd (s:up) 20 | parseLine s = (\x -> case x of { Just e -> Left e; Nothing -> Right s }) $ do 21 | (t, s') <- readTime s 22 | (_, s'') <- S.uncons s' 23 | (c,rest) <- S.uncons s'' 24 | case c of 25 | '>' -> return (t, InEdge rest Rise ) 26 | '<' -> return (t, InEdge rest Fall ) 27 | '!' -> do 28 | let (track, val') = S.break (==' ') rest 29 | let label = S.unpack $ S.drop 1 val' 30 | return (t, InEdge track (Pulse (Status "" label))) 31 | '@' -> do 32 | let (track, val') = S.break (==' ') rest 33 | (_,val) <- S.uncons val' 34 | return (t, InEdge track $ SetTo (Status {statusColor = S.unpack $ val, statusLabel = ""})) 35 | '=' -> do 36 | let (track, val') = S.break (==' ') rest 37 | (_,val) <- S.uncons val' 38 | case S.uncons val of 39 | Nothing -> Nothing 40 | Just (v, val') -> case v of 41 | '`' -> do 42 | return (t, InAtom track val') 43 | _ -> do 44 | (v, _) <- readSigned readDecimal val 45 | return (t, InValue track v) 46 | _ -> Nothing 47 | 48 | -------------------------------------------------------------------------------- /Tools/TimePlot/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP, TypeFamilies, BangPatterns #-} 2 | module Tools.TimePlot.Types where 3 | 4 | import Data.Default 5 | import Data.Time hiding (parseTime) 6 | import qualified Data.ByteString.Char8 as S 7 | import Graphics.Rendering.Chart 8 | import Data.Colour 9 | import Graphics.Rendering.Chart.Event 10 | 11 | data Status = Status {statusColor :: String, statusLabel :: String} deriving (Eq, Show, Ord) 12 | 13 | instance PlotValue Status where 14 | toValue = const 0 15 | fromValue = const (Status "" "") 16 | autoAxis = const unitStatusAxis 17 | 18 | unitStatusAxis :: AxisData Status 19 | unitStatusAxis = AxisData { 20 | _axis_viewport = \(x0,x1) _ -> (x0+x1)/2, 21 | _axis_tropweiv = \_ _ -> Status "" "", 22 | _axis_ticks = [(Status "" "", 0)], 23 | _axis_labels = [[(Status "" "", "")]], 24 | _axis_grid = [], 25 | _axis_visibility = def 26 | } 27 | 28 | data Edge = Rise | Fall | Pulse Status | SetTo Status deriving (Eq,Show) 29 | 30 | data InEvent = InEdge {evt_track :: S.ByteString, evt_edge :: Edge} 31 | | InValue {evt_track :: S.ByteString, evt_value :: Double} 32 | | InAtom {evt_track :: S.ByteString, evt_atom :: S.ByteString} 33 | deriving (Show) 34 | 35 | data OutFormat = OutPNG | OutPDF | OutPS | OutSVG 36 | #ifdef HAVE_GTK 37 | | Window 38 | #endif 39 | 40 | class HasDelta t where 41 | type Delta t :: * 42 | add :: Delta t -> t -> t 43 | sub :: t -> t -> Delta t 44 | -- the 't' is a dummy argument here, just to aid type checking 45 | -- (since given just a Delta t, the compiler won't be able to 46 | -- figure out which 't' we're speaking of) 47 | toSeconds :: Delta t -> t -> Double 48 | deltaToSeconds :: t -> t -> Double 49 | fromSeconds :: Double -> t -> Delta t 50 | showDelta :: t -> t -> String 51 | 52 | instance HasDelta Double where 53 | type Delta Double = Double 54 | add d t = t + d 55 | sub t2 t1 = t2 - t1 56 | toSeconds d _ = d 57 | deltaToSeconds t2 t1 = t2 - t1 58 | fromSeconds d _ = d 59 | showDelta a b = show (a - b) 60 | 61 | instance HasDelta LocalTime where 62 | type Delta LocalTime = NominalDiffTime 63 | add d t = utcToLocalTime utc (addUTCTime d (localTimeToUTC utc t)) 64 | sub t2 t1 = diffUTCTime (localTimeToUTC utc t2) (localTimeToUTC utc t1) 65 | toSeconds d _ = fromIntegral (truncate (1000000*d)) / 1000000 66 | deltaToSeconds t2 t1 = diffLocalToSeconds t2 t1 67 | fromSeconds d _ = fromRational (toRational d) 68 | showDelta t1 t2 69 | | ts0 < 0.001 = "0" 70 | | tm < 1 = showsPrec 3 s "s" 71 | | th < 1 = show m ++ "m" ++ (if s<1 then "" else (show (floor s) ++ "s")) 72 | | d < 1 = show h ++ "h" ++ (if m<1 then "" else (show m ++ "m")) 73 | | True = show d ++ "d" ++ (if h<1 then "" else (show h ++ "h")) 74 | where ts0 = toSeconds (t1 `sub` t2) t1 75 | ts = if ts0 < 60 then ts0 else fromIntegral (round ts0) 76 | tm = floor (ts / 60) :: Int 77 | th = tm `div` 60 :: Int 78 | s = ts - 60 * fromIntegral tm :: Double 79 | m = tm - 60 * th :: Int 80 | h = th - 24 * d :: Int 81 | d = h `div` 24 :: Int 82 | 83 | diffLocalToSeconds :: LocalTime -> LocalTime -> Double 84 | diffLocalToSeconds !t2 !t1 = 86400.0*fromIntegral (diffDays d2 d1) + fromIntegral (3600*(h2-h1) + 60*(m2-m1)) + fromRational (toRational (s2-s1)) 85 | where 86 | (d1,d2,TimeOfDay h1 m1 s1,TimeOfDay h2 m2 s2) = (localDay t1, localDay t2, localTimeOfDay t1, localTimeOfDay t2) 87 | 88 | 89 | data SumSubtrackStyle = SumStacked | SumOverlayed 90 | 91 | data ChartKind t = KindEvent 92 | | KindDuration { subKind :: ChartKind t, dropSubtrack :: Bool } 93 | | KindWithin { mapName :: S.ByteString -> S.ByteString, subKind :: ChartKind t } 94 | | KindACount { binSize :: Delta t } 95 | | KindCount { binSize :: Delta t } 96 | | KindAPercent { binSize :: Delta t, baseCount :: Double } 97 | | KindAFreq { binSize :: Delta t } 98 | | KindQuantile { binSize :: Delta t, quantiles :: [Double] } 99 | | KindBinFreq { binSize :: Delta t, delims :: [Double] } 100 | | KindBinHist { binSize :: Delta t, delims :: [Double] } 101 | | KindFreq { binSize :: Delta t, style :: PlotBarsStyle } 102 | | KindHistogram { binSize :: Delta t, style :: PlotBarsStyle } 103 | | KindLines 104 | | KindDots { alpha :: Double } 105 | | KindCumSum { binSize :: Delta t, subtrackStyle :: SumSubtrackStyle } 106 | | KindSum { binSize :: Delta t, subtrackStyle :: SumSubtrackStyle } 107 | | KindNone 108 | | KindUnspecified -- Causes an error message 109 | 110 | data PlotData = PlotBarsData 111 | { 112 | plotName :: String, 113 | barsStyle :: PlotBarsStyle, 114 | barsValues :: [ (LocalTime, [Double]) ], 115 | barsStyles :: [(FillStyle, Maybe LineStyle)], 116 | barsTitles :: [String] 117 | } 118 | | PlotEventData 119 | { 120 | plotName :: String, 121 | eventData :: [Event LocalTime Status] 122 | } 123 | | PlotLinesData 124 | { 125 | plotName :: String, 126 | linesData :: [[(LocalTime, Double)]], 127 | linesStyles :: [LineStyle], 128 | linesTitles :: [String] 129 | } 130 | | PlotDotsData 131 | { 132 | plotName :: String, 133 | dotsData :: [[(LocalTime, Double)]], 134 | dotsColors :: [AlphaColour Double], 135 | dotsTitles :: [String] 136 | } 137 | deriving (Show) 138 | 139 | data ParseResult t = ParseResult { 140 | parsedData :: [(t, InEvent)], 141 | unparseableLines :: [S.ByteString] 142 | } 143 | 144 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: 2 | text: 3 | integer-simple: false 4 | extra-package-dbs: [] 5 | packages: 6 | - '.' 7 | extra-deps: 8 | - Chart-1.5.4 9 | - Chart-cairo-1.5.4 10 | - QuickCheck-2.8.1 11 | - StateVar-1.1.0.1 12 | - adjunctions-4.2.2 13 | - alex-3.1.6 14 | - base-orphans-0.4.5 15 | - bifunctors-5.1 16 | - bytestring-lexing-0.5.0.2 17 | - cairo-0.13.1.1 18 | - colour-2.3.3 19 | - comonad-4.2.7.2 20 | - contravariant-1.3.3 21 | - data-accessor-0.2.2.6 22 | - data-accessor-template-0.2.1.12 23 | - data-default-0.5.3 24 | - data-default-class-0.0.1 25 | - data-default-instances-base-0.0.1 26 | - data-default-instances-containers-0.0.1 27 | - data-default-instances-dlist-0.0.1 28 | - data-default-instances-old-locale-0.0.1 29 | - distributive-0.4.4 30 | - dlist-0.7.1.2 31 | - exceptions-0.8.0.2 32 | - free-4.12.1 33 | - gtk2hs-buildtools-0.13.0.5 34 | - hashable-1.2.3.3 35 | - hashtables-1.2.1.0 36 | - kan-extensions-4.2.3 37 | - lens-4.13 38 | - mtl-2.2.1 39 | - old-locale-1.0.0.7 40 | - operational-0.2.3.2 41 | - parallel-3.2.0.6 42 | - parsec-3.1.9 43 | - prelude-extras-0.4.0.2 44 | - primitive-0.6.1.0 45 | - profunctors-5.1.2 46 | - random-1.1 47 | - reflection-2.1 48 | - regex-base-0.93.2 49 | - regex-tdfa-1.2.1 50 | - semigroupoids-5.0.0.4 51 | - semigroups-0.18.0.1 52 | - stm-2.4.4 53 | - strptime-1.0.10 54 | - tagged-0.8.2 55 | - text-1.2.1.3 56 | - tf-random-0.5 57 | - transformers-compat-0.4.0.4 58 | - unordered-containers-0.2.5.1 59 | - utf8-string-1.0.1.1 60 | - utility-ht-0.0.11 61 | - vcs-revision-0.0.2 62 | - vector-0.11.0.0 63 | - void-0.7.1 64 | resolver: ghc-7.10.3 65 | -------------------------------------------------------------------------------- /timeplot.cabal: -------------------------------------------------------------------------------- 1 | name: timeplot 2 | version: 1.0.33 3 | cabal-version: >=1.10 4 | build-type: Simple 5 | license: BSD3 6 | license-file: LICENSE 7 | copyright: Eugene Kirpichov, 2009-2011 8 | maintainer: Eugene Kirpichov 9 | stability: stable 10 | homepage: http://haskell.org/haskellwiki/Timeplot 11 | synopsis: A tool for visualizing time series from log files. 12 | description: A tool for visualizing time series from log files. 13 | Reads an input file with events in different "tracks" and draws a diagram for 14 | each track, where a diagram may be one of several types. See --help for help and the 15 | homepage for a bigger description, examples and a tutorial. See presentation: 16 | or download: 17 | . 18 | category: Graphics 19 | author: Eugene Kirpichov 20 | source-repository head 21 | type: git 22 | location: git://github.com/jkff/timeplot.git 23 | 24 | executable tplot 25 | main-is: Tools/TimePlot.hs 26 | default-language: Haskell2010 27 | other-modules: Tools.TimePlot.Conf Tools.TimePlot.Incremental 28 | Tools.TimePlot.Plots Tools.TimePlot.Render Tools.TimePlot.Source 29 | Tools.TimePlot.Types Paths_timeplot 30 | buildable: True 31 | ghc-options: -rtsopts 32 | other-modules: Graphics.Rendering.Chart.Event 33 | build-depends: Chart >= 1.3, Chart-cairo >= 1.3, base >=3 && <5, bytestring -any, 34 | bytestring-lexing ==0.5.*, cairo -any, colour -any, containers -any, 35 | data-default -any, lens >= 3.9, 36 | regex-tdfa -any, strptime >=0.1.7, time >= 1.11, 37 | transformers -any, 38 | vcs-revision >=0.0.2, template-haskell -any 39 | -------------------------------------------------------------------------------- /tutorial-data/README: -------------------------------------------------------------------------------- 1 | $ awk '/Successful COMMIT/{print $1 " !commit." $6}' tplot-tutorial.log > commit.trace 2 | $ head commit.trace 3 | 20121024.115520.85 !commit.dbv:0 4 | 20121024.115537.31 !commit.kth:1 5 | 20121024.115621.03 !commit.dbv:0 6 | 20121024.115707.44 !commit.mth:0 7 | ... 8 | 9 | $ tplot -if commit.trace -o commit.png -tf '%Y%m%d.%H%M%OS' -dk 'within[.] acount 5' 10 | $ # See commit.png 11 | -------------------------------------------------------------------------------- /tutorial-data/commit.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jkff/timeplot/112eff2dd4eb6d844f13ce9360f80db5d8f1b537/tutorial-data/commit.png --------------------------------------------------------------------------------