diff --git a/Graphics/Rendering/Chart/Event.hs b/Graphics/Rendering/Chart/Event.hs --- a/Graphics/Rendering/Chart/Event.hs +++ b/Graphics/Rendering/Chart/Event.hs @@ -1,121 +1,121 @@ -{-# LANGUAGE TemplateHaskell #-} -module Graphics.Rendering.Chart.Event ( - PlotEvent(..), - Event(..), - - defaultPlotEvent, - plot_event_title, - plot_event_data, - plot_event_long_fillstyle, - plot_event_long_linestyle, - plot_event_pulse_linestyle, - plot_event_track_linestyle, - plot_event_label, -) where - -import qualified Graphics.Rendering.Cairo as C -import Graphics.Rendering.Chart -import Data.Colour -import Data.Colour.Names -import Data.Accessor -import Data.Accessor.Template -import Control.Monad - -data Event t e = LongEvent (t,Bool) (t,Bool) e -- ^ An event that has a beginning and an end. - -- True = "known explicitly", False = "implicit" (e.g. imposed by axis bounds) - | PulseEvent t e -- ^ A zero-length event - deriving (Show) - --- | A chart that depict events. --- There are two kinds of events: long and impulse events. A long event --- is drawn like "--[=====]---" and has a beginning and ending moment, and --- an impulse event is drawn like "---|----" and has an occurence moment. -data PlotEvent t e = PlotEvent { - plot_event_title_ :: String, - plot_event_data_ :: [Event t e], - -- | Linestyle with which marks for pulse events will be drawn - plot_event_pulse_linestyle_ :: e -> CairoLineStyle, - -- | Linestyle with which borders of rectangles for long events will be drawn - plot_event_long_linestyle_ :: e -> CairoLineStyle, - -- | 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_label_ :: e -> String -} - -defaultPlotEvent = PlotEvent { - plot_event_title_ = "", - plot_event_data_ = [], - 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_label_ = const "" -} - -instance ToPlot PlotEvent where - toPlot p = Plot { - plot_render_ = renderPlotEvent p, - plot_legend_ = [(plot_event_title_ p, renderPlotLegendEvent p)], - plot_all_points_ = plotAllPointsEvent p - } - -renderPlotLegendEvent :: PlotEvent t e -> Rect -> CRender () -renderPlotLegendEvent p r = return () - - -filledRect :: CairoFillStyle -> Rect -> CRender () -filledRect fs r = setFillStyle fs >> fillPath (rectPath r) - -framedRect :: CairoLineStyle -> Rect -> CRender () -framedRect ls r = setLineStyle ls >> strokePath (rectPath r) - -barHeight = 7 -pulseHeight = 15 - -renderPlotEvent :: PlotEvent t e -> PointMapFn t e -> CRender () -renderPlotEvent p pmap = do - setLineStyle $ plot_event_track_linestyle_ p - moveTo (Point x0 cy) - lineTo (Point x1 cy) - c $ C.stroke - mapM_ drawEventFill (plot_event_data_ p) - mapM_ drawEventFrame (plot_event_data_ p) - where - (Point x0 y0) = pmap (LMin,LMin) - (Point x1 y1) = pmap (LMax,LMax) - (cx,cy) = ((x0+x1)/2, (y0+y1)/2) - drawEventFill (PulseEvent t e) = return () - drawEventFill (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) - filledRect (plot_event_long_fillstyle_ p e) $ Rect - (Point x1 (cy-barHeight/2)) (Point x2 (cy+barHeight/2)) - - drawEventFrame (PulseEvent t e) = do - setLineStyle $ plot_event_pulse_linestyle_ p e - let (Point x y) = pmap (LValue t, LValue e) - 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) - framedRect (plot_event_long_linestyle_ p e) $ Rect - (Point x1 (cy-barHeight/2)) (Point x2 (cy+barHeight/2)) - -plotAllPointsEvent :: PlotEvent t e -> ([t], [e]) -plotAllPointsEvent p = let (ts, es) = unzip (map decomp d) in (concat ts, es) - where - d = plot_event_data_ p - decomp (PulseEvent t e) = ([t], e) - decomp (LongEvent (t1,_) (t2,_) e) = ([t1,t2], e) - -$( deriveAccessors ''PlotEvent ) +{-# LANGUAGE TemplateHaskell #-} +module Graphics.Rendering.Chart.Event ( + PlotEvent(..), + Event(..), + + defaultPlotEvent, + plot_event_title, + plot_event_data, + plot_event_long_fillstyle, + plot_event_long_linestyle, + plot_event_pulse_linestyle, + plot_event_track_linestyle, + plot_event_label, +) where + +import qualified Graphics.Rendering.Cairo as C +import Graphics.Rendering.Chart +import Data.Colour +import Data.Colour.Names +import Data.Accessor +import Data.Accessor.Template +import Control.Monad + +data Event t e = LongEvent (t,Bool) (t,Bool) e -- ^ An event that has a beginning and an end. + -- True = "known explicitly", False = "implicit" (e.g. imposed by axis bounds) + | PulseEvent t e -- ^ A zero-length event + deriving (Show) + +-- | A chart that depict events. +-- There are two kinds of events: long and impulse events. A long event +-- is drawn like "--[=====]---" and has a beginning and ending moment, and +-- an impulse event is drawn like "---|----" and has an occurence moment. +data PlotEvent t e = PlotEvent { + plot_event_title_ :: String, + plot_event_data_ :: [Event t e], + -- | Linestyle with which marks for pulse events will be drawn + plot_event_pulse_linestyle_ :: e -> CairoLineStyle, + -- | Linestyle with which borders of rectangles for long events will be drawn + plot_event_long_linestyle_ :: e -> CairoLineStyle, + -- | 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_label_ :: e -> String +} + +defaultPlotEvent = PlotEvent { + plot_event_title_ = "", + plot_event_data_ = [], + 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_label_ = const "" +} + +instance ToPlot PlotEvent where + toPlot p = Plot { + plot_render_ = renderPlotEvent p, + plot_legend_ = [(plot_event_title_ p, renderPlotLegendEvent p)], + plot_all_points_ = plotAllPointsEvent p + } + +renderPlotLegendEvent :: PlotEvent t e -> Rect -> CRender () +renderPlotLegendEvent p r = return () + + +filledRect :: CairoFillStyle -> Rect -> CRender () +filledRect fs r = setFillStyle fs >> fillPath (rectPath r) + +framedRect :: CairoLineStyle -> Rect -> CRender () +framedRect ls r = setLineStyle ls >> strokePath (rectPath r) + +barHeight = 7 +pulseHeight = 15 + +renderPlotEvent :: PlotEvent t e -> PointMapFn t e -> CRender () +renderPlotEvent p pmap = do + setLineStyle $ plot_event_track_linestyle_ p + moveTo (Point x0 cy) + lineTo (Point x1 cy) + c $ C.stroke + mapM_ drawEventFill (plot_event_data_ p) + mapM_ drawEventFrame (plot_event_data_ p) + where + (Point x0 y0) = pmap (LMin,LMin) + (Point x1 y1) = pmap (LMax,LMax) + (cx,cy) = ((x0+x1)/2, (y0+y1)/2) + drawEventFill (PulseEvent t e) = return () + drawEventFill (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) + filledRect (plot_event_long_fillstyle_ p e) $ Rect + (Point x1 (cy-barHeight/2)) (Point x2 (cy+barHeight/2)) + + drawEventFrame (PulseEvent t e) = do + setLineStyle $ plot_event_pulse_linestyle_ p e + let (Point x y) = pmap (LValue t, LValue e) + 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) + framedRect (plot_event_long_linestyle_ p e) $ Rect + (Point x1 (cy-barHeight/2)) (Point x2 (cy+barHeight/2)) + +plotAllPointsEvent :: PlotEvent t e -> ([t], [e]) +plotAllPointsEvent p = let (ts, es) = unzip (map decomp d) in (concat ts, es) + where + d = plot_event_data_ p + decomp (PulseEvent t e) = ([t], e) + decomp (LongEvent (t1,_) (t2,_) e) = ([t1,t2], e) + +$( deriveAccessors ''PlotEvent ) diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,31 +1,31 @@ -Copyright (c) 2009, Eugene Kirpichov - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * The names of contributors may not be used to endorse or promote - products derived from this software without specific prior - written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +Copyright (c) 2009, Eugene Kirpichov + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * The names of contributors may not be used to endorse or promote + products derived from this software without specific prior + written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,8 +1,8 @@ -#!/usr/bin/env runghc - -module Main where - -import Distribution.Simple - -main :: IO () -main = defaultMain +#!/usr/bin/env runghc + +module Main where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/Tools/TimePlot.hs b/Tools/TimePlot.hs --- a/Tools/TimePlot.hs +++ b/Tools/TimePlot.hs @@ -1,823 +1,823 @@ -{-# LANGUAGE ScopedTypeVariables, TypeFamilies, FlexibleContexts, GADTs, CPP, ParallelListComp #-} -module Main where - -import Control.Monad -import qualified Control.Monad.Trans.State.Strict as St -import qualified Control.Monad.Trans.RWS.Strict as RWS -import Control.Arrow -import Data.List -import Data.Ord -import Data.Maybe -import qualified Data.Map as M -import qualified Data.Set as Set -import qualified Data.ByteString.Char8 as S -import qualified Data.ByteString.Lazy.Char8 as B -import Data.ByteString.Lex.Lazy.Double - -import Data.Char - -import Text.Regex.TDFA -import Text.Regex.TDFA.ByteString - -import System -import System.Exit -import System.Console.GetOpt - -import Data.Time hiding (parseTime) -import Data.Time.Parse - -import Data.Accessor - -import Graphics.Rendering.Chart -import Graphics.Rendering.Chart.Gtk -import Graphics.Rendering.Chart.Grid -import Graphics.Rendering.Chart.Plot -import Graphics.Rendering.Chart.Event - -import Data.Colour -import Data.Colour.Names - -import Debug.Trace - -data Status = Status {statusColor :: String, statusLabel :: String} deriving (Eq, Show, Ord) - -instance PlotValue Status where - toValue = const 0 - 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_grid_ = [] -} - -data Edge = Rise | Fall | Pulse Status | SetTo Status deriving (Eq,Show) - -data InEvent = InEdge {evt_track :: S.ByteString, evt_edge :: Edge} - | InValue {evt_track :: S.ByteString, evt_value :: Double} - | InAtom {evt_track :: S.ByteString, evt_atom :: S.ByteString} - deriving (Show) - -data OutFormat = PNG | PDF | PS | SVG - | Window - -class HasDelta t where - 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 - -- figure out which 't' we're speaking of) - toSeconds :: Delta t -> t -> Double - fromSeconds :: Double -> t -> Delta t - showDelta :: t -> t -> String - -instance HasDelta Double where - type Delta Double = Double - add d t = t + d - sub t2 t1 = t2 - t1 - toSeconds d _ = d - fromSeconds d _ = d - showDelta a b = show (a - b) - -instance HasDelta LocalTime where - type Delta LocalTime = NominalDiffTime - add d t = utcToLocalTime utc (addUTCTime d (localTimeToUTC utc t)) - sub t2 t1 = diffUTCTime (localTimeToUTC utc t2) (localTimeToUTC utc t1) - toSeconds d _ = fromIntegral (truncate (1000000*d)) / 1000000 - fromSeconds d _ = fromRational (toRational d) - showDelta t1 t2 - | ts0 < 0.001 = "0" - | tm < 1 = showsPrec 3 s "s" - | th < 1 = show m ++ "m" ++ (if s<1 then "" else (show (floor s) ++ "s")) - | d < 1 = show h ++ "h" ++ (if m<1 then "" else (show m ++ "m")) - | True = show d ++ "d" ++ (if h<1 then "" else (show h ++ "h")) - where ts0 = toSeconds (t1 `sub` t2) t1 - ts = if ts0 < 60 then ts0 else fromIntegral (round ts0) - tm = floor (ts / 60) :: Int - th = tm `div` 60 :: Int - s = ts - 60 * fromIntegral tm :: Double - m = tm - 60 * th :: Int - h = th - 24 * d :: Int - d = h `div` 24 :: Int - -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 - -instance TimeAxis Double - -instance TimeAxis LocalTime - -data SumSubtrackStyle = SumStacked | SumOverlayed - -data ChartKind t = KindEvent - | KindDuration { subKind :: ChartKind t } - | KindWithin { mapName :: S.ByteString -> S.ByteString, subKind :: ChartKind t } - | KindACount { binSize :: Delta t } - | KindAPercent { binSize :: Delta t, baseCount :: Double } - | KindAFreq { binSize :: Delta t } - | KindQuantile { binSize :: Delta t, quantiles :: [Double] } - | KindBinFreq { binSize :: Delta t, delims :: [Double] } - | KindBinHist { binSize :: Delta t, delims :: [Double] } - | KindFreq { binSize :: Delta t, style :: PlotBarsStyle } - | KindHistogram { binSize :: Delta t, style :: PlotBarsStyle } - | KindLines - | KindDots - | KindCumSum { subtrackStyle :: SumSubtrackStyle } - | KindSum { binSize :: Delta t, subtrackStyle :: SumSubtrackStyle } - | KindNone - -data ZoomMode = ZoomInput | ZoomOutput - -data ConcreteConf t = - ConcreteConf { - inFile :: FilePath, - parseTime :: B.ByteString -> Maybe (t, B.ByteString), - chartKindF :: S.ByteString -> [ChartKind t], - - fromTime :: Maybe t, - toTime :: Maybe t, - zoomMode :: ZoomMode, - transformLabel :: t -> String -> String, - - outFile :: FilePath, - outFormat :: OutFormat, - 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"] -> Conf $ readConf' readDouble - "date":f -> Conf $ readConf' (strptime (B.pack $ unwords f)) - _ -> error "Unrecognized time format (-tf)" - where - 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' :: 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, - transformLabel=transformLabel, zoomMode=zoomMode} - where - inFile = single "input file" "-if" (error "No input file (-if) specified") - outFile = single "output file" "-o" (error "No output file (-o) specified") - outFormat = maybe PNG id $ lookup (single "output format" "-of" (name2format outFile)) $ - [("png",PNG), ("pdf",PDF), ("ps",PS), ("svg",SVG) - , ("x",Window) - ] - 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 $ - [(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 ++ - [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) - - fromTime = fst `fmap` (parseTime . B.pack $ single "minimum time (inclusive)" "-fromTime" "") - toTime = fst `fmap` (parseTime . B.pack $ single "maximum time (exclusive)" "-toTime" "") - baseTime = fst `fmap` (parseTime . B.pack $ single "base time" "-baseTime" "") - - zoomMode = case single "zoom mode (input/output)" "-zoomMode" "input" of - "input" -> ZoomInput - "output" -> ZoomOutput - - transformLabel t s = case baseTime of - Nothing -> s - Just bt -> showDelta t bt - - parseKind ["acount", n ] = KindACount {binSize=read n} - parseKind ["apercent",n,b] = KindAPercent {binSize=read n,baseCount=read b} - parseKind ["afreq", n ] = KindAFreq {binSize=read n} - parseKind ["freq", n ] = KindFreq {binSize=read n,style=BarsClustered} - parseKind ["freq", n,s] = KindFreq {binSize=read n,style=parseStyle s} - parseKind ["hist", n ] = KindHistogram {binSize=read n,style=BarsClustered} - parseKind ["hist", n,s] = KindHistogram {binSize=read n,style=parseStyle s} - parseKind ["event" ] = KindEvent - parseKind ["quantile",b,q] = KindQuantile {binSize=read b, quantiles=read ("["++q++"]")} - parseKind ["binf", b,q] = KindBinFreq {binSize=read b, delims =read ("["++q++"]")} - parseKind ["binh", b,q] = KindBinHist {binSize=read b, delims =read ("["++q++"]")} - parseKind ["lines" ] = KindLines - parseKind ["dots" ] = KindDots - parseKind ["cumsum" ] = KindCumSum {subtrackStyle=SumStacked} - parseKind ["cumsum", s ] = KindCumSum {subtrackStyle=parseSubtrackStyle s} - parseKind ["sum", b ] = KindSum {binSize=read b, subtrackStyle=SumStacked} - parseKind ["sum", b,s] = KindSum {binSize=read b, subtrackStyle=parseSubtrackStyle s} - parseKind ("duration":ws) = KindDuration {subKind=parseKind ws} - parseKind (('w':'i':'t':'h':'i':'n':'[':sep:"]"):ws) - = KindWithin {subKind=parseKind ws, mapName = fst . S.break (==sep)} - parseKind ["none" ] = KindNone - parseKind ws = error ("Unknown diagram kind " ++ unwords ws) - - defaultKindMinus = parseKind $ words $ single "default kind" "-dk" "none" - defaultKindsPlus = map (parseKind . words . head) $ getArg "+dk" 1 args - - parseStyle "stacked" = BarsStacked - parseStyle "clustered" = BarsClustered - - parseSubtrackStyle "stacked" = SumStacked - parseSubtrackStyle "overlayed" = SumOverlayed - - --- getArg "-a" 2 ["-b", "1", "-a", "2", "q", "r", "-c", "3", "-a", "x"] = --- [["2", "q"], ["x"]] -getArg :: String -> Int -> [String] -> [[String]] -getArg name arity args = [take arity as | (t:as) <- tails args, t==name] - -readSource :: (Show t) => (B.ByteString -> Maybe (t,B.ByteString)) -> FilePath -> IO [(t, InEvent)] -readSource readTime f = (justs . map parseLine . blines) `fmap` (if f=="-" then B.getContents else B.readFile f) - where - justs xs = [x | Just x <- xs] - blines = map pruneLF . B.split '\n' - pruneLF b | not (B.null b) && (B.last b == '\r') = B.init b - | otherwise = b - strict = S.concat . B.toChunks - parseLine s = do - (t, s') <- readTime s - (_, s'') <- B.uncons s' - (c,rest) <- B.uncons s'' - case c of - '>' -> return (t, InEdge (strict rest) Rise ) - '<' -> return (t, InEdge (strict rest) Fall ) - '!' -> do - let (track, val') = B.break (==' ') rest - if B.null val' - then return (t, InEdge (strict track) (Pulse (Status "" ""))) - else do - (_,val) <- B.uncons val' - return (t, InEdge (strict track) $ Pulse (Status "" (B.unpack val))) - '@' -> do - let (track, val') = B.break (==' ') rest - (_,val) <- B.uncons val' - return (t, InEdge (strict track) $ SetTo (Status {statusColor = B.unpack $ val, statusLabel = ""})) - '=' -> do - let (track, val') = B.break (==' ') rest - (_,val) <- B.uncons val' - if B.null val - then Nothing - else do - case B.head val of - '`' -> do - return (t, InAtom (strict track) (strict $ B.tail val)) - _ -> do - (v,_ ) <- readDouble val - return (t, InValue (strict track) v) - _ -> Nothing - -makeChart :: forall t . TimeAxis t => - (S.ByteString -> [ChartKind t]) -> - [(t, InEvent)] -> - Maybe t -> Maybe t -> - ZoomMode -> - (t -> String -> String) -> - Renderable () -makeChart chartKindF [] minT maxT zoomMode transformLabel = emptyRenderable -makeChart chartKindF events0 minT maxT zoomMode transformLabel = renderLayout1sStacked plots - where - events :: [(t, InEvent)] - events@((t0,_):_) = sortBy (comparing (\(t,_)-> t)) events0 - - track2events :: M.Map S.ByteString [(t, InEvent)] - track2events = reverse `fmap` foldl' insert M.empty [(evt_track e, x) | x@(t, 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, - kind <- chartKindF k, - case kind of {KindNone -> False ; KindWithin _ _ -> False ; _ -> True} ] ++ - withinPlots - - withinPlots = [ plotWithKind name k es | (name, (k,es)) <- M.toList withinTracks ] - where - withinTracks = M.fromListWith (\(ka,as) (kb,bs) -> (ka,mergeOn fst as bs)) components - components = [ (mn k, (sk, es)) - | (k, es) <- M.toList track2events, - kind <- chartKindF k, - Just (sk,mn) <- [case kind of {KindWithin mn sk -> Just (sk,mn) ; _ -> Nothing}]] - mergeOn f [] ys = ys - mergeOn f xs [] = xs - mergeOn f (x:xs) (y:ys) - | f x <= f y = x : mergeOn f xs (y:ys) - | otherwise = y : mergeOn f (x:xs) ys - - minInTime = case (zoomMode, minT) of (ZoomInput, Just t) -> t ; _ -> head times - maxInTime = case (zoomMode, maxT) of (ZoomInput, Just t) -> t ; _ -> last times - - minOutTime = case (zoomMode, minT) of (ZoomOutput, Just t) -> t ; _ -> head times - maxOutTime = case (zoomMode, maxT) of (ZoomOutput, Just t) -> t ; _ -> last times - - times :: [t] - times = sort $ [t | tes <- M.elems track2events, (t,_)<- tes] - - commonTimeAxis :: AxisData t - commonTimeAxis = transformLabels $ autoAxis axisTimes - where - axisTimes = case zoomMode of - ZoomInput -> [minInTime] ++ times ++ [maxInTime] - ZoomOutput -> [minOutTime] ++ filter (\x -> x >= minOutTime && x <= maxOutTime) times ++ [maxOutTime] - transformLabels axis = axis { axis_labels_ = map (map (\(t, s) -> (t, transformLabel t s))) (axis_labels_ axis) } - - plotTrack :: S.ByteString -> ChartKind t -> [(t, InEvent)] -> AnyLayout1 t - plotTrack name kind es = plotWithKind name kind es - - plotWithKind :: S.ByteString -> ChartKind t -> [(t, InEvent)] -> AnyLayout1 t - plotWithKind name k es = case k of - KindACount bs -> withAnyOrdinate $ plotTrackACount name es bs - KindAPercent bs b -> withAnyOrdinate $ plotTrackAPercent name es bs b - KindAFreq bs -> withAnyOrdinate $ plotTrackAFreq name es bs - KindFreq bs k -> withAnyOrdinate $ plotTrackFreq name es bs k - KindHistogram bs k -> withAnyOrdinate $ plotTrackHist name es bs k - KindEvent -> withAnyOrdinate $ plotTrackEvent name es - KindQuantile bs qs -> withAnyOrdinate $ plotTrackQuantile name es qs bs - KindBinFreq bs vs -> withAnyOrdinate $ plotTrackBinFreqs name es vs bs - KindBinHist bs vs -> withAnyOrdinate $ plotTrackBinHist name es vs bs - KindLines -> withAnyOrdinate $ plotTrackLines name es - KindDots -> withAnyOrdinate $ plotTrackDots name es - KindSum bs ss -> withAnyOrdinate $ plotTrackSum name es bs ss - KindCumSum ss -> withAnyOrdinate $ plotTrackCumSum name es ss - KindDuration sk -> plotWithKind name sk (edges2durations (edges es) minInTime maxInTime name) - KindWithin _ _ -> error "KindDuration should not be plotted" - KindNone -> error "KindNone should not be plotted" - - edges :: [(t,InEvent)] -> [(t,S.ByteString,Edge)] - values :: [(t,InEvent)] -> [(t,S.ByteString,Double)] - atoms :: [(t,InEvent)] -> [(t,S.ByteString,S.ByteString)] - edges es = [(t,s,e) | (t,InEdge s e) <- es] - values es = [(t,s,v) | (t,InValue s v) <- es] - atoms es = [(t,s,a) | (t,InAtom s a) <- es] - - ourPlotBars :: (BarsPlotValue a) => PlotBars t a - ourPlotBars = plot_bars_spacing ^= BarsFixGap 0 0 $ - plot_bars_style ^= BarsStacked $ - plot_bars_alignment ^= BarsLeft $ - defaultPlotBars - - plotTrackActivity :: S.ByteString -> [(t,InEvent)] -> Delta t -> ([(S.ByteString, Double)] -> Double -> Double) -> Layout1 t Double - plotTrackActivity name es bs transform = layoutWithTitle [plotBars plot] name - where plot = plot_bars_values ^= barsData $ - plot_bars_item_styles ^= itemStyles $ - plot_bars_titles ^= map show subTracks $ - ourPlotBars - itemStyles = [(solidFillStyle (opaque c), Nothing) | c <- colors] - bins = edges2bins bs minInTime maxInTime (edges es) - subTracks = Set.toList $ Set.fromList [s | (_,sns) <- bins, (s,n) <- sns] - barsData = [(t, map (transform sns . fromMaybe 0 . (`lookup` sns)) subTracks) - | ((t,_),sns) <- edges2bins bs minInTime maxInTime (edges es), (s,n) <- sns] - - plotTrackACount :: S.ByteString -> [(t,InEvent)] -> Delta t -> Layout1 t Double - plotTrackACount name es bs = plotTrackActivity name es bs (\_ -> id) - - plotTrackAFreq :: S.ByteString -> [(t,InEvent)] -> Delta t -> Layout1 t Double - plotTrackAFreq name es bs = plotTrackActivity name es bs $ \sns -> - let total = (\x -> if x==0 then 1 else x) $ sum [n | (s,n) <- sns] in (/total) - - plotTrackAPercent :: S.ByteString -> [(t,InEvent)] -> Delta t -> Double -> Layout1 t Double - plotTrackAPercent name es bs b = plotTrackActivity name es bs (\_ x -> 100*x/b) - - 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 $ - plot_bars_item_styles ^= itemStyles $ - plot_bars_titles ^= "":map show vs $ - ourPlotBars - itemStyles = none:[(solidFillStyle (opaque c), Nothing) | c <- colors] - vals = byTimeBins ((0:).f vs) bs t0 as - -- TODO Multiple tracks - as = [(t,a) | (t,_,a) <- atoms es] - vs = M.keys $ M.fromList $ [(a,()) | (_,a) <- as] - - -- TODO Multiple tracks - plotTrackEvent :: S.ByteString -> [(t,InEvent)] -> Layout1 t Status - plotTrackEvent name es = layoutWithTitle [toPlot plot] name - where plot = plot_event_data ^= dropTrack (edges2events (edges es) minInTime maxInTime) $ - plot_event_long_fillstyle ^= toFillStyle $ - plot_event_label ^= toLabel $ - defaultPlotEvent - dropTrack = map snd - 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 vs) $ - plot_bars_item_styles ^= quantileStyles $ - plot_bars_titles ^= quantileTitles $ - ourPlotBars - -- TODO Multiple tracks - vs = [(t,v) | (t,_,v) <- values es] - 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)) $ [0.0] ++ qs ++ [1.0] - n = length qs - - lag :: [a] -> [(a,a)] - lag xs = xs `zip` tail xs - - colors = cycle [green,blue,red,brown,yellow,orange,grey,purple,violet,lightblue] - - binTitles vs = [low]++[show v1++".."++show v2 | (v1,v2) <- lag vs]++[high] - where - low = "<"++show (head vs) - high = ">"++show (last vs) - - binColor n i = opaque (colors !! i) - - plotTrackBinFreqs name es vs bs = plotTrackBars vals (binTitles vs) name (binColor n) - where - vals = byTimeBins ((0:).values2binFreqs vs) bs t0 tvs - n = length vs - -- TODO Multiple tracks - tvs = [(t,v) | (t,_,v) <- values es] - plotTrackBinHist name es vs bs = plotTrackBars vals (binTitles vs) name (binColor n) - where - vals = byTimeBins ((0:).values2binHist vs) bs t0 tvs - tvs = [(t,v) | (t,_,v) <- values es] - n = length vs - - plotTrackBars :: (BarsPlotValue a) => [(t,[a])] -> [String] -> S.ByteString -> (Int -> AlphaColour Double) -> Layout1 t a - plotTrackBars values titles name clr = layoutWithTitle [plotBars plot] name - where plot = plot_bars_values ^= values $ - plot_bars_item_styles ^= binStyles $ - plot_bars_titles ^= "":titles $ - ourPlotBars - binStyles = none:[(solidFillStyle (clr i), Just $ solidLine 1 (opaque black)) - | (i,_) <- [0..]`zip`titles] - - none = (solidFillStyle transparent, Nothing) - toBars tvs = [(t,diffs vs) | (t,vs) <- tvs] - diffs xs = zipWith (-) xs (0:xs) - - groupByTrack xs = M.toList $ sort `fmap` M.fromListWith (++) [(s, [(t,v)]) | (t,s,v) <- xs] - - plotLines :: S.ByteString -> [(S.ByteString, [(t,Double)])] -> Layout1 t Double - plotLines name vss = layoutWithTitle (map toPlot plots) name - where plots = [plot_lines_values ^= [vs] $ - plot_lines_title ^= S.unpack subtrack $ - plot_lines_style .> line_color ^= color $ - defaultPlotLines - | (subtrack, vs) <- vss - | color <- map opaque colors] - - plotTrackLines :: S.ByteString -> [(t,InEvent)] -> Layout1 t Double - plotTrackLines name es = plotLines name (groupByTrack (values es)) - - plotTrackDots :: S.ByteString -> [(t,InEvent)] -> Layout1 t Double - plotTrackDots name es = layoutWithTitle (map toPlot plots) name - where plots = [plot_points_values ^= vs $ - plot_points_style ^= hollowCircles 4 1 color $ - plot_points_title ^= S.unpack subtrack $ - defaultPlotPoints - | (subtrack, vs) <- groupByTrack (values es) - | color <- map opaque colors] - - plotTrackCumSum :: S.ByteString -> [(t,InEvent)] -> SumSubtrackStyle -> Layout1 t Double - plotTrackCumSum name es SumOverlayed = plotLines name rows - where rows = [(track, scanl (\(t1,s) (t2,v) -> (t2,s+v)) (minInTime, 0) vs) | (track, vs) <- groupByTrack (values es)] - plotTrackCumSum name es SumStacked = plotLines name rows - where vals = values es - allTracks = Set.toList $ Set.fromList [track | (t, track, v) <- vals] - - rows :: [(S.ByteString, [(t, Double)])] - rows = groupByTrack [(t, track, v) | (t, tvs) <- rowsT, (track,v) <- tvs] - - rowsT :: [(t, [(S.ByteString, Double)])] - rowsT = (minInTime, zip allTracks (repeat 0)) : St.evalState (mapM addDataPoint vals) M.empty - - addDataPoint (t, track, v) = do - St.modify (M.insertWith (+) track v) - st <- St.get - let trackSums = map (\x -> M.findWithDefault 0 x st) allTracks - return (t, allTracks `zip` (scanl1 (+) trackSums)) - - - plotTrackSum :: S.ByteString -> [(t,InEvent)] -> Delta t -> SumSubtrackStyle -> Layout1 t Double - plotTrackSum name es bs ss = plotLines name rows - where groups = groupByTrack (values es) - allTracks = M.keys $ M.fromList groups - - rowsT :: [(t, M.Map S.ByteString Double)] - rowsT = byTimeBins (M.fromListWith (+)) bs t0 $ sort [(t, (track, v)) | (track, vs) <- groups, (t, v) <- vs] - - rowsT' = case ss of - SumOverlayed -> map (\(t,ss) -> (t, M.toList ss)) rowsT - SumStacked -> map (\(t,ss) -> (t, stack ss)) rowsT - - stack :: M.Map S.ByteString Double -> [(S.ByteString, Double)] - stack ss = zip allTracks (scanl1 (+) (map (\x -> M.findWithDefault 0 x ss) allTracks)) - - rows :: [(S.ByteString, [(t, Double)])] - rows = M.toList $ sort `fmap` M.fromListWith (++) [(track, [(t,sum)]) | (t, m) <- rowsT', (track, sum) <- m] - - layoutWithTitle :: (PlotValue a) => [Plot t a] -> S.ByteString -> Layout1 t a - layoutWithTitle plots name = - layout1_title ^= "" $ - layout1_plots ^= map Left plots $ - layout1_bottom_axis .> laxis_generate ^= (\_ -> commonTimeAxis) $ - layout1_top_axis .> laxis_generate ^= (\_ -> commonTimeAxis) $ - layout1_left_axis .> laxis_title ^= S.unpack name $ - layout1_margin ^= 0 $ - layout1_grid_last ^= True $ - defaultLayout1 - -edges2durations :: forall t. (Ord t, HasDelta t) => [(t,S.ByteString,Edge)] -> t -> t -> S.ByteString -> [(t,InEvent)] -edges2durations tes minTime maxTime commonTrack = - [(t2, InValue commonTrack $ toSeconds (t2 `sub` t1) (undefined::t)) - | (track, LongEvent (t1,True) (t2,True) _) <- edges2events tes minTime maxTime] - -edges2events :: (Ord t) => [(t,S.ByteString,Edge)] -> t -> t -> [(S.ByteString,Event t Status)] -edges2events tes minTime maxTime = snd $ RWS.execRWS (mapM_ step tes >> flush) () M.empty - where - getTrack s = M.findWithDefault (minTime, 0, emptyStatus) s `fmap` RWS.get - putTrack s t = RWS.get >>= RWS.put . M.insert s t - trackCase s whenZero withNonzero = do - (t0, numActive, st) <- getTrack s - case numActive of - 0 -> whenZero - n -> withNonzero t0 numActive st - killTrack s = RWS.get >>= RWS.put . M.delete s - - emptyStatus = Status "" "" - - step (t,s,Pulse st) = RWS.tell [(s, PulseEvent t st)] - step (t,s,SetTo st) = trackCase s (putTrack s (t, 1, st)) - (\t0 n st0 -> RWS.tell [(s, LongEvent (t0,True) (t,True) st0)] >> - putTrack s (t, n, st)) - step (t,s,Rise) = trackCase s (putTrack s (t, 1, emptyStatus)) - (\t0 n st -> putTrack s (t, n+1, st)) - step (t,s,Fall) = do - (t0, numActive, st) <- getTrack s - case numActive of - 1 -> RWS.tell [(s, LongEvent (t0,True) (t,True) st)] >> killTrack s - n -> putTrack s (t0, max 0 (n-1), st) - - flush = RWS.get >>= mapM_ (\(s, (t0,_,st)) -> RWS.tell [(s, LongEvent (t0,True) (maxTime,False) st)]) . M.toList - -edges2bins :: forall t. (Ord t,HasDelta t,Show t) => Delta t -> t -> t -> [(t,S.ByteString,Edge)] -> [((t,t), [(S.ByteString,Double)])] -edges2bins binSize minTime maxTime es = snd $ RWS.execRWS (mapM_ step es >> flush) () (M.empty, iterate (add binSize) minTime) - where - getBin = RWS.gets $ \(m, t1:t2:ts) -> (t1, t2) - nextBin = RWS.get >>= \(m, t1:t2:ts) -> RWS.put (m, t2:ts) - getState s t = RWS.gets $ \(m, _) -> (M.findWithDefault (0,t,0,0) s m) - putState s v = RWS.get >>= \(m, ts) -> RWS.put (M.insert s v m, ts) - modState s t f = getState s t >>= putState s . f - getStates = RWS.gets (\(m,_) -> M.toList m) - - flushBin = do - bin@(t1,t2) <- getBin - states <- getStates - let binSizeSec = toSeconds (t2 `sub` t1) t1 - RWS.tell [(bin, [(s, (fromIntegral npulse + area + toSeconds (t2 `sub` start) t2*nopen)/binSizeSec) | (s,(area,start,nopen,npulse)) <- states])] - forM_ states $ \(s, (area,start,nopen,_)) -> putState s (0,t2,nopen,0) - nextBin - - step ev@(t, s, e) = do - (t1, t2) <- getBin - if t < t1 - then error "Times are not in ascending order" - else if (t >= t2) - then flushBin >> step ev - else step'' ev - step'' ev@(t,s,e) = do (t1,t2) <- getBin; when (t < t1 || t >= t2) (error "Outside bin"); step' ev - step' (t, s, SetTo _) = modState s t id - step' (t, s, Pulse _) = modState s t $ \(area, start, nopen, npulse) -> (area, start, nopen, npulse+1) - step' (t, s, Rise) = modState s t $ \(area, start, nopen, npulse) -> (area+toSeconds (t `sub` start) t*nopen, t, nopen+1, npulse) - step' (t, s, Fall) = modState s t $ \(area, start, nopen, npulse) -> (area+toSeconds (t `sub` start) t*nopen, t, nopen-1, npulse) - flush = getBin >>= \(t1,t2) -> when (t2 <= maxTime) (flushBin >> flush) - -values2timeBins :: (Ord t) => [t] -> [(t,a)] -> [[a]] -values2timeBins (t1:t2:ts) [] = [] -values2timeBins (t1:t2:ts) tvs@((t,_):_) - | t ([a] -> b) -> Delta t -> t -> [(t,a)] -> [(t, b)] -byTimeBins f binSize t0 tvs = times `zip` map f (values2timeBins times tvs) - where times = iterate (add binSize) t0 - -getQuantiles :: (Ord a) => [Double] -> [a] -> [a] -getQuantiles qs = \xs -> quantiles' (sort xs) - where - qs' = sort qs - quantiles' [] = [] - quantiles' xs = index (0:ns++[n-1]) 0 xs - where - n = length xs - ns = map (floor . (*(fromIntegral n-1))) qs' - - index _ _ [] = [] - index [] _ _ = [] - index [i] j (x:xs) - | ij = index (i:i':is) (j+1) xs - | i==i' = x:index (i':is) j (x:xs) - | True = x:index (i':is) (j+1) xs - -values2binFreqs :: (Ord a) => [a] -> [a] -> [Double] -values2binFreqs bins xs = map toFreq $ values2binHist bins xs - where - n = length xs - toFreq = if n==0 then const 0 else (\k -> fromIntegral k/fromIntegral n) -values2binHist bins xs = values2binHist' bins $ sort xs - where - values2binHist' [] xs = [length xs] - values2binHist' (a:as) xs = length xs0 : values2binHist' as xs' - where (xs0,xs') = span ( [a] -> [a] -> [Int] -atoms2hist as xs = map (maybe 0 id . (`M.lookup` m)) as - where - m = foldl' insert M.empty xs - insert m a = M.alter (Just . maybe 1 inc) a m - inc n = n `seq` (n+1) - -atoms2freqs :: (Ord a) => [a] -> [a] -> [Double] -atoms2freqs as xs = map toFreq (atoms2hist as xs) - where - n = length xs - toFreq = if n==0 then const 0 else (\k -> fromIntegral k/fromIntegral n) - -zoom :: (TimeAxis t) => [(t, InEvent)] -> Maybe t -> Maybe t -> [(t, InEvent)] -zoom events fromTime toTime = filter p events - where - p (t, _) = (maybe True (\ft -> t >= ft) fromTime) && - (maybe True (\tt -> t < tt) toTime) - -showHelp = mapM_ putStrLn [ "", - "tplot - a tool for drawing timing diagrams.", - " See http://www.haskell.org/haskellwiki/Timeplot", - "Usage: tplot [-o OFILE] [-of {png|pdf|ps|svg|x}] [-or 640x480]", - " -if IFILE [-tf TF] ", - " [{+|-}k Pat1 Kind1 {+|-}k Pat2 Kind2 ...] [{+|-}dk KindN]", - " [-fromTime TIME] [-toTime TIME] [-baseTime TIME]", - " -o OFILE - output file (required if -of is not x)", - " -of - output format (x means draw result in a window, default:", - " extension of -o)", - " -or - output resolution (default 640x480)", - " -if IFILE - input file; '-' means 'read from stdin'", - " -tf TF - time format: 'num' means that times are floating-point", - " numbers (for instance, seconds elapsed since an event);", - " 'date PATTERN' means that times are dates in the format", - " specified by PATTERN - see", - " http://linux.die.net/man/3/strptime, for example,", - " [%Y-%m-%d %H:%M:%S] parses dates like [2009-10-20 16:52:43].", - " We also support %OS for fractional seconds (i.e. %OS will", - " parse 12.4039 or 12,4039) and %^[+-][N]s for ten-powers ", - " of seconds since epoch, for example %^-3s is ms since epoch.", - " Default: 'date %Y-%m-%d %H:%M:%OS'", - " {+|-}dk - set default diagram kind", - " {+|-}k P K - set diagram kind for tracks matching regex P (in the format", - " of regex-tdfa, which is at least POSIX-compliant and", - " supports some GNU extensions) to K", - " EXPLANATION:", - " -k clauses are matched till first success, +k are all", - " matched: a track is drawn acc. to all matching +k, to +dk", - " AND ALSO to the first matching -k, or -dk if none of -k", - " match", - " -fromTime - filter records whose time is >= this time", - " (formatted according to -tf)", - " -toTime - filter records whose time is < this time", - " (formatted according to -tf)", - " -baseTime - display time difference with this value instead of absolute time", - " (formatted according to -tf)", - " -zoomMode M- whether -fromTime and -toTime filter the input or the output:", - " zooming input (dropping events outside interval) may be faster,", - " but zooming output will be more accurate for history-dependent", - " graphs like activity graphs. M is 'input' or 'output'.", - "", - "Input format: lines of the following form:", - "1234 >A - at time 1234, activity A has begun", - "1234 ... <), 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 processing durations without", - " computing them yourself. Very useful inside 'within'!", - " 'within[C] XXXX' - draw plot XXXX over events grouped by their track's name ", - " before separator 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", - " durations, use within[-] duration dots; or if you've got jobs starting", - " and finishing tasks on different machines, and you want to plot a diagram", - " showing the number of utilized machines and how this number is composed of", - " utilization by different jobs, make your trace say '>job-JOBID'...' customer, John), ", - " group the events by supertrack and for each supertrack draw a graphical track", - " using the plot type SOMETHING. It's up to SOMETHING to do something with these", - " events, e.g. 'lines' will simply draw several line plots, one per subtrack.", - " 'acount 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", - " 'what was the average number of active events or impulses per time unit ", - " within that interval'. When used inside 'within', the histogram is a stacked one,", - " with one vertical bar per subtrack in each bin.", - " 'apercent N B' is for activity percentages of a basis: like 'acount N',", - " but instead of X you get 100*X/B", - " 'afreq N' is for activity frequencies: it's like acount, but relative", - " rather than absolute - it only makes sense inside 'within', because", - " otherwise it would just always show a filled one-coloured bar in every bin.", - " 'freq N [TYPE]' is for event frequency histograms: a histogram of type", - " TYPE (stacked or clustered, default clustered) is drawn for each time", - " bin of size N, about the *frequency* of various ` events", - " 'hist N [TYPE]' is for event count histograms: a histogram of type TYPE", - " (stacked or clustered, default clustered) is drawn for each time bin", - " of size N, about the *counts* of various ` events", - " 'quantile N q1,q2,..' (example: quantile 100 0.25,0.5,0.75) - a bar chart", - " of corresponding quantiles in time bins of size N", - " 'binf N v1,v2,..' (example: binf 100 1,2,5,10) - a histogram of frequency", - " of values falling into bins min..v1, v1..v2, .., v2..max in time bins", - " of size N", - " 'binh N v1,v2,..' (example: binf 100 1,2,5,10) - a histogram of counts of", - " values falling into bins min..v1, v1..v2, .., v2..max in time bins of", - " size N", - " 'lines' - a simple line plot of numeric values. When used in 'within', ", - " gives one plot per subtrack.", - " 'dots' - a simple dot plot of numeric values. When used in 'within', ", - " gives one plot per subtrack.", - " 'cumsum [TYPE]' - a simple line plot of the sum of the numeric values.", - " When used in 'within', produce 1 subplot per subtrack. TYPE can be: ", - " 'overlayed' -> just lay the subplots over one another.", - " 'stacked' -> add them up at each point to see how subtracks contribute", - " to the total cumulative sum (default; only makes sense inside 'within')", - " 'sum N [TYPE]' - a simple line plot of the sum of the numeric values in time", - " bins of size N. N is measured in units or in seconds.", - " When used in 'within', produce 1 subplot per subtrack. TYPE used in same ", - " way as in cumsum." - ] - - -main = do - args <- getArgs - mainWithArgs args -mainWithArgs args = do - when (null args || args == ["--help"]) $ showHelp >> exitSuccess - 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 ; - Window -> \c w h f -> renderableToWindow c w h - } - case conf of - ConcreteConf { - parseTime=parseTime, inFile=inFile, chartKindF=chartKindF, - outFile=outFile, outResolution=outResolution, - fromTime=fromTime, toTime=toTime, transformLabel=transformLabel, zoomMode=zoomMode} -> do - source <- readSource parseTime inFile - let source' = case zoomMode of { - ZoomInput -> zoom source fromTime toTime ; - ZoomOutput -> source - } - let chart = makeChart chartKindF source' fromTime toTime zoomMode transformLabel - let (w,h) = outResolution - render chart w h outFile +{-# LANGUAGE ScopedTypeVariables, TypeFamilies, FlexibleContexts, GADTs, CPP, ParallelListComp #-} +module Main where + +import Control.Monad +import qualified Control.Monad.Trans.State.Strict as St +import qualified Control.Monad.Trans.RWS.Strict as RWS +import Control.Arrow +import Data.List +import Data.Ord +import Data.Maybe +import qualified Data.Map as M +import qualified Data.Set as Set +import qualified Data.ByteString.Char8 as S +import qualified Data.ByteString.Lazy.Char8 as B +import Data.ByteString.Lex.Lazy.Double + +import Data.Char + +import Text.Regex.TDFA +import Text.Regex.TDFA.ByteString + +import System +import System.Exit +import System.Console.GetOpt + +import Data.Time hiding (parseTime) +import Data.Time.Parse + +import Data.Accessor + +import Graphics.Rendering.Chart +import Graphics.Rendering.Chart.Gtk +import Graphics.Rendering.Chart.Grid +import Graphics.Rendering.Chart.Plot +import Graphics.Rendering.Chart.Event + +import Data.Colour +import Data.Colour.Names + +import Debug.Trace + +data Status = Status {statusColor :: String, statusLabel :: String} deriving (Eq, Show, Ord) + +instance PlotValue Status where + toValue = const 0 + 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_grid_ = [] +} + +data Edge = Rise | Fall | Pulse Status | SetTo Status deriving (Eq,Show) + +data InEvent = InEdge {evt_track :: S.ByteString, evt_edge :: Edge} + | InValue {evt_track :: S.ByteString, evt_value :: Double} + | InAtom {evt_track :: S.ByteString, evt_atom :: S.ByteString} + deriving (Show) + +data OutFormat = PNG | PDF | PS | SVG + | Window + +class HasDelta t where + 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 + -- figure out which 't' we're speaking of) + toSeconds :: Delta t -> t -> Double + fromSeconds :: Double -> t -> Delta t + showDelta :: t -> t -> String + +instance HasDelta Double where + type Delta Double = Double + add d t = t + d + sub t2 t1 = t2 - t1 + toSeconds d _ = d + fromSeconds d _ = d + showDelta a b = show (a - b) + +instance HasDelta LocalTime where + type Delta LocalTime = NominalDiffTime + add d t = utcToLocalTime utc (addUTCTime d (localTimeToUTC utc t)) + sub t2 t1 = diffUTCTime (localTimeToUTC utc t2) (localTimeToUTC utc t1) + toSeconds d _ = fromIntegral (truncate (1000000*d)) / 1000000 + fromSeconds d _ = fromRational (toRational d) + showDelta t1 t2 + | ts0 < 0.001 = "0" + | tm < 1 = showsPrec 3 s "s" + | th < 1 = show m ++ "m" ++ (if s<1 then "" else (show (floor s) ++ "s")) + | d < 1 = show h ++ "h" ++ (if m<1 then "" else (show m ++ "m")) + | True = show d ++ "d" ++ (if h<1 then "" else (show h ++ "h")) + where ts0 = toSeconds (t1 `sub` t2) t1 + ts = if ts0 < 60 then ts0 else fromIntegral (round ts0) + tm = floor (ts / 60) :: Int + th = tm `div` 60 :: Int + s = ts - 60 * fromIntegral tm :: Double + m = tm - 60 * th :: Int + h = th - 24 * d :: Int + d = h `div` 24 :: Int + +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 + +instance TimeAxis Double + +instance TimeAxis LocalTime + +data SumSubtrackStyle = SumStacked | SumOverlayed + +data ChartKind t = KindEvent + | KindDuration { subKind :: ChartKind t } + | KindWithin { mapName :: S.ByteString -> S.ByteString, subKind :: ChartKind t } + | KindACount { binSize :: Delta t } + | KindAPercent { binSize :: Delta t, baseCount :: Double } + | KindAFreq { binSize :: Delta t } + | KindQuantile { binSize :: Delta t, quantiles :: [Double] } + | KindBinFreq { binSize :: Delta t, delims :: [Double] } + | KindBinHist { binSize :: Delta t, delims :: [Double] } + | KindFreq { binSize :: Delta t, style :: PlotBarsStyle } + | KindHistogram { binSize :: Delta t, style :: PlotBarsStyle } + | KindLines + | KindDots + | KindCumSum { subtrackStyle :: SumSubtrackStyle } + | KindSum { binSize :: Delta t, subtrackStyle :: SumSubtrackStyle } + | KindNone + +data ZoomMode = ZoomInput | ZoomOutput + +data ConcreteConf t = + ConcreteConf { + inFile :: FilePath, + parseTime :: B.ByteString -> Maybe (t, B.ByteString), + chartKindF :: S.ByteString -> [ChartKind t], + + fromTime :: Maybe t, + toTime :: Maybe t, + zoomMode :: ZoomMode, + transformLabel :: t -> String -> String, + + outFile :: FilePath, + outFormat :: OutFormat, + 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"] -> Conf $ readConf' readDouble + "date":f -> Conf $ readConf' (strptime (B.pack $ unwords f)) + _ -> error "Unrecognized time format (-tf)" + where + 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' :: 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, + transformLabel=transformLabel, zoomMode=zoomMode} + where + inFile = single "input file" "-if" (error "No input file (-if) specified") + outFile = single "output file" "-o" (error "No output file (-o) specified") + outFormat = maybe PNG id $ lookup (single "output format" "-of" (name2format outFile)) $ + [("png",PNG), ("pdf",PDF), ("ps",PS), ("svg",SVG) + , ("x",Window) + ] + 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 $ + [(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 ++ + [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) + + fromTime = fst `fmap` (parseTime . B.pack $ single "minimum time (inclusive)" "-fromTime" "") + toTime = fst `fmap` (parseTime . B.pack $ single "maximum time (exclusive)" "-toTime" "") + baseTime = fst `fmap` (parseTime . B.pack $ single "base time" "-baseTime" "") + + zoomMode = case single "zoom mode (input/output)" "-zoomMode" "input" of + "input" -> ZoomInput + "output" -> ZoomOutput + + transformLabel t s = case baseTime of + Nothing -> s + Just bt -> showDelta t bt + + parseKind ["acount", n ] = KindACount {binSize=read n} + parseKind ["apercent",n,b] = KindAPercent {binSize=read n,baseCount=read b} + parseKind ["afreq", n ] = KindAFreq {binSize=read n} + parseKind ["freq", n ] = KindFreq {binSize=read n,style=BarsClustered} + parseKind ["freq", n,s] = KindFreq {binSize=read n,style=parseStyle s} + parseKind ["hist", n ] = KindHistogram {binSize=read n,style=BarsClustered} + parseKind ["hist", n,s] = KindHistogram {binSize=read n,style=parseStyle s} + parseKind ["event" ] = KindEvent + parseKind ["quantile",b,q] = KindQuantile {binSize=read b, quantiles=read ("["++q++"]")} + parseKind ["binf", b,q] = KindBinFreq {binSize=read b, delims =read ("["++q++"]")} + parseKind ["binh", b,q] = KindBinHist {binSize=read b, delims =read ("["++q++"]")} + parseKind ["lines" ] = KindLines + parseKind ["dots" ] = KindDots + parseKind ["cumsum" ] = KindCumSum {subtrackStyle=SumStacked} + parseKind ["cumsum", s ] = KindCumSum {subtrackStyle=parseSubtrackStyle s} + parseKind ["sum", b ] = KindSum {binSize=read b, subtrackStyle=SumStacked} + parseKind ["sum", b,s] = KindSum {binSize=read b, subtrackStyle=parseSubtrackStyle s} + parseKind ("duration":ws) = KindDuration {subKind=parseKind ws} + parseKind (('w':'i':'t':'h':'i':'n':'[':sep:"]"):ws) + = KindWithin {subKind=parseKind ws, mapName = fst . S.break (==sep)} + parseKind ["none" ] = KindNone + parseKind ws = error ("Unknown diagram kind " ++ unwords ws) + + defaultKindMinus = parseKind $ words $ single "default kind" "-dk" "none" + defaultKindsPlus = map (parseKind . words . head) $ getArg "+dk" 1 args + + parseStyle "stacked" = BarsStacked + parseStyle "clustered" = BarsClustered + + parseSubtrackStyle "stacked" = SumStacked + parseSubtrackStyle "overlayed" = SumOverlayed + + +-- getArg "-a" 2 ["-b", "1", "-a", "2", "q", "r", "-c", "3", "-a", "x"] = +-- [["2", "q"], ["x"]] +getArg :: String -> Int -> [String] -> [[String]] +getArg name arity args = [take arity as | (t:as) <- tails args, t==name] + +readSource :: (Show t) => (B.ByteString -> Maybe (t,B.ByteString)) -> FilePath -> IO [(t, InEvent)] +readSource readTime f = (justs . map parseLine . blines) `fmap` (if f=="-" then B.getContents else B.readFile f) + where + justs xs = [x | Just x <- xs] + blines = map pruneLF . B.split '\n' + pruneLF b | not (B.null b) && (B.last b == '\r') = B.init b + | otherwise = b + strict = S.concat . B.toChunks + parseLine s = do + (t, s') <- readTime s + (_, s'') <- B.uncons s' + (c,rest) <- B.uncons s'' + case c of + '>' -> return (t, InEdge (strict rest) Rise ) + '<' -> return (t, InEdge (strict rest) Fall ) + '!' -> do + let (track, val') = B.break (==' ') rest + if B.null val' + then return (t, InEdge (strict track) (Pulse (Status "" ""))) + else do + (_,val) <- B.uncons val' + return (t, InEdge (strict track) $ Pulse (Status "" (B.unpack val))) + '@' -> do + let (track, val') = B.break (==' ') rest + (_,val) <- B.uncons val' + return (t, InEdge (strict track) $ SetTo (Status {statusColor = B.unpack $ val, statusLabel = ""})) + '=' -> do + let (track, val') = B.break (==' ') rest + (_,val) <- B.uncons val' + if B.null val + then Nothing + else do + case B.head val of + '`' -> do + return (t, InAtom (strict track) (strict $ B.tail val)) + _ -> do + (v,_ ) <- readDouble val + return (t, InValue (strict track) v) + _ -> Nothing + +makeChart :: forall t . TimeAxis t => + (S.ByteString -> [ChartKind t]) -> + [(t, InEvent)] -> + Maybe t -> Maybe t -> + ZoomMode -> + (t -> String -> String) -> + Renderable () +makeChart chartKindF [] minT maxT zoomMode transformLabel = emptyRenderable +makeChart chartKindF events0 minT maxT zoomMode transformLabel = renderLayout1sStacked plots + where + events :: [(t, InEvent)] + events@((t0,_):_) = {-# SCC "sortEvents" #-} sortBy (comparing (\(t,_)-> t)) events0 + + track2events :: M.Map S.ByteString [(t, InEvent)] + track2events = {-# SCC "track2events" #-} reverse `fmap` foldl' insert M.empty [(evt_track e, x) | x@(t, e) <- events] + where insert m (s, r) = M.alter (Just . maybe [r] (r:)) s m + + plots = {-# SCC "plots" #-} [ plotTrack k kind es | (k, es) <- M.toList track2events, + kind <- chartKindF k, + case kind of {KindNone -> False ; KindWithin _ _ -> False ; _ -> True} ] ++ + withinPlots + + withinPlots = {-# SCC "withinPlots" #-} [ plotWithKind name k es | (name, (k,es)) <- M.toList withinTracks ] + where + withinTracks = {-# SCC "withinTracks" #-} M.fromListWith (\(ka,as) (kb,bs) -> (ka,mergeOn fst as bs)) components + components = {-# SCC "components" #-} [ (mn k, (sk, es)) + | (k, es) <- M.toList track2events, + kind <- chartKindF k, + Just (sk,mn) <- [case kind of {KindWithin mn sk -> Just (sk,mn) ; _ -> Nothing}]] + mergeOn f [] ys = ys + mergeOn f xs [] = xs + mergeOn f (x:xs) (y:ys) + | f x <= f y = x : mergeOn f xs (y:ys) + | otherwise = y : mergeOn f (x:xs) ys + + minInTime = case (zoomMode, minT) of (ZoomInput, Just t) -> t ; _ -> head times + maxInTime = case (zoomMode, maxT) of (ZoomInput, Just t) -> t ; _ -> last times + + minOutTime = case (zoomMode, minT) of (ZoomOutput, Just t) -> t ; _ -> head times + maxOutTime = case (zoomMode, maxT) of (ZoomOutput, Just t) -> t ; _ -> last times + + times :: [t] + times = {-# SCC "times" #-} sort $ [t | tes <- M.elems track2events, (t,_)<- tes] + + commonTimeAxis :: AxisData t + commonTimeAxis = {-# SCC "commonTimeAxis" #-} transformLabels $ autoAxis axisTimes + where + axisTimes = case zoomMode of + ZoomInput -> [minInTime] ++ times ++ [maxInTime] + ZoomOutput -> [minOutTime] ++ filter (\x -> x >= minOutTime && x <= maxOutTime) times ++ [maxOutTime] + transformLabels axis = axis { axis_labels_ = map (map (\(t, s) -> (t, transformLabel t s))) (axis_labels_ axis) } + + plotTrack :: S.ByteString -> ChartKind t -> [(t, InEvent)] -> AnyLayout1 t + plotTrack name kind es = {-# SCC "plotTrack" #-} plotWithKind name kind es + + plotWithKind :: S.ByteString -> ChartKind t -> [(t, InEvent)] -> AnyLayout1 t + plotWithKind name k es = {-# SCC "plotWithKind" #-} case k of + KindACount bs -> withAnyOrdinate $ plotTrackACount name es bs + KindAPercent bs b -> withAnyOrdinate $ plotTrackAPercent name es bs b + KindAFreq bs -> withAnyOrdinate $ plotTrackAFreq name es bs + KindFreq bs k -> withAnyOrdinate $ plotTrackFreq name es bs k + KindHistogram bs k -> withAnyOrdinate $ plotTrackHist name es bs k + KindEvent -> withAnyOrdinate $ plotTrackEvent name es + KindQuantile bs qs -> withAnyOrdinate $ plotTrackQuantile name es qs bs + KindBinFreq bs vs -> withAnyOrdinate $ plotTrackBinFreqs name es vs bs + KindBinHist bs vs -> withAnyOrdinate $ plotTrackBinHist name es vs bs + KindLines -> withAnyOrdinate $ plotTrackLines name es + KindDots -> withAnyOrdinate $ plotTrackDots name es + KindSum bs ss -> withAnyOrdinate $ plotTrackSum name es bs ss + KindCumSum ss -> withAnyOrdinate $ plotTrackCumSum name es ss + KindDuration sk -> plotWithKind name sk (edges2durations (edges es) minInTime maxInTime name) + KindWithin _ _ -> error "KindDuration should not be plotted" + KindNone -> error "KindNone should not be plotted" + + edges :: [(t,InEvent)] -> [(t,S.ByteString,Edge)] + values :: [(t,InEvent)] -> [(t,S.ByteString,Double)] + atoms :: [(t,InEvent)] -> [(t,S.ByteString,S.ByteString)] + edges es = [(t,s,e) | (t,InEdge s e) <- es] + values es = [(t,s,v) | (t,InValue s v) <- es] + atoms es = [(t,s,a) | (t,InAtom s a) <- es] + + ourPlotBars :: (BarsPlotValue a) => PlotBars t a + ourPlotBars = plot_bars_spacing ^= BarsFixGap 0 0 $ + plot_bars_style ^= BarsStacked $ + plot_bars_alignment ^= BarsLeft $ + defaultPlotBars + + plotTrackActivity :: S.ByteString -> [(t,InEvent)] -> Delta t -> ([(S.ByteString, Double)] -> Double -> Double) -> Layout1 t Double + plotTrackActivity name es bs transform = {-# SCC "plotTrackActivity" #-} layoutWithTitle [plotBars plot] name + where plot = plot_bars_values ^= barsData $ + plot_bars_item_styles ^= itemStyles $ + plot_bars_titles ^= map show subTracks $ + ourPlotBars + itemStyles = [(solidFillStyle (opaque c), Nothing) | c <- colors] + bins = edges2bins bs minInTime maxInTime (edges es) + subTracks = Set.toList $ Set.fromList [s | (_,sns) <- bins, (s,n) <- sns] + barsData = [(t, map (transform sns . fromMaybe 0 . (`lookup` sns)) subTracks) + | ((t,_),sns) <- edges2bins bs minInTime maxInTime (edges es), (s,n) <- sns] + + plotTrackACount :: S.ByteString -> [(t,InEvent)] -> Delta t -> Layout1 t Double + plotTrackACount name es bs = plotTrackActivity name es bs (\_ -> id) + + plotTrackAFreq :: S.ByteString -> [(t,InEvent)] -> Delta t -> Layout1 t Double + plotTrackAFreq name es bs = plotTrackActivity name es bs $ \sns -> + let total = (\x -> if x==0 then 1 else x) $ sum [n | (s,n) <- sns] in (/total) + + plotTrackAPercent :: S.ByteString -> [(t,InEvent)] -> Delta t -> Double -> Layout1 t Double + plotTrackAPercent name es bs b = plotTrackActivity name es bs (\_ x -> 100*x/b) + + 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 $ + plot_bars_item_styles ^= itemStyles $ + plot_bars_titles ^= "":map show vs $ + ourPlotBars + itemStyles = none:[(solidFillStyle (opaque c), Nothing) | c <- colors] + vals = byTimeBins ((0:).f vs) bs t0 as + -- TODO Multiple tracks + as = [(t,a) | (t,_,a) <- atoms es] + vs = M.keys $ M.fromList $ [(a,()) | (_,a) <- as] + + -- TODO Multiple tracks + plotTrackEvent :: S.ByteString -> [(t,InEvent)] -> Layout1 t Status + plotTrackEvent name es = layoutWithTitle [toPlot plot] name + where plot = plot_event_data ^= dropTrack (edges2events (edges es) minInTime maxInTime) $ + plot_event_long_fillstyle ^= toFillStyle $ + plot_event_label ^= toLabel $ + defaultPlotEvent + dropTrack = map snd + 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 vs) $ + plot_bars_item_styles ^= quantileStyles $ + plot_bars_titles ^= quantileTitles $ + ourPlotBars + -- TODO Multiple tracks + vs = [(t,v) | (t,_,v) <- values es] + quantileStyles = none:(zip (map (solidFillStyle . opaque) colors) [Nothing | i <- [0..n+1]]) + quantileTitles = [""]++[show p1++".."++show p2++"%" | (p1,p2) <- lag percents ] + 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,red,brown,yellow,orange,grey,purple,violet,lightblue] + + binTitles vs = [low]++[show v1++".."++show v2 | (v1,v2) <- lag vs]++[high] + where + low = "<"++show (head vs) + high = ">"++show (last vs) + + binColor n i = opaque (colors !! i) + + plotTrackBinFreqs name es vs bs = plotTrackBars vals (binTitles vs) name (binColor n) + where + vals = byTimeBins ((0:).values2binFreqs vs) bs t0 tvs + n = length vs + -- TODO Multiple tracks + tvs = [(t,v) | (t,_,v) <- values es] + plotTrackBinHist name es vs bs = plotTrackBars vals (binTitles vs) name (binColor n) + where + vals = byTimeBins ((0:).values2binHist vs) bs t0 tvs + tvs = [(t,v) | (t,_,v) <- values es] + n = length vs + + plotTrackBars :: (BarsPlotValue a) => [(t,[a])] -> [String] -> S.ByteString -> (Int -> AlphaColour Double) -> Layout1 t a + plotTrackBars values titles name clr = layoutWithTitle [plotBars plot] name + where plot = plot_bars_values ^= values $ + plot_bars_item_styles ^= binStyles $ + plot_bars_titles ^= "":titles $ + ourPlotBars + binStyles = none:[(solidFillStyle (clr i), Nothing) + | (i,_) <- [0..]`zip`titles] + + none = (solidFillStyle transparent, Nothing) + toBars tvs = [(t,diffs vs) | (t,vs) <- tvs] + diffs xs = zipWith (-) xs (0:xs) + + groupByTrack xs = {-# SCC "groupByTrack" #-} M.toList $ sort `fmap` M.fromListWith (++) [(s, [(t,v)]) | (t,s,v) <- xs] + + plotLines :: S.ByteString -> [(S.ByteString, [(t,Double)])] -> Layout1 t Double + plotLines name vss = layoutWithTitle (map toPlot plots) name + where plots = [plot_lines_values ^= [vs] $ + plot_lines_title ^= S.unpack subtrack $ + plot_lines_style .> line_color ^= color $ + defaultPlotLines + | (subtrack, vs) <- vss + | color <- map opaque colors] + + plotTrackLines :: S.ByteString -> [(t,InEvent)] -> Layout1 t Double + plotTrackLines name es = plotLines name (groupByTrack (values es)) + + plotTrackDots :: S.ByteString -> [(t,InEvent)] -> Layout1 t Double + plotTrackDots name es = layoutWithTitle (map toPlot plots) name + where plots = [plot_points_values ^= vs $ + plot_points_style ^= hollowCircles 4 1 color $ + plot_points_title ^= S.unpack subtrack $ + defaultPlotPoints + | (subtrack, vs) <- {-# SCC "inDots" #-} groupByTrack (values es) + | color <- map opaque colors] + + plotTrackCumSum :: S.ByteString -> [(t,InEvent)] -> SumSubtrackStyle -> Layout1 t Double + plotTrackCumSum name es SumOverlayed = plotLines name rows + where rows = [(track, scanl (\(t1,s) (t2,v) -> (t2,s+v)) (minInTime, 0) vs) | (track, vs) <- groupByTrack (values es)] + plotTrackCumSum name es SumStacked = plotLines name rows + where vals = values es + allTracks = Set.toList $ Set.fromList [track | (t, track, v) <- vals] + + rows :: [(S.ByteString, [(t, Double)])] + rows = groupByTrack [(t, track, v) | (t, tvs) <- rowsT, (track,v) <- tvs] + + rowsT :: [(t, [(S.ByteString, Double)])] + rowsT = (minInTime, zip allTracks (repeat 0)) : St.evalState (mapM addDataPoint vals) M.empty + + addDataPoint (t, track, v) = do + St.modify (M.insertWith (+) track v) + st <- St.get + let trackSums = map (\x -> M.findWithDefault 0 x st) allTracks + return (t, allTracks `zip` (scanl1 (+) trackSums)) + + + plotTrackSum :: S.ByteString -> [(t,InEvent)] -> Delta t -> SumSubtrackStyle -> Layout1 t Double + plotTrackSum name es bs ss = plotLines name rows + where groups = groupByTrack (values es) + allTracks = M.keys $ M.fromList groups + + rowsT :: [(t, M.Map S.ByteString Double)] + rowsT = byTimeBins (M.fromListWith (+)) bs t0 $ sort [(t, (track, v)) | (track, vs) <- groups, (t, v) <- vs] + + rowsT' = case ss of + SumOverlayed -> map (\(t,ss) -> (t, M.toList ss)) rowsT + SumStacked -> map (\(t,ss) -> (t, stack ss)) rowsT + + stack :: M.Map S.ByteString Double -> [(S.ByteString, Double)] + stack ss = zip allTracks (scanl1 (+) (map (\x -> M.findWithDefault 0 x ss) allTracks)) + + rows :: [(S.ByteString, [(t, Double)])] + rows = M.toList $ sort `fmap` M.fromListWith (++) [(track, [(t,sum)]) | (t, m) <- rowsT', (track, sum) <- m] + + layoutWithTitle :: (PlotValue a) => [Plot t a] -> S.ByteString -> Layout1 t a + layoutWithTitle plots name = + layout1_title ^= "" $ + layout1_plots ^= map Left plots $ + layout1_bottom_axis .> laxis_generate ^= (\_ -> commonTimeAxis) $ + layout1_top_axis .> laxis_generate ^= (\_ -> commonTimeAxis) $ + layout1_left_axis .> laxis_title ^= S.unpack name $ + layout1_margin ^= 0 $ + layout1_grid_last ^= True $ + defaultLayout1 + +edges2durations :: forall t. (Ord t, HasDelta t) => [(t,S.ByteString,Edge)] -> t -> t -> S.ByteString -> [(t,InEvent)] +edges2durations tes minTime maxTime commonTrack = + [(t2, InValue commonTrack $ toSeconds (t2 `sub` t1) (undefined::t)) + | (track, LongEvent (t1,True) (t2,True) _) <- edges2events tes minTime maxTime] + +edges2events :: (Ord t) => [(t,S.ByteString,Edge)] -> t -> t -> [(S.ByteString,Event t Status)] +edges2events tes minTime maxTime = snd $ RWS.execRWS (mapM_ step tes >> flush) () M.empty + where + getTrack s = M.findWithDefault (minTime, 0, emptyStatus) s `fmap` RWS.get + putTrack s t = RWS.get >>= RWS.put . M.insert s t + trackCase s whenZero withNonzero = do + (t0, numActive, st) <- getTrack s + case numActive of + 0 -> whenZero + n -> withNonzero t0 numActive st + killTrack s = RWS.get >>= RWS.put . M.delete s + + emptyStatus = Status "" "" + + step (t,s,Pulse st) = RWS.tell [(s, PulseEvent t st)] + step (t,s,SetTo st) = trackCase s (putTrack s (t, 1, st)) + (\t0 n st0 -> RWS.tell [(s, LongEvent (t0,True) (t,True) st0)] >> + putTrack s (t, n, st)) + step (t,s,Rise) = trackCase s (putTrack s (t, 1, emptyStatus)) + (\t0 n st -> putTrack s (t, n+1, st)) + step (t,s,Fall) = do + (t0, numActive, st) <- getTrack s + case numActive of + 1 -> RWS.tell [(s, LongEvent (t0,True) (t,True) st)] >> killTrack s + n -> putTrack s (t0, max 0 (n-1), st) + + flush = RWS.get >>= mapM_ (\(s, (t0,_,st)) -> RWS.tell [(s, LongEvent (t0,True) (maxTime,False) st)]) . M.toList + +edges2bins :: forall t. (Ord t,HasDelta t,Show t) => Delta t -> t -> t -> [(t,S.ByteString,Edge)] -> [((t,t), [(S.ByteString,Double)])] +edges2bins binSize minTime maxTime es = snd $ RWS.execRWS (mapM_ step es >> flush) () (M.empty, iterate (add binSize) minTime) + where + getBin = RWS.gets $ \(m, t1:t2:ts) -> (t1, t2) + nextBin = RWS.get >>= \(m, t1:t2:ts) -> RWS.put (m, t2:ts) + getState s t = RWS.gets $ \(m, _) -> (M.findWithDefault (0,t,0,0) s m) + putState s v = RWS.get >>= \(m, ts) -> RWS.put (M.insert s v m, ts) + modState s t f = getState s t >>= putState s . f + getStates = RWS.gets (\(m,_) -> M.toList m) + + flushBin = do + bin@(t1,t2) <- getBin + states <- getStates + let binSizeSec = toSeconds (t2 `sub` t1) t1 + RWS.tell [(bin, [(s, (fromIntegral npulse/binSizeSec + area + toSeconds (t2 `sub` start) t2*nopen)/binSizeSec) | (s,(area,start,nopen,npulse)) <- states])] + forM_ states $ \(s, (area,start,nopen,_)) -> putState s (0,t2,nopen,0) + nextBin + + step ev@(t, s, e) = do + (t1, t2) <- getBin + if t < t1 + then error "Times are not in ascending order" + else if (t >= t2) + then flushBin >> step ev + else step'' ev + step'' ev@(t,s,e) = do (t1,t2) <- getBin; when (t < t1 || t >= t2) (error "Outside bin"); step' ev + step' (t, s, SetTo _) = modState s t id + step' (t, s, Pulse _) = modState s t $ \(area, start, nopen, npulse) -> (area, t, nopen, npulse+1) + step' (t, s, Rise) = modState s t $ \(area, start, nopen, npulse) -> (area+toSeconds (t `sub` start) t*nopen, t, nopen+1, npulse) + step' (t, s, Fall) = modState s t $ \(area, start, nopen, npulse) -> (area+toSeconds (t `sub` start) t*nopen, t, nopen-1, npulse) + flush = getBin >>= \(t1,t2) -> when (t2 <= maxTime) (flushBin >> flush) + +values2timeBins :: (Ord t) => [t] -> [(t,a)] -> [[a]] +values2timeBins (t1:t2:ts) [] = [] +values2timeBins (t1:t2:ts) tvs@((t,_):_) + | t ([a] -> b) -> Delta t -> t -> [(t,a)] -> [(t, b)] +byTimeBins f binSize t0 tvs = times `zip` map f (values2timeBins times tvs) + where times = iterate (add binSize) t0 + +getQuantiles :: (Ord a) => [Double] -> [a] -> [a] +getQuantiles qs = \xs -> quantiles' (sort xs) + where + qs' = sort qs + quantiles' [] = [] + quantiles' xs = index (0:ns++[n-1]) 0 xs + where + n = length xs + ns = map (floor . (*(fromIntegral n-1))) qs' + + index _ _ [] = [] + index [] _ _ = [] + index [i] j (x:xs) + | ij = index (i:i':is) (j+1) xs + | i==i' = x:index (i':is) j (x:xs) + | True = x:index (i':is) (j+1) xs + +values2binFreqs :: (Ord a) => [a] -> [a] -> [Double] +values2binFreqs bins xs = map toFreq $ values2binHist bins xs + where + n = length xs + toFreq = if n==0 then const 0 else (\k -> fromIntegral k/fromIntegral n) +values2binHist bins xs = values2binHist' bins $ sort xs + where + values2binHist' [] xs = [length xs] + values2binHist' (a:as) xs = length xs0 : values2binHist' as xs' + where (xs0,xs') = span ( [a] -> [a] -> [Int] +atoms2hist as xs = map (maybe 0 id . (`M.lookup` m)) as + where + m = foldl' insert M.empty xs + insert m a = M.alter (Just . maybe 1 inc) a m + inc n = n `seq` (n+1) + +atoms2freqs :: (Ord a) => [a] -> [a] -> [Double] +atoms2freqs as xs = map toFreq (atoms2hist as xs) + where + n = length xs + toFreq = if n==0 then const 0 else (\k -> fromIntegral k/fromIntegral n) + +zoom :: (TimeAxis t) => [(t, InEvent)] -> Maybe t -> Maybe t -> [(t, InEvent)] +zoom events fromTime toTime = filter p events + where + p (t, _) = (maybe True (\ft -> t >= ft) fromTime) && + (maybe True (\tt -> t < tt) toTime) + +showHelp = mapM_ putStrLn [ "", + "tplot - a tool for drawing timing diagrams.", + " See http://www.haskell.org/haskellwiki/Timeplot", + "Usage: tplot [-o OFILE] [-of {png|pdf|ps|svg|x}] [-or 640x480]", + " -if IFILE [-tf TF] ", + " [{+|-}k Pat1 Kind1 {+|-}k Pat2 Kind2 ...] [{+|-}dk KindN]", + " [-fromTime TIME] [-toTime TIME] [-baseTime TIME]", + " -o OFILE - output file (required if -of is not x)", + " -of - output format (x means draw result in a window, default:", + " extension of -o)", + " -or - output resolution (default 640x480)", + " -if IFILE - input file; '-' means 'read from stdin'", + " -tf TF - time format: 'num' means that times are floating-point", + " numbers (for instance, seconds elapsed since an event);", + " 'date PATTERN' means that times are dates in the format", + " specified by PATTERN - see", + " http://linux.die.net/man/3/strptime, for example,", + " [%Y-%m-%d %H:%M:%S] parses dates like [2009-10-20 16:52:43].", + " We also support %OS for fractional seconds (i.e. %OS will", + " parse 12.4039 or 12,4039) and %^[+-][N]s for ten-powers ", + " of seconds since epoch, for example %^-3s is ms since epoch.", + " Default: 'date %Y-%m-%d %H:%M:%OS'", + " {+|-}dk - set default diagram kind", + " {+|-}k P K - set diagram kind for tracks matching regex P (in the format", + " of regex-tdfa, which is at least POSIX-compliant and", + " supports some GNU extensions) to K", + " EXPLANATION:", + " -k clauses are matched till first success, +k are all", + " matched: a track is drawn acc. to all matching +k, to +dk", + " AND ALSO to the first matching -k, or -dk if none of -k", + " match", + " -fromTime - filter records whose time is >= this time", + " (formatted according to -tf)", + " -toTime - filter records whose time is < this time", + " (formatted according to -tf)", + " -baseTime - display time difference with this value instead of absolute time", + " (formatted according to -tf)", + " -zoomMode M- whether -fromTime and -toTime filter the input or the output:", + " zooming input (dropping events outside interval) may be faster,", + " but zooming output will be more accurate for history-dependent", + " graphs like activity graphs. M is 'input' or 'output'.", + "", + "Input format: lines of the following form:", + "1234 >A - at time 1234, activity A has begun", + "1234 ... <), 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 processing durations without", + " computing them yourself. Very useful inside 'within'!", + " 'within[C] XXXX' - draw plot XXXX over events grouped by their track's name ", + " before separator 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", + " durations, use within[-] duration dots; or if you've got jobs starting", + " and finishing tasks on different machines, and you want to plot a diagram", + " showing the number of utilized machines and how this number is composed of", + " utilization by different jobs, make your trace say '>job-JOBID'...' customer, John), ", + " group the events by supertrack and for each supertrack draw a graphical track", + " using the plot type SOMETHING. It's up to SOMETHING to do something with these", + " events, e.g. 'lines' will simply draw several line plots, one per subtrack.", + " 'acount 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", + " 'what was the average number of active events or impulses in that", + " interval'. When used inside 'within', the histogram is a stacked one,", + " with one vertical bar per subtrack in each bin.", + " 'apercent N B' is for activity percentages of a basis: like 'acount N',", + " but instead of X you get 100*X/B", + " 'afreq N' is for activity frequencies: it's like acount, but relative", + " rather than absolute - it only makes sense inside 'within', because", + " otherwise it would just always show a filled one-coloured bar in every bin.", + " 'freq N [TYPE]' is for event frequency histograms: a histogram of type", + " TYPE (stacked or clustered, default clustered) is drawn for each time", + " bin of size N, about the *frequency* of various ` events", + " 'hist N [TYPE]' is for event count histograms: a histogram of type TYPE", + " (stacked or clustered, default clustered) is drawn for each time bin", + " of size N, about the *counts* of various ` events", + " 'quantile N q1,q2,..' (example: quantile 100 0.25,0.5,0.75) - a bar chart", + " of corresponding quantiles in time bins of size N", + " 'binf N v1,v2,..' (example: binf 100 1,2,5,10) - a histogram of frequency", + " of values falling into bins min..v1, v1..v2, .., v2..max in time bins", + " of size N", + " 'binh N v1,v2,..' (example: binf 100 1,2,5,10) - a histogram of counts of", + " values falling into bins min..v1, v1..v2, .., v2..max in time bins of", + " size N", + " 'lines' - a simple line plot of numeric values. When used in 'within', ", + " gives one plot per subtrack.", + " 'dots' - a simple dot plot of numeric values. When used in 'within', ", + " gives one plot per subtrack.", + " 'cumsum [TYPE]' - a simple line plot of the sum of the numeric values.", + " When used in 'within', produce 1 subplot per subtrack. TYPE can be: ", + " 'overlayed' -> just lay the subplots over one another.", + " 'stacked' -> add them up at each point to see how subtracks contribute", + " to the total cumulative sum (default; only makes sense inside 'within')", + " 'sum N [TYPE]' - a simple line plot of the sum of the numeric values in time", + " bins of size N. N is measured in units or in seconds.", + " When used in 'within', produce 1 subplot per subtrack. TYPE used in same ", + " way as in cumsum." + ] + + +main = do + args <- getArgs + mainWithArgs args +mainWithArgs args = do + when (null args || args == ["--help"]) $ showHelp >> exitSuccess + 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 ; + Window -> \c w h f -> renderableToWindow c w h + } + case conf of + ConcreteConf { + parseTime=parseTime, inFile=inFile, chartKindF=chartKindF, + outFile=outFile, outResolution=outResolution, + fromTime=fromTime, toTime=toTime, transformLabel=transformLabel, zoomMode=zoomMode} -> do + source <- readSource parseTime inFile + let source' = case zoomMode of { + ZoomInput -> zoom source fromTime toTime ; + ZoomOutput -> source + } + let chart = makeChart chartKindF source' fromTime toTime zoomMode transformLabel + let (w,h) = outResolution + render chart w h outFile diff --git a/timeplot.cabal b/timeplot.cabal --- a/timeplot.cabal +++ b/timeplot.cabal @@ -1,33 +1,33 @@ -name: timeplot -version: 0.3.7 -cabal-version: >=1.6 -build-type: Simple -license: BSD3 -license-file: LICENSE -copyright: Eugene Kirpichov, 2009-2011 -maintainer: Eugene Kirpichov -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: - or download: - . -category: Graphics -author: Eugene Kirpichov -source-repository head - type: git - location: git://github.com/jkff/timeplot.git - -executable tplot - main-is: Tools/TimePlot.hs - buildable: True - ghc-options: -O2 -rtsopts - 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, - transformers -any +name: timeplot +version: 0.3.8 +cabal-version: >=1.6 +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: Eugene Kirpichov, 2009-2011 +maintainer: Eugene Kirpichov +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: + or download: + . +category: Graphics +author: Eugene Kirpichov +source-repository head + type: git + location: git://github.com/jkff/timeplot.git + +executable tplot + main-is: Tools/TimePlot.hs + buildable: True + ghc-options: -rtsopts + 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, + transformers -any