splot (empty) → 0.1.0

raw patch · 4 files changed

+179/−0 lines, 4 filesdep +Chartdep +basedep +bytestringsetup-changed

Dependencies added: Chart, base, bytestring, bytestring-lexing, cairo, colour, containers, haskell98, mtl, strptime, time

Files

LICENSE +31/−0
Setup.hs +8/−0
Tools/StatePlot.hs +113/−0
splot.cabal +27/−0

+ LICENSE view

@@ -0,0 +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.

+ Setup.hs view

@@ -0,0 +1,8 @@+#!/usr/bin/env runghc++module Main where++import Distribution.Simple++main :: IO ()+main = defaultMain

+ Tools/StatePlot.hs view

@@ -0,0 +1,113 @@+module Main where++import Control.Monad.Writer+import Control.Monad.State+import qualified Data.Map as M+import Data.List+import Data.Ord+import Data.Function+import Debug.Trace+import Data.Maybe+import Data.Time+import Data.Time.Parse+import System (getArgs)+import qualified Data.ByteString.Char8 as B+import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Renderable+import Graphics.Rendering.Chart.Gtk+import qualified Graphics.Rendering.Cairo as C+import Data.Colour+import Data.Colour.Names++data Event = Event {time :: LocalTime, track :: String, edge :: Edge} deriving (Show)+data Edge = Begin { color :: String } | End deriving (Show)++getArg :: String -> String -> [String] -> String+getArg name def args = case [(k,v) | (k,v) <- zip args (tail args), k==("-"++name)] of+  (_,v):_ -> v+  _       -> def++parse :: (B.ByteString -> (LocalTime, B.ByteString)) -> B.ByteString -> Event+parse parseTime s = Event { time = ts, track = B.unpack $ B.tail track', edge = edge }+  where+    (ts, s') = parseTime s+    (track', color) = B.break (==' ') (B.tail s')+    edge = case (B.head track') of+      '>' -> Begin (B.unpack (B.tail color))+      '<' -> End++diffToMillis :: LocalTime -> LocalTime -> Double+diffToMillis t2 t1 = fromIntegral (truncate (1000000*d)) / 1000+ where d = diffUTCTime (localTimeToUTC utc t2) (localTimeToUTC utc t1)++renderEvents :: Double -> Double -> [Event] -> Renderable ()+renderEvents bandHeight ticksIntervalMs es = Renderable {minsize = return (0,0), render = render'}+  where +    events = sortBy (comparing time) es+    minTime = time $ head events+    maxTime = time $ last events+    time2ms t = diffToMillis t minTime+    rangeMs = time2ms maxTime+    ticks = takeWhile (<rangeMs) $ iterate (+ticksIntervalMs) 0+    tracks = sortBy (comparing (time . head)) . groupBy ((==) `on` track) . sortBy (comparing track) $ events++    maybeM :: (Monad m) => (a -> m b) -> Maybe a -> m ()+    maybeM f Nothing  = return ()+    maybeM f (Just x) = f x >> return ()++    bars track = execWriter $ evalStateT (mapM step track) Nothing+      where+        step (Event t _ (Begin c)) = do+          get >>= maybeM (\(t0,c0) -> tell [(time2ms t0, time2ms t, c0)])+          put (Just (t,c))+        step (Event t _ End      ) = do+          get >>= maybeM (\(t0,c0) -> tell [(time2ms t0, time2ms t, c0)])+          put Nothing++    render' (w,h) = do+      let ms2x ms = 10 + ms / rangeMs * (w - 10)+      let time2x t = ms2x (time2ms t)+      let numTracks = length tracks+      let yStep = (h-10) / fromIntegral (numTracks+1)+      let track2y i = fromIntegral (i+1) * yStep - bandHeight/2+      let drawTick ms = do {+          setLineStyle $ solidLine 1 (opaque black)+        ; moveTo $ Point (ms2x ms) (h-10)+        ; lineTo $ Point (ms2x ms) (h-5)+        ; c $ C.stroke+        }+      let drawBar i (ms1, ms2, color) = do {+          setLineStyle $ solidLine 1 transparent+        ; setFillStyle $ solidFillStyle $ opaque $ fromMaybe (error "unknown color") (readColourName color)+        ; fillPath (rectPath $ Rect (Point (ms2x ms1) (track2y i)) (Point (ms2x ms2) (track2y i + bandHeight)))+        }+      let drawTrack (i, es) = mapM_ (drawBar i) (bars es)++      setFillStyle $ solidFillStyle (opaque white)+      fillPath $ rectPath $ Rect (Point 0 0) (Point w h)+      setLineStyle $ solidLine 1 (opaque black)+      moveTo (Point 10 (h-10))+      lineTo (Point w  (h-10))+      c $ C.stroke+      moveTo (Point 10 (h-10))+      lineTo (Point 10 0)+      c $ C.stroke+      mapM_ drawTick ticks+      mapM_ drawTrack $ zip [0..] tracks+      return nullPickFn++main = do+  args <- getArgs+  let (w,h) = (read $ getArg "w" "640" args, read $ getArg "h" "480" args)+  let bandHeight = read $ getArg "bh" "5" args+  let ticksIntervalMs = read $ getArg "tickInterval" "10" args+  let timeFormat = getArg "tf" "%Y-%m-%d %H:%M:%OS" args+  let parseTime = fromMaybe (error "Invalid time") . strptime (B.pack timeFormat)+  let outPNG = getArg "o" "" args+  input <- B.getContents+  let events = parse parseTime `map` B.lines input+  let pic = renderEvents bandHeight ticksIntervalMs events+  case outPNG of+    "" -> renderableToWindow pic w h+    f  -> const () `fmap` renderableToPNGFile pic w h outPNG+

+ splot.cabal view

@@ -0,0 +1,27 @@+Name: splot+Version: 0.1.0+License: BSD3+License-file: LICENSE+Copyright: Eugene Kirpichov, 2010+Author: Eugene Kirpichov <ekirpichov@gmail.com>+Maintainer: Eugene Kirpichov <ekirpichov@gmail.com>+Synopsis: A tool for visualizing the lifecycle of many concurrent multi-staged processes.+Description: A tool for visualizing the lifecycle of many concurrent multi-staged processes.+  Each process has a name, it starts at a point in time, ends at a point in time, and at some+  points in time it changes colour.+Category: Graphics+Cabal-Version: >= 1.6+Build-Type: Simple++flag splitbase+  description: Choose the new smaller, split-up base package.++executable splot+  if flag(splitbase)+    Build-Depends: base >= 3 && < 5+  else+    Build-Depends: base < 3++  Build-Depends: cairo, bytestring, bytestring-lexing, strptime >= 0.1.5, time, +                 containers, colour, haskell98, Chart, mtl+  Main-Is: Tools/StatePlot.hs