packages feed

timeplot 0.3.10 → 0.3.11

raw patch · 2 files changed

+110/−93 lines, 2 files

Files

Tools/TimePlot.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, TypeFamilies, FlexibleContexts, GADTs, CPP, ParallelListComp #-}+{-# LANGUAGE ScopedTypeVariables, TypeFamilies, ParallelListComp #-} module Main where  import Control.Monad@@ -108,12 +108,6 @@ 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@@ -132,33 +126,33 @@                | KindCumSum    { subtrackStyle :: SumSubtrackStyle }                | KindSum       { binSize :: Delta t, subtrackStyle :: SumSubtrackStyle }                | KindNone+               | KindUnspecified -- Causes an error message   data ZoomMode = ZoomInput | ZoomOutput  data ConcreteConf t =   ConcreteConf {-    inFile        :: FilePath,-    parseTime     :: B.ByteString -> Maybe (t, B.ByteString),-    chartKindF    :: S.ByteString -> [ChartKind t],+    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,+    fromTime      :: !(Maybe t),+    toTime        :: !(Maybe t),+    zoomMode      :: !ZoomMode,+    transformLabel :: !(t -> String -> String), -    outFile       :: FilePath,-    outFormat     :: OutFormat,-    outResolution :: (Int,Int)+    outFile       :: !FilePath,+    outFormat     :: !OutFormat,+    outResolution :: !(Int,Int)   } -data Conf = forall t . (TimeAxis t) => Conf {concrete :: ConcreteConf t}+type Conf = ConcreteConf LocalTime  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))+    "date":f -> readConf' (strptime (B.pack $ unwords f))     _        -> error "Unrecognized time format (-tf)"   where     int2double = fromIntegral :: Int -> Double@@ -167,7 +161,7 @@       []    -> def       _     -> error $ "Single argument expected for: "++desc++" ("++name++")" -    readConf' :: forall t. (TimeAxis t) => (B.ByteString -> Maybe (t, B.ByteString)) -> ConcreteConf t+    readConf' :: (B.ByteString -> Maybe (LocalTime, B.ByteString)) -> ConcreteConf LocalTime     readConf' parseTime = ConcreteConf {inFile=inFile, outFile=outFile, outFormat=outFormat, outResolution=outRes,                       chartKindF=chartKindF, parseTime=parseTime, fromTime=fromTime, toTime=toTime,                       transformLabel=transformLabel, zoomMode=zoomMode}@@ -183,11 +177,14 @@         outRes      = parseRes $ single "output resolution" "-or" "640x480"           where             parseRes s = case break (=='x') s of (h,_:v) -> (read h,read v)-        chartKindF  = kindByRegex $+        forceList :: [a] -> ()+        forceList = foldr seq ()+        chartKindF  = forceList [forceList plusKinds, forceList minusKinds, forceList defaultKindsPlus, defaultKindMinus `seq` ()] `seq` 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 }+            plusKinds  = [parseKind (words kind) | [regex, kind] <- getArg "+k" 2 args]+            minusKinds = [parseKind (words kind) | [regex, kind] <- getArg "-k" 2 args]             kindByRegex rks s = (defaultKindsPlus ++                                 [k | (Accumulate, p, k) <- rks, p s] ++                                 [case [k | (Cut, p, k) <- rks, p s] of { [] -> defaultKindMinus; k:_ -> k }])@@ -205,30 +202,54 @@           Nothing -> s           Just bt -> showDelta t bt +        parseKind :: [String] -> ChartKind LocalTime         parseKind ["acount",  n  ] = KindACount    {binSize=read n}+        parseKind ("acount":_)     = error "acount requires a single numeric argument, bin size, e.g.: -dk 'acount 1'"         parseKind ["apercent",n,b] = KindAPercent  {binSize=read n,baseCount=read b}+        parseKind ("apercent":_)   = error "apercent requires two numeric arguments: bin size and base value, e.g.: -dk 'apercent 1 480'"         parseKind ["afreq",   n  ] = KindAFreq     {binSize=read n}+        parseKind ("afreq":_)      = error "afreq requires a single numeric argument, bin size, e.g.: -dk 'afreq 1'"         parseKind ["freq",    n  ] = KindFreq      {binSize=read n,style=BarsClustered}         parseKind ["freq",    n,s] = KindFreq      {binSize=read n,style=parseStyle s}+        parseKind ("freq":_)       = error $ "freq requires a single numeric argument, bin size, e.g.: -dk 'freq 1', " ++ +                                             "or two arguments, e.g.: -dk 'freq 1 clustered'"         parseKind ["hist",    n  ] = KindHistogram {binSize=read n,style=BarsClustered}         parseKind ["hist",    n,s] = KindHistogram {binSize=read n,style=parseStyle s}+        parseKind ("hist":_)       = error $ "hist requires a single numeric argument, bin size, e.g.: -dk 'hist 1', " ++ +                                             "or two arguments, e.g.: -dk 'hist 1 clustered'"         parseKind ["event"       ] = KindEvent+        parseKind ("event":_)      = error "event requires no arguments"         parseKind ["quantile",b,q] = KindQuantile  {binSize=read b, quantiles=read ("["++q++"]")}+        parseKind ("quantile":_)   = error $ "quantile requres two arguments: bin size and comma-separated " ++ +                                             "(without spaces!) quantiles, e.g.: -dk 'quantile 1 0.5,0.75,0.9'"         parseKind ["binf",    b,q] = KindBinFreq   {binSize=read b, delims   =read ("["++q++"]")}+        parseKind ("binf":_)       = error $ "binf requres two arguments: bin size and comma-separated " ++ +                                             "(without spaces!) threshold values, e.g.: -dk 'binf 1 10,50,100,200,500'"         parseKind ["binh",    b,q] = KindBinHist   {binSize=read b, delims   =read ("["++q++"]")}+        parseKind ("binh":_)       = error $ "binh requres two arguments: bin size and comma-separated " ++ +                                             "(without spaces!) threshold values, e.g.: -dk 'binh 1 10,50,100,200,500'"         parseKind ["lines"       ] = KindLines+        parseKind ("lines":_)      = error "lines requires no arguments"         parseKind ["dots"        ] = KindDots+        parseKind ("dots":_)       = error "dots requires no arguments"         parseKind ["cumsum"      ] = KindCumSum    {subtrackStyle=SumStacked}         parseKind ["cumsum",  s  ] = KindCumSum    {subtrackStyle=parseSubtrackStyle s}+        parseKind ("cumsum":_)     = error $ "cumsum requires zero or one argument (subtrack style), e.g.: " ++ +                                             "-dk cumsum or -dk 'cumsum stacked'"         parseKind ["sum",     b  ] = KindSum       {binSize=read b, subtrackStyle=SumStacked}         parseKind ["sum",     b,s] = KindSum       {binSize=read b, subtrackStyle=parseSubtrackStyle s}+        parseKind ("sum":_)        = error $ "sum requires one or two arguments: bin size and optionally " ++ +                                             "subtrack style, e.g.: -dk 'sum 1' or -dk 'sum 1 stacked'"         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 ("none":_)       = error "none requires no arguments"+        parseKind ["unspecified" ] = KindUnspecified+        parseKind ("unspecified":_)= error "unspecified requires no arguments"         parseKind ws               = error ("Unknown diagram kind " ++ unwords ws) -        defaultKindMinus = parseKind $ words $ single "default kind" "-dk" "none"+        defaultKindMinus = parseKind $ words $ single "default kind" "-dk" "unspecified"         defaultKindsPlus = map (parseKind . words . head) $ getArg "+dk" 1 args          parseStyle "stacked"   = BarsStacked@@ -244,14 +265,13 @@ 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)+readSource readTime f = (map parseLine . filter (not . B.null) . 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+    parseLine s = (\x -> case x of { Just e -> e; Nothing -> error $ "Unparseable input line: " ++ B.unpack s }) $ do       (t, s') <- readTime s       (_, s'') <- B.uncons s'       (c,rest) <- B.uncons s''@@ -283,20 +303,19 @@                   return (t, InValue (strict track) v)         _   -> Nothing -makeChart :: forall t . TimeAxis t =>-             (S.ByteString -> [ChartKind t]) -> -             [(t, InEvent)] ->-             Maybe t -> Maybe t ->+makeChart :: (S.ByteString -> [ChartKind LocalTime]) -> +             [(LocalTime, InEvent)] ->+             Maybe LocalTime -> Maybe LocalTime ->              ZoomMode -> -             (t -> String -> String) -> +             (LocalTime -> String -> String) ->               Renderable () makeChart chartKindF []      minT maxT zoomMode transformLabel = emptyRenderable makeChart chartKindF events0 minT maxT zoomMode transformLabel = renderLayout1sStacked plots   where-    events :: [(t, InEvent)]+    events :: [(LocalTime, InEvent)]     events@((t0,_):_) = sortBy (comparing (\(t,_)-> t)) events0 -    track2events :: M.Map S.ByteString [(t, InEvent)]+    track2events :: M.Map S.ByteString [(LocalTime, 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 @@ -324,10 +343,10 @@     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             :: [LocalTime]     times             = sort $ [t | tes <- M.elems track2events, (t,_)<- tes] -    commonTimeAxis    :: AxisData t+    commonTimeAxis    :: AxisData LocalTime     commonTimeAxis    = transformLabels $ autoAxis axisTimes       where         axisTimes = case zoomMode of@@ -335,10 +354,10 @@           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 :: S.ByteString -> ChartKind LocalTime -> [(LocalTime, InEvent)] -> AnyLayout1 LocalTime     plotTrack name kind es = plotWithKind name kind es -    plotWithKind :: S.ByteString -> ChartKind t -> [(t, InEvent)] -> AnyLayout1 t+    plotWithKind :: S.ByteString -> ChartKind LocalTime -> [(LocalTime, InEvent)] -> AnyLayout1 LocalTime     plotWithKind name k es = case k of       KindACount    bs    -> withAnyOrdinate $ plotTrackACount    name es bs       KindAPercent  bs b  -> withAnyOrdinate $ plotTrackAPercent  name es bs b@@ -354,23 +373,24 @@       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"+      KindWithin    _ _   -> error $ "KindDuration should not be plotted: track " ++ show name+      KindNone            -> error $ "KindNone should not be plotted: track " ++ show name+      KindUnspecified     -> error $ "Kind not specified for track " ++ show name ++ " (have you misspelled -dk or any of -k arguments?)" -    edges  :: [(t,InEvent)] -> [(t,S.ByteString,Edge)]-    values :: [(t,InEvent)] -> [(t,S.ByteString,Double)]-    atoms  :: [(t,InEvent)] -> [(t,S.ByteString,S.ByteString)]+    edges  :: [(LocalTime,InEvent)] -> [(LocalTime,S.ByteString,Edge)]+    values :: [(LocalTime,InEvent)] -> [(LocalTime,S.ByteString,Double)]+    atoms  :: [(LocalTime,InEvent)] -> [(LocalTime,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 :: (BarsPlotValue a) => PlotBars LocalTime 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 :: S.ByteString -> [(LocalTime,InEvent)] -> NominalDiffTime -> ([(S.ByteString, Double)] -> Double -> Double) -> Layout1 LocalTime Double     plotTrackActivity name es bs transform = layoutWithTitle [plotBars plot] name       where plot = plot_bars_values      ^= barsData $                    plot_bars_item_styles ^= itemStyles $@@ -382,25 +402,25 @@             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 :: S.ByteString -> [(LocalTime,InEvent)] -> NominalDiffTime -> Layout1 LocalTime Double     plotTrackACount name es bs = plotTrackActivity name es bs (\_ -> id) -    plotTrackAFreq :: S.ByteString -> [(t,InEvent)] -> Delta t -> Layout1 t Double+    plotTrackAFreq :: S.ByteString -> [(LocalTime,InEvent)] -> NominalDiffTime -> Layout1 LocalTime 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 :: S.ByteString -> [(LocalTime,InEvent)] -> NominalDiffTime -> Double -> Layout1 LocalTime 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  :: S.ByteString -> [(LocalTime,InEvent)] -> NominalDiffTime -> PlotBarsStyle -> Layout1 LocalTime Double     plotTrackFreq  = plotTrackAtoms atoms2freqs -    plotTrackHist  :: S.ByteString -> [(t,InEvent)] -> Delta t -> PlotBarsStyle -> Layout1 t Int+    plotTrackHist  :: S.ByteString -> [(LocalTime,InEvent)] -> NominalDiffTime -> PlotBarsStyle -> Layout1 LocalTime Int     plotTrackHist  = plotTrackAtoms atoms2hist      plotTrackAtoms :: (Num v, BarsPlotValue v) =>                       ([S.ByteString] -> [S.ByteString] -> [v]) ->-                      S.ByteString -> [(t,InEvent)] -> Delta t -> PlotBarsStyle -> Layout1 t v+                      S.ByteString -> [(LocalTime,InEvent)] -> NominalDiffTime -> PlotBarsStyle -> Layout1 LocalTime v     plotTrackAtoms f name es bs k = layoutWithTitle [plotBars plot] name       where plot = plot_bars_style       ^= k           $                    plot_bars_values      ^= vals        $@@ -414,7 +434,7 @@             vs   = M.keys $ M.fromList $ [(a,()) | (_,a) <- as]      -- TODO Multiple tracks-    plotTrackEvent :: S.ByteString -> [(t,InEvent)] -> Layout1 t Status+    plotTrackEvent :: S.ByteString -> [(LocalTime,InEvent)] -> Layout1 LocalTime Status     plotTrackEvent     name es       = layoutWithTitle [toPlot plot] name       where plot = plot_event_data           ^= dropTrack (edges2events (edges es) minInTime maxInTime) $                    plot_event_long_fillstyle ^= toFillStyle             $@@ -424,7 +444,7 @@             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 :: S.ByteString -> [(LocalTime,InEvent)] -> [Double] -> NominalDiffTime -> Layout1 LocalTime 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 $@@ -462,7 +482,7 @@         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 :: (BarsPlotValue a) => [(LocalTime,[a])] -> [String] -> S.ByteString -> (Int -> AlphaColour Double) -> Layout1 LocalTime a     plotTrackBars values titles name clr = layoutWithTitle [plotBars plot] name       where plot = plot_bars_values      ^= values    $                    plot_bars_item_styles ^= binStyles $@@ -477,7 +497,7 @@      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 :: S.ByteString -> [(S.ByteString, [(LocalTime,Double)])] -> Layout1 LocalTime Double     plotLines name vss = layoutWithTitle (map toPlot plots) name       where plots = [plot_lines_values ^= [vs] $                       plot_lines_title  ^= S.unpack subtrack $ @@ -486,10 +506,10 @@                      | (subtrack, vs) <- vss                      | color <- map opaque colors] -    plotTrackLines :: S.ByteString -> [(t,InEvent)] -> Layout1 t Double+    plotTrackLines :: S.ByteString -> [(LocalTime,InEvent)] -> Layout1 LocalTime Double     plotTrackLines name es = plotLines name (groupByTrack (values es)) -    plotTrackDots :: S.ByteString -> [(t,InEvent)] -> Layout1 t Double+    plotTrackDots :: S.ByteString -> [(LocalTime,InEvent)] -> Layout1 LocalTime Double     plotTrackDots  name es = layoutWithTitle (map toPlot plots) name       where plots = [plot_points_values ^= vs $                      plot_points_style  ^= hollowCircles 4 1 color $@@ -498,17 +518,17 @@                      | (subtrack, vs) <- groupByTrack (values es)                      | color <- map opaque colors] -    plotTrackCumSum :: S.ByteString -> [(t,InEvent)] -> SumSubtrackStyle -> Layout1 t Double+    plotTrackCumSum :: S.ByteString -> [(LocalTime,InEvent)] -> SumSubtrackStyle -> Layout1 LocalTime 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 :: [(S.ByteString, [(LocalTime, Double)])]             rows = groupByTrack [(t, track, v) | (t, tvs) <- rowsT, (track,v) <- tvs] -            rowsT :: [(t, [(S.ByteString, Double)])]+            rowsT :: [(LocalTime, [(S.ByteString, Double)])]             rowsT = (minInTime, zip allTracks (repeat 0)) : St.evalState (mapM addDataPoint vals) M.empty                          addDataPoint (t, track, v) = do@@ -518,12 +538,12 @@               return (t, allTracks `zip` (scanl1 (+) trackSums))  -    plotTrackSum :: S.ByteString -> [(t,InEvent)] -> Delta t -> SumSubtrackStyle -> Layout1 t Double+    plotTrackSum :: S.ByteString -> [(LocalTime,InEvent)] -> NominalDiffTime -> SumSubtrackStyle -> Layout1 LocalTime 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 :: [(LocalTime, 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@@ -533,10 +553,10 @@             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 :: [(S.ByteString, [(LocalTime, 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 :: (PlotValue a) => [Plot LocalTime a] -> S.ByteString -> Layout1 LocalTime a     layoutWithTitle plots name =         layout1_title ^= "" $         layout1_plots ^= map Left plots $@@ -669,7 +689,7 @@     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 :: (Ord 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) &&@@ -687,12 +707,10 @@   "               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].",+  "  -tf TF     - time format: -tf 'date PATTERN' means that times are dates in the format",+  "               specified by PATTERN - see http://linux.die.net/man/3/strptime, ",+  "               for example, -tf 'date [%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.",@@ -799,25 +817,24 @@   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+  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 ;+      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         }-      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+      let chart = makeChart chartKindF source' fromTime toTime zoomMode transformLabel+      let (w,h) = outResolution+      render chart w h outFile
timeplot.cabal view
@@ -1,5 +1,5 @@ name: timeplot-version: 0.3.10+version: 0.3.11 cabal-version: >=1.6 build-type: Simple license: BSD3