packages feed

timeplot 1.0.3 → 1.0.4

raw patch · 6 files changed

+40/−57 lines, 6 files

Files

Tools/TimePlot.hs view
@@ -37,10 +37,10 @@ -- Pass 2: --  * Generate plot data (one-pass multiplexed to tracks) -- -makeChart :: (S.ByteString -> [ChartKind UTCTime]) -> -             IO [(UTCTime, InEvent)] ->-             Maybe UTCTime -> Maybe UTCTime ->-             (UTCTime -> String -> String) -> +makeChart :: (S.ByteString -> [ChartKind LocalTime]) -> +             IO [(LocalTime, InEvent)] ->+             Maybe LocalTime -> Maybe LocalTime ->+             (LocalTime -> String -> String) ->               IO (Renderable ()) makeChart chartKindF readEvents minT maxT transformLabel = do   events <- readEvents
Tools/TimePlot/Conf.hs view
@@ -33,24 +33,19 @@     outResolution :: !(Int,Int)
   }
 
-type Conf = ConcreteConf UTCTime
+type Conf = ConcreteConf LocalTime
 
 data KindChoiceOperator = Cut | Accumulate
 
-localToUTC Nothing = Nothing
-localToUTC (Just (t,s)) = Just (localToUTC' t, s)
-localToUTC' (LocalTime day (TimeOfDay h m s)) = {-# SCC "localToUTC" #-} UTCTime day daytime
-  where
-    daytime = unsafeCoerce (s + fromIntegral (60*m + 3600*h))
-
 readConf :: [String] -> Conf
 readConf args = readConf' parseTime 
   where
     pattern = case (words $ single "time format" "-tf" ("date %Y-%m-%d %H:%M:%OS")) of
         "date":f -> B.pack (unwords f)
         _        -> error "Unrecognized time format (-tf)"
-    ourStrptime = {-# SCC "ourStrptime" #-} strptime pattern
-    parseTime s = localToUTC (ourStrptime s)
+    {-# NOINLINE ourStrptime #-}
+    ourStrptime = strptime pattern
+    parseTime s = ourStrptime s
 
     int2double = fromIntegral :: Int -> Double
     single desc name def = case (getArg name 1 args) of
@@ -58,7 +53,7 @@       []    -> def
       _     -> error $ "Single argument expected for: "++desc++" ("++name++")"
 
-    readConf' :: (B.ByteString -> Maybe (UTCTime, B.ByteString)) -> ConcreteConf UTCTime
+    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}
@@ -99,7 +94,7 @@           Nothing -> s
           Just bt -> showDelta t bt
 
-        parseKind :: [String] -> ChartKind UTCTime
+        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}
Tools/TimePlot/Plots.hs view
@@ -25,9 +25,9 @@ import Tools.TimePlot.Types
 import qualified Tools.TimePlot.Incremental as I
 
-type PlotGen = String -> UTCTime -> UTCTime -> I.StreamSummary (UTCTime, InEvent) PlotData
+type PlotGen = String -> LocalTime -> LocalTime -> I.StreamSummary (LocalTime, InEvent) PlotData
 
-initGen :: ChartKind UTCTime -> PlotGen
+initGen :: ChartKind LocalTime -> PlotGen
 initGen (KindACount bs)         = genActivity (\sns n -> n) bs
 initGen (KindAPercent bs b)     = genActivity (\sns n -> 100*n/b) bs
 initGen (KindAFreq bs)          = genActivity (\sns n -> if n == 0 then 0 else (n / sum (M.elems sns))) bs
@@ -53,7 +53,7 @@ 
 -- Auxiliary functions for two common plot varieties
 
-plotTrackBars :: [(UTCTime,[Double])] -> [String] -> String -> [Colour Double] -> PlotData
+plotTrackBars :: [(LocalTime,[Double])] -> [String] -> String -> [Colour Double] -> PlotData
 plotTrackBars vals titles name colors = PlotBarsData {
         plotName = name,
         barsStyle = BarsStacked,
@@ -64,7 +64,7 @@         barsTitles = titles
     }
 
-plotLines :: String -> [(S.ByteString, [(UTCTime,Double)])] -> PlotData
+plotLines :: String -> [(S.ByteString, [(LocalTime,Double)])] -> PlotData
 plotLines name vss = PlotLinesData {
         plotName = name,
         linesData = [vs | (_, vs) <- vss],
@@ -183,7 +183,7 @@            NominalDiffTime -> PlotBarsStyle -> PlotGen
 genAtoms f binSize k name t0 t1 = I.filterMap atomsDropTrack (h <$> unique (\(t,atom) -> atom) <*> fInBins)
   where 
-    fInBins :: I.StreamSummary (UTCTime, S.ByteString) [(UTCTime, M.Map S.ByteString Int)]
+    fInBins :: I.StreamSummary (LocalTime, S.ByteString) [(LocalTime, M.Map S.ByteString Int)]
     fInBins = summaryByFixedTimeBins t0 binSize $ I.mapInput (second counts) I.collect
     counts  = foldl' insert M.empty
       where
@@ -191,19 +191,19 @@           Nothing -> M.insert a 1     m
           Just !n -> M.insert a (n+1) m
 
-    h :: [S.ByteString] -> [(UTCTime, M.Map S.ByteString Int)] -> PlotData
+    h :: [S.ByteString] -> [(LocalTime, M.Map S.ByteString Int)] -> PlotData
     h as tfs = plotTrackBars (map (second (f as)) tfs) (map show as) name colors
 
 unique :: (Ord a) => (x -> a) -> I.StreamSummary x [a]
 unique f = I.stateful M.empty (\a -> M.insert (f a) ()) M.keys
 
-uniqueSubtracks :: I.StreamSummary (UTCTime,S.ByteString,a) [S.ByteString]
+uniqueSubtracks :: I.StreamSummary (LocalTime,S.ByteString,a) [S.ByteString]
 uniqueSubtracks = unique (\(t,s,a) -> s)
 
 genSum :: NominalDiffTime -> SumSubtrackStyle -> PlotGen
 genSum binSize ss name t0 t1 = I.filterMap values (h <$> uniqueSubtracks <*> sumsInBins t0 binSize)
   where 
-    h :: [S.ByteString] -> [(UTCTime, M.Map S.ByteString Double)] -> PlotData
+    h :: [S.ByteString] -> [(LocalTime, M.Map S.ByteString Double)] -> PlotData
     h tracks binSums = plotLines name rows
       where
         rowsT' = case ss of
@@ -213,11 +213,11 @@         stack :: M.Map S.ByteString Double -> [(S.ByteString, Double)]
         stack ss = zip tracks (scanl1 (+) (map (\x -> M.findWithDefault 0 x ss) tracks))
         
-        rows :: [(S.ByteString, [(UTCTime, Double)])]
+        rows :: [(S.ByteString, [(LocalTime, Double)])]
         rows = M.toList $ fmap sort $ M.fromListWith (++) $
           [(track, [(t,sum)]) | (t, m) <- rowsT', (track, sum) <- m]
 
-sumsInBins :: UTCTime -> NominalDiffTime -> I.StreamSummary (UTCTime,S.ByteString,Double) [(UTCTime, M.Map S.ByteString Double)]
+sumsInBins :: LocalTime -> NominalDiffTime -> I.StreamSummary (LocalTime,S.ByteString,Double) [(LocalTime, M.Map S.ByteString Double)]
 sumsInBins t0 bs = I.mapInput (\(t,s,v) -> (t,(s,v))) $
                    summaryByFixedTimeBins t0 bs $
                    I.mapInput (second (fromListWith' (+))) $
@@ -226,7 +226,7 @@ genCumSum :: NominalDiffTime -> SumSubtrackStyle -> PlotGen
 genCumSum bs ss name t0 t1 = I.filterMap values (accumulate <$> uniqueSubtracks <*> sumsInBins t0 bs)
   where
-    accumulate :: [S.ByteString] -> [(UTCTime, M.Map S.ByteString Double)] -> PlotData
+    accumulate :: [S.ByteString] -> [(LocalTime, M.Map S.ByteString Double)] -> PlotData
     accumulate tracks tss = plotLines name [(track, [(t, ss M.! track) | (t,ss) <- cumsums]) | track <- tracks]
       where 
         cumsums = scanl' f (t0, M.fromList $ zip tracks (repeat 0)) (map normalize tss)
@@ -246,7 +246,7 @@ genActivity :: (M.Map S.ByteString Double -> Double -> Double) -> NominalDiffTime -> PlotGen
 genActivity f bs name t0 t1 = I.filterMap edges (h <$> uniqueSubtracks <*> binAreas)
   where 
-    binAreas :: I.StreamSummary (UTCTime,S.ByteString,Edge) [(UTCTime, M.Map S.ByteString Double)]
+    binAreas :: I.StreamSummary (LocalTime,S.ByteString,Edge) [(LocalTime, M.Map S.ByteString Double)]
     binAreas = fmap (map (\((t1,t2),m) -> (t1,m))) $ edges2binsSummary bs t0 t1
 
     h tracks binAreas = (plotTrackBars barsData ("":map S.unpack tracks) name colors) { barsStyle = BarsStacked }
@@ -348,7 +348,7 @@                       edges2eventsSummary t0 t1 I.collect
 -- TODO Multiple tracks
 
-genDuration :: ChartKind UTCTime -> PlotGen
+genDuration :: ChartKind LocalTime -> PlotGen
 genDuration sk name t0 t1 = I.filterMap edges $ edges2durationsSummary t0 t1 name (initGen sk name t0 t1)
 
 fromListWith' f kvs = foldl' insert M.empty kvs
Tools/TimePlot/Render.hs view
@@ -14,16 +14,6 @@ import Tools.TimePlot.Types
 import Tools.TimePlot.Plots
 
-instance PlotValue UTCTime where
-  toValue = toValue . utcToLocalTime utc
-  fromValue = localTimeToUTC utc . fromValue
-  autoAxis ts = ad' 
-    where 
-      ad :: AxisData LocalTime
-      ad = autoAxis (map (utcToLocalTime utc) ts)
-      ad' :: AxisData UTCTime
-      ad' = mapAxisData (utcToLocalTime utc) (localTimeToUTC utc) ad
-
 mapAxisData :: (a -> b) -> (b -> a) -> AxisData b -> AxisData a
 mapAxisData f f' (AxisData vp pv ticks labels grid) = AxisData 
     (\range x -> vp range (f x)) 
@@ -32,7 +22,7 @@     (map (map (\(x,lab) -> (f' x, lab))) labels) 
     (map f' grid)
 
-dataToPlot :: AxisData UTCTime -> PlotData -> AnyLayout1 UTCTime
+dataToPlot :: AxisData LocalTime -> PlotData -> AnyLayout1 LocalTime
 dataToPlot commonTimeAxis p@PlotBarsData{} = withAnyOrdinate $ layoutWithTitle commonTimeAxis [plotBars plot] (plotName p) (length (barsTitles p) > 1)
   where plot = plot_bars_values      ^= barsValues p $
                plot_bars_item_styles ^= barsStyles p $
@@ -62,7 +52,7 @@                  | color <- dotsColors p
                  | vs <- dotsData p]
 
-layoutWithTitle :: (PlotValue a) => AxisData UTCTime -> [Plot UTCTime a] -> String -> Bool -> Layout1 UTCTime a
+layoutWithTitle :: (PlotValue a) => AxisData LocalTime -> [Plot LocalTime a] -> String -> Bool -> Layout1 LocalTime a
 layoutWithTitle commonTimeAxis plots name showLegend =
     layout1_title ^= "" $
     layout1_plots ^= map Left plots $
@@ -74,7 +64,7 @@     layout1_grid_last ^= True $
     defaultLayout1
 
-ourPlotBars :: (BarsPlotValue a) => PlotBars UTCTime a
+ourPlotBars :: (BarsPlotValue a) => PlotBars LocalTime a
 ourPlotBars = plot_bars_spacing ^= BarsFixGap 0 0 $
               plot_bars_style   ^= BarsStacked    $
               plot_bars_alignment ^= BarsLeft     $
Tools/TimePlot/Types.hs view
@@ -57,12 +57,12 @@   fromSeconds d _ = d
   showDelta a b = show (a - b)
 
-instance HasDelta UTCTime where
-  type Delta UTCTime = NominalDiffTime
-  add d t = addUTCTime d t
-  sub t2 t1 = diffUTCTime t2 t1
+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
-  deltaToSeconds t2 t1 = diffToSeconds t2 t1
+  deltaToSeconds t2 t1 = diffLocalToSeconds t2 t1
   fromSeconds d _ = fromRational (toRational d)
   showDelta t1 t2
     | ts0 < 0.001 = "0"
@@ -79,16 +79,14 @@           h = th - 24 * d :: Int
           d = h `div` 24 :: Int
 
-{-# INLINE diffToSeconds #-}
-diffToSeconds :: UTCTime -> UTCTime -> Double
-diffToSeconds !t2 !t1 = 86400.0 * fromIntegral dd + fromRational (toRational (tod2-tod1))*1000.0
+diffLocalToSeconds :: LocalTime -> LocalTime -> Double
+diffLocalToSeconds !t2 !t1 = 86400.0*fromIntegral (diffDays d2 d1) + fromIntegral (3600*(h2-h1) + 60*(m2-m1)) + fromRational (toRational (s2-s1))
   where
-    (d1,d2,tod1,tod2) = (utctDay t1, utctDay t2, utctDayTime t1, utctDayTime t2)
-    dd = toModifiedJulianDay d2 - toModifiedJulianDay d1
+    (d1,d2,TimeOfDay h1 m1 s1,TimeOfDay h2 m2 s2) = (localDay t1, localDay t2, localTimeOfDay t1, localTimeOfDay t2)
 
 
 instance Read NominalDiffTime where
-  readsPrec n s = [(fromSeconds i (undefined::UTCTime), s') | (i,s') <- readsPrec n s]
+  readsPrec n s = [(fromSeconds i (undefined::LocalTime), s') | (i,s') <- readsPrec n s]
 
 data SumSubtrackStyle = SumStacked | SumOverlayed
 
@@ -116,26 +114,26 @@                 {
                     plotName :: String,
                     barsStyle :: PlotBarsStyle, 
-                    barsValues :: [ (UTCTime, [Double]) ], 
+                    barsValues :: [ (LocalTime, [Double]) ], 
                     barsStyles :: [(CairoFillStyle, Maybe CairoLineStyle)], 
                     barsTitles :: [String] 
                 }
               | PlotEventData
                 {
                     plotName :: String,
-                    eventData :: [Event UTCTime Status]
+                    eventData :: [Event LocalTime Status]
                 }
               | PlotLinesData
                 {
                     plotName :: String,
-                    linesData :: [[(UTCTime, Double)]],
+                    linesData :: [[(LocalTime, Double)]],
                     linesStyles :: [CairoLineStyle],
                     linesTitles :: [String]
                 }
               | PlotDotsData
                 {
                     plotName :: String,
-                    dotsData :: [[(UTCTime, Double)]],
+                    dotsData :: [[(LocalTime, Double)]],
                     dotsColors :: [AlphaColour Double],
                     dotsTitles :: [String]
                 }
timeplot.cabal view
@@ -1,5 +1,5 @@ name: timeplot-version: 1.0.3+version: 1.0.4 cabal-version: >=1.6 build-type: Simple license: BSD3