diff --git a/Tools/TimePlot.hs b/Tools/TimePlot.hs --- a/Tools/TimePlot.hs +++ b/Tools/TimePlot.hs @@ -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 diff --git a/timeplot.cabal b/timeplot.cabal --- a/timeplot.cabal +++ b/timeplot.cabal @@ -1,5 +1,5 @@ name: timeplot -version: 0.3.10 +version: 0.3.11 cabal-version: >=1.6 build-type: Simple license: BSD3