timeplot 0.2.17 → 0.2.18
raw patch · 2 files changed
+121/−99 lines, 2 filesdep ~base
Dependency ranges changed: base
Files
- Tools/TimePlot.hs +95/−58
- timeplot.cabal +26/−41
Tools/TimePlot.hs view
@@ -59,7 +59,7 @@ | InAtom S.ByteString deriving (Show) -data OutFormat = PNG | PDF | PS | SVG +data OutFormat = PNG | PDF | PS | SVG #if HAVE_GTK | Window #endif@@ -68,8 +68,8 @@ type Delta t :: * add :: Delta t -> t -> t sub :: t -> t -> Delta t- -- the 't' is a dummy argument here, just to aid type checking - -- (since given just a Delta t, the compiler won't be able to + -- the 't' is a dummy argument here, just to aid type checking+ -- (since given just a Delta t, the compiler won't be able to -- figure out which 't' we're speaking of) toSeconds :: Delta t -> t -> Double fromSeconds :: Double -> t -> Delta t@@ -91,7 +91,7 @@ instance Read NominalDiffTime where readsPrec n s = [(fromSeconds i (undefined::LocalTime), s') | (i,s') <- readsPrec n s] -class (Ord t, HasDelta t, PlotValue t, Show t, Show (Delta t), Read (Delta t)) => TimeAxis t +class (Ord t, HasDelta t, PlotValue t, Show t, Show (Delta t), Read (Delta t)) => TimeAxis t instance TimeAxis Double @@ -110,11 +110,9 @@ | KindCumSum | KindSum { binSize :: Delta t } | KindNone- deriving (Show) --data Conf = forall t . TimeAxis t =>- Conf {+data ConcreteConf t =+ ConcreteConf { inFile :: FilePath, parseTime :: B.ByteString -> Maybe (t, B.ByteString), chartKindF :: S.ByteString -> [ChartKind t],@@ -127,42 +125,45 @@ outResolution :: (Int,Int) } +data Conf = forall t . (TimeAxis t) => Conf {concrete :: ConcreteConf t}+ data KindChoiceOperator = Cut | Accumulate readConf :: [String] -> Conf readConf args = case (words $ single "time format" "-tf" ("date %Y-%m-%d %H:%M:%OS")) of- ["num"] -> readConf' readDouble- "date":f -> readConf' (strptime (B.pack $ unwords f))+ ["num"] -> Conf $ readConf' readDouble+ "date":f -> Conf $ readConf' (strptime (B.pack $ unwords f)) _ -> error "Unrecognized time format (-tf)" where- int2double = fromIntegral::Int-> Double+ int2double = fromIntegral :: Int -> Double single desc name def = case (getArg name 1 args) of [[r]] -> r [] -> def _ -> error $ "Single argument expected for: "++desc++" ("++name++")" - readConf' parseTime = Conf {inFile=inFile, outFile=outFile, outFormat=outFormat, outResolution=outRes,+ readConf' :: forall t. (TimeAxis t) => (B.ByteString -> Maybe (t, B.ByteString)) -> ConcreteConf t+ readConf' parseTime = ConcreteConf {inFile=inFile, outFile=outFile, outFormat=outFormat, outResolution=outRes, chartKindF=chartKindF, parseTime=parseTime, fromTime=fromTime, toTime=toTime} where inFile = single "input file" "-if" (error "No input file (-if) specified") outFile = single "output file" "-o" (error "No output file (-o) specified (or have you specified '-of x' and built without --flags=gtk ?)") outFormat = maybe PNG id $ lookup (single "output format" "-of" (name2format outFile)) $ [("png",PNG), ("pdf",PDF), ("ps",PS), ("svg",SVG)-#if HAVE_GTK +#if HAVE_GTK , ("x",Window)-#endif +#endif ] where name2format = reverse . takeWhile (/='.') . reverse outRes = parseRes $ single "output resolution" "-or" "640x480" where parseRes s = case break (=='x') s of (h,_:v) -> (read h,read v)- chartKindF = kindByRegex $ + chartKindF = kindByRegex $ [(Cut, matches regex, parseKind (words kind)) | [regex,kind] <- getArg "-k" 2 args] ++ [(Accumulate, matches regex, parseKind (words kind)) | [regex,kind] <- getArg "+k" 2 args] where ifNull xs y = case xs of { [] -> [y] ; _ -> xs }- kindByRegex rks s = (defaultKindsPlus ++ + kindByRegex rks s = (defaultKindsPlus ++ [k | (Accumulate, p, k) <- rks, p s] ++ [case [k | (Cut, p, k) <- rks, p s] of { [] -> defaultKindMinus; k:_ -> k }]) matches regex = matchTest (makeRegexOpts defaultCompOpt (ExecOption {captureGroups = False}) regex)@@ -184,7 +185,7 @@ parseKind ["cumsum" ] = KindCumSum parseKind ["sum", b ] = KindSum {binSize=read b} parseKind ("duration":ws) = KindDuration {subKind=parseKind ws, mapName=id}- parseKind (('d':'u':'r':'a':'t':'i':'o':'n':'[':sep:"]"):ws) + parseKind (('d':'u':'r':'a':'t':'i':'o':'n':'[':sep:"]"):ws) = KindDuration {subKind=parseKind ws, mapName = fst . S.break (==sep)} parseKind ["none" ] = KindNone parseKind ws = error ("Unknown diagram kind " ++ unwords ws)@@ -244,34 +245,45 @@ makeChart chartKindF [] = emptyRenderable makeChart chartKindF events0 = renderLayout1sStacked plots where- events@((t0,_,_):_) = sortBy (comparing (\(t,_,_)->t)) events0+ events :: [(t, S.ByteString, InEvent)]+ events@((t0,_,_):_) = sortBy (comparing (\(t,_,_)-> t)) events0++ track2events :: M.Map S.ByteString [(t, InEvent)] track2events = reverse `fmap` foldl' insert M.empty [(s, (t, e)) | (t, s, e) <- events] where insert m (s, r) = M.alter (Just . maybe [r] (r:)) s m - plots = [ plotTrack k kind es | (k, es) <- M.toList track2events, + plots = [ plotTrack k kind es | (k, es) <- M.toList track2events, kind <- chartKindF k, case kind of {KindNone -> False ; KindDuration _ _ -> False ; _ -> True} ] ++ durationPlots+ durationPlots = [ plotWithKind name k es | (name, (k,es)) <- M.toList durationTracks ] where durationTracks = M.fromListWith (\(ka,as) (kb,bs) -> (ka,mergeOn fst as bs)) components- components = [ (mn k, (sk, edges2durations (edges es))) - | (k, es) <- M.toList track2events, + components = [ (mn k, (sk, edges2durations (edges es)))+ | (k, es) <- M.toList track2events, kind <- chartKindF k, Just (sk,mn) <- [case kind of {KindDuration mn sk -> Just (sk,mn) ; _ -> Nothing}]] mergeOn f [] ys = ys mergeOn f xs [] = xs- mergeOn f (x:xs) (y:ys) + mergeOn f (x:xs) (y:ys) | f x <= f y = x : mergeOn f xs (y:ys)- | otherwise = y : mergeOn f (x:xs) ys + | otherwise = y : mergeOn f (x:xs) ys + minTime, maxTime :: t (minTime,maxTime) = (head times, last times)++ times :: [t] times = sort $ [t | tes <- M.elems track2events, (t,_)<- tes]++ commonTimeAxis :: AxisData t commonTimeAxis = autoAxis times - plotTrack name kind es = plotWithKind name kind es+ plotTrack :: S.ByteString -> ChartKind t -> [(t,InEvent)] -> AnyLayout1 t+ plotTrack name kind es = plotWithKind name kind es - plotWithKind name k es = case k of+ plotWithKind :: S.ByteString -> ChartKind t -> [(t, InEvent)] -> AnyLayout1 t+ plotWithKind name k es = case k of KindCount bs -> withAnyOrdinate $ plotTrackCount name es bs KindFreq bs k -> withAnyOrdinate $ plotTrackFreq name es bs k KindHistogram bs k -> withAnyOrdinate $ plotTrackHist name es bs k@@ -286,27 +298,36 @@ KindDuration _ _ -> error "KindDuration should not be plotted" KindNone -> error "KindNone should not be plotted" + edges :: [(t,InEvent)] -> [(t,Edge)]+ values :: [(t,InEvent)] -> [(t,Double)]+ atoms :: [(t,InEvent)] -> [(t,S.ByteString)] edges es = [(t,e) | (t,InEdge e) <- es] values es = [(t,v) | (t,InValue v) <- es] atoms es = [(t,a) | (t,InAtom a) <- es] - lag xs = xs `zip` tail xs- ourPlotBars :: (BarsPlotValue a) => PlotBars t a ourPlotBars = plot_bars_spacing ^= BarsFixGap 0 0 $ plot_bars_style ^= BarsStacked $ plot_bars_alignment ^= BarsLeft $ defaultPlotBars + plotTrackCount :: S.ByteString -> [(t,InEvent)] -> Delta t -> Layout1 t Int plotTrackCount name es bs = layoutWithTitle (plotBars plot) name- where plot = plot_bars_values ^= barsData $ - plot_bars_item_styles ^= [(solidFillStyle (opaque blue), Nothing)] $ + where plot = plot_bars_values ^= barsData $+ plot_bars_item_styles ^= [(solidFillStyle (opaque blue), Nothing)] $ ourPlotBars+ barsData :: [(t,[Int])] barsData = [(t,[n]) | ((t,_),n) <- edges2bins bs t0 (edges es)] + plotTrackFreq :: S.ByteString -> [(t,InEvent)] -> Delta t -> PlotBarsStyle -> Layout1 t Double plotTrackFreq = plotTrackAtoms atoms2freqs++ plotTrackHist :: S.ByteString -> [(t,InEvent)] -> Delta t -> PlotBarsStyle -> Layout1 t Int plotTrackHist = plotTrackAtoms atoms2hist + plotTrackAtoms :: (Num v, BarsPlotValue v) =>+ ([S.ByteString] -> [S.ByteString] -> [v]) ->+ S.ByteString -> [(t,InEvent)] -> Delta t -> PlotBarsStyle -> Layout1 t v plotTrackAtoms f name es bs k = layoutWithTitle (plotBars plot) name where plot = plot_bars_style ^= k $ plot_bars_values ^= vals $@@ -318,14 +339,16 @@ as = atoms es vs = M.keys $ M.fromList $ [(a,()) | (_,a) <- as] + plotTrackEvent :: S.ByteString -> [(t,InEvent)] -> Layout1 t Status plotTrackEvent name es = layoutWithTitle (toPlot plot) name- where plot = plot_event_data ^= edges2events (edges es) $ - plot_event_long_fillstyle ^= toFillStyle $ - plot_event_label ^= toLabel $ + 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 :: S.ByteString -> [(t,InEvent)] -> [Double] -> Delta t -> Layout1 t Double plotTrackQuantile name es qs bs = layoutWithTitle (plotBars plot) name where plot = plot_bars_values ^= toBars (byTimeBins (getQuantiles qs) bs t0 (values es)) $ plot_bars_item_styles ^= quantileStyles $@@ -333,9 +356,13 @@ ourPlotBars quantileStyles = none:(zip (map (solidFillStyle . opaque) colors) [Just $ solidLine 1 (opaque black) | i <- [0..n+1]]) quantileTitles = [""]++[show p1++".."++show p2++"%" | (p1,p2) <- lag percents ]- where percents = map (floor . (*100)) $ [0]++qs++[1]+ where+ percents = map (floor . (*100.0)) $ [0.0] ++ qs ++ [1.0] n = length qs- ++ lag :: [a] -> [(a,a)]+ lag xs = xs `zip` tail xs+ colors = cycle [green,blue,yellow,red,orange,brown,grey,purple,violet,lightblue] binTitles vs = [low]++[show v1++".."++show v2 | (v1,v2) <- lag vs]++[high]@@ -367,20 +394,26 @@ toBars tvs = [(t,diffs vs) | (t,vs) <- tvs] diffs xs = zipWith (-) xs (0:xs) + plotLines :: S.ByteString -> [(t,Double)] -> Layout1 t Double plotLines name vs = layoutWithTitle (toPlot plot) name where plot = plot_lines_values ^= [vs] $ defaultPlotLines + plotTrackLines :: S.ByteString -> [(t,InEvent)] -> Layout1 t Double plotTrackLines name es = plotLines name (values es)- ++ plotTrackDots :: S.ByteString -> [(t,InEvent)] -> Layout1 t Double plotTrackDots name es = layoutWithTitle (toPlot plot) name- where plot = plot_points_values ^= values es $ - plot_points_style ^= hollowCircles 4 1 (opaque blue) $ + where plot = plot_points_values ^= values es $+ plot_points_style ^= hollowCircles 4 1 (opaque blue) $ defaultPlotPoints + plotTrackCumSum :: S.ByteString -> [(t,InEvent)] -> Layout1 t Double plotTrackCumSum name es = plotLines name $ scanl (\(t1,s) (t2,v) -> (t2,s+v)) (minTime, 0) (values es) + plotTrackSum :: S.ByteString -> [(t,InEvent)] -> Delta t -> Layout1 t Double plotTrackSum name es bs = plotLines name $ byTimeBins sum bs t0 (values es) + layoutWithTitle :: (PlotValue a) => Plot t a -> S.ByteString -> Layout1 t a layoutWithTitle plot name = layout1_title ^= "" $ layout1_plots ^= [Left plot] $@@ -493,7 +526,7 @@ zoom :: (TimeAxis t) => [(t, S.ByteString, InEvent)] -> Maybe t -> Maybe t -> [(t, S.ByteString, InEvent)] zoom events fromTime toTime = filter p events- where + where p (t, _, _) = (maybe True (\ft -> t >= ft) fromTime) && (maybe True (\tt -> t < tt) toTime) @@ -541,7 +574,7 @@ "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,", + "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)",@@ -550,7 +583,7 @@ " 'none' - do not plot this track", " '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", + " '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'",@@ -559,7 +592,7 @@ " 'duration[C] XXXX' - same as 'duration', but of a track's name we only", " take the part before character C. For example, if you have processes", " named 'MACHINE-PID' (i.e. UNIT027-8532) say 'begin something' / ",- " 'end something' and you're interested in the properties of per-machine", + " 'end something' and you're interested in the properties of per-machine", " durations, use duration[-].", " 'count N' is for activity counts: a histogram is drawn with granularity", " of N time units, where the bin corresponding to [t..t+N) has value",@@ -592,20 +625,24 @@ mainWithArgs args mainWithArgs args = do when (null args || args == ["--help"]) $ showHelp >> exitSuccess- let conf = readConf args- let render = case (outFormat conf) of {- PNG -> \c w h f -> const () `fmap` renderableToPNGFile c w h f;- PDF -> renderableToPDFFile ;- PS -> renderableToPSFile ;- SVG -> renderableToSVGFile ;-#if HAVE_GTK - Window -> \c w h f -> renderableToWindow c w h-#endif - }- case conf of- Conf{parseTime=parseTime, inFile=inFile, chartKindF=chartKindF, outFile=outFile, outResolution=outResolution, fromTime=fromTime, toTime=toTime} -> do- source <- readSource parseTime inFile- let source' = zoom source fromTime toTime- let chart = makeChart chartKindF source'- let (w,h) = outResolution- render chart w h outFile+ case (readConf args) of+ Conf conf -> do+ let render = case (outFormat conf) of {+ PNG -> \c w h f -> const () `fmap` renderableToPNGFile c w h f;+ PDF -> renderableToPDFFile ;+ PS -> renderableToPSFile ;+ SVG -> renderableToSVGFile ;+#if HAVE_GTK+ Window -> \c w h f -> renderableToWindow c w h+#endif+ }+ case conf of+ ConcreteConf {+ parseTime=parseTime, inFile=inFile, chartKindF=chartKindF,+ outFile=outFile, outResolution=outResolution,+ fromTime=fromTime, toTime=toTime} -> do+ source <- readSource parseTime inFile+ let source' = zoom source fromTime toTime+ let chart = makeChart chartKindF source'+ let (w,h) = outResolution+ render chart w h outFile
timeplot.cabal view
@@ -1,42 +1,27 @@-Name: timeplot-Version: 0.2.17-License: BSD3-License-file: LICENSE-Copyright: Eugene Kirpichov, 2009-Author: Eugene Kirpichov <ekirpichov@gmail.com>-Maintainer: Eugene Kirpichov <ekirpichov@gmail.com>-Synopsis: A tool for visualizing time series from log files.-Description: A tool for visualizing time series from log files. - Reads an input file with events in different "tracks" and draws a diagram for - each track, where a diagram may be one of 8 types. See --help for help and the - homepage for a bigger description, examples and a tutorial. See presentation:- <http://www.slideshare.net/jkff/two-visualization-tools>-Category: Graphics-Cabal-Version: >= 1.6-Build-Type: Simple-Homepage: http://haskell.org/haskellwiki/Timeplot-Source-repository head- type: git- location: git://github.com/jkff/timeplot--flag splitbase- description: Choose the new smaller, split-up base package.--flag gtk- description: Include the gtk-based ability to render to a window- default: False-+name: timeplot+version: 0.2.18+cabal-version: >=1.6+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: Eugene Kirpichov, 2009+maintainer: Eugene Kirpichov <ekirpichov@gmail.com>+stability: stable+homepage: http://haskell.org/haskellwiki/Timeplot+synopsis: A tool for visualizing time series from log files.+description: A tool for visualizing time series from log files.+ Reads an input file with events in different "tracks" and draws a diagram for+ each track, where a diagram may be one of several types. See --help for help and the+ homepage for a bigger description, examples and a tutorial. See presentation:+ <http://www.slideshare.net/jkff/two-visualization-tools>+category: Graphics+author: Eugene Kirpichov <ekirpichov@gmail.com>+ executable tplot- if flag(splitbase)- Build-Depends: base >= 3 && < 5- else- Build-Depends: base < 3-- if flag(gtk)- cpp-options: -DHAVE_GTK=1- - 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- Other-Modules: Graphics.Rendering.Chart.Event+ main-is: Tools/TimePlot.hs+ buildable: True+ other-modules: Graphics.Rendering.Chart.Event+ build-depends: Chart >=0.14, base >=3 && <5, bytestring -any,+ bytestring-lexing -any, cairo -any, colour -any, containers -any,+ data-accessor ==0.2.*, data-accessor-template >=0.2.1.1 && <0.3,+ haskell98 -any, regex-tdfa -any, strptime >=0.1.7, time -any