eventlog2html 0.1.0 → 0.2.0
raw patch · 7 files changed
+88/−44 lines, 7 filesdep +timePVP ok
version bump matches the API change (PVP)
Dependencies added: time
API changes (from Hackage documentation)
+ Eventlog.Args: [outputFile] :: Args -> Maybe String
- Eventlog.Args: Args :: Sort -> Bool -> Double -> Int -> Bool -> Bool -> Bool -> Bool -> Text -> [String] -> Args
+ Eventlog.Args: Args :: Sort -> Bool -> Double -> Int -> Bool -> Bool -> Bool -> Bool -> Text -> Maybe String -> [String] -> Args
Files
- CHANGELOG +6/−0
- eventlog2html.cabal +5/−4
- main/Main.hs +18/−17
- src/Eventlog/Args.hs +6/−0
- src/Eventlog/Data.hs +1/−0
- src/Eventlog/Events.hs +23/−8
- src/Eventlog/HtmlTemplate.hs +29/−15
CHANGELOG view
@@ -1,3 +1,9 @@+0.2, released 2019-07-05++* Added the commandline option '-o OUTFILE' which writes the output to+ the given filename.+* Show the time the eventlog was created in the generated HTML output.+ 0.1, released 2019-06-23 * Initial release, a complete rewrite on hp2pretty. Implemented by
eventlog2html.cabal view
@@ -1,5 +1,5 @@ Name: eventlog2html-Version: 0.1.0+Version: 0.2.0 Synopsis: Visualise an eventlog Description: eventlog2html is a library for visualising eventlogs. At the moment, the intended use is to visualise eventlogs@@ -39,10 +39,9 @@ attoparsec >= 0.13.2 && < 0.14, array >= 0.5.3 && < 0.6, base >= 4 && < 5,+ blaze-html >= 0.9.1 && < 0.10, bytestring >= 0.10.8 && < 0.11, containers >= 0.6.0 && < 0.7,- text >= 1.2.3 && < 1.3,- blaze-html >= 0.9.1 && < 0.10, file-embed >= 0.0.11 && < 0.1, filepath >= 1.4.2 && < 1.5, ghc-events >= 0.8.0 && < 0.10,@@ -50,7 +49,9 @@ hvega >= 0.2.0 && < 0.3, mtl >= 2.2.2 && < 2.3, optparse-applicative >= 0.14.3 && < 0.15,- semigroups >= 0.18 && < 0.20+ semigroups >= 0.18 && < 0.20,+ text >= 1.2.3 && < 1.3,+ time >= 1.8.0 && < 2.0 GHC-options: -Wall default-language: Haskell2010
main/Main.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE MultiWayIf #-} module Main (main) where@@ -26,21 +25,23 @@ argsToOutput a argsToOutput :: Args -> IO ()-argsToOutput a =- if | json a -> doJson a- | otherwise -> doHtml a+argsToOutput a@Args{files = files, outputFile = Nothing} =+ if | json a -> forM_ files $ \file -> doOneJson a file (file <.> "json")+ | otherwise -> forM_ files $ \file -> doOneHtml a file (file <.> "html")+argsToOutput a@Args{files = [fin], outputFile = Just fout} =+ if | json a -> doOneJson a fin fout+ | otherwise -> doOneHtml a fin fout+argsToOutput _ =+ die "When the -o option is specified, exactly one eventlog file has to be passed."+ +doOneJson :: Args -> FilePath -> FilePath -> IO ()+doOneJson a fin fout = do+ (_, val) <- generateJson fin a+ encodeFile fout val -doJson :: Args -> IO ()-doJson a = do- forM_ (files a) $ \file -> do- (_, val) <- generateJson file a- encodeFile (file <.> "json") val+doOneHtml :: Args -> FilePath -> FilePath -> IO ()+doOneHtml a fin fout = do+ (header, data_json) <- generateJson fin a+ let html = templateString header data_json a+ writeFile fout html -doHtml :: Args -> IO ()-doHtml a = do- forM_ (files a) $ \file -> do- (header, data_json) <- generateJson file a- let html = templateString header data_json a- let filename2 = file <.> "html"- writeFile filename2 html- exitSuccess
src/Eventlog/Args.hs view
@@ -10,6 +10,7 @@ import Options.Applicative import Data.Text (Text) import Data.Semigroup ((<>))+import Control.Applicative (optional) data Sort = Size | StdDev | Name @@ -24,6 +25,7 @@ , json :: Bool , noTraces :: Bool , userColourScheme :: Text+ , outputFile :: Maybe String , files :: [String] } @@ -67,6 +69,10 @@ ( long "colour-scheme" <> value "category20b" <> help "The name of the colour scheme. See the vega documentation (https://vega.github.io/vega/docs/schemes/#reference) for a complete list. Examples include \"category10\" \"dark2\" \"tableau10\". ")+ <*> (optional $ option str+ (short 'o'+ <> help "Write the output to the given filename."+ <> metavar "OUTFILE")) <*> some (argument str ( help "Eventlogs (FILE.eventlog will be converted to FILE.html)." <> metavar "FILES..." ))
src/Eventlog/Data.hs view
@@ -24,6 +24,7 @@ StdDev -> cmpStdDev reversing' = if reversing a then swap else id (ph, fs, traces) <- chunk file+ putStrLn (show fs) let (h, totals) = total ph fs let keeps = prune cmp 0 (bound $ nBands a) totals let combinedJson = object [
src/Eventlog/Events.hs view
@@ -13,8 +13,8 @@ import Data.List import Data.Function import Data.Word---import Data.Time---import Data.Time.Clock.POSIX(posixSecondsToUTCTime)+import Data.Time+import Data.Time.Clock.POSIX fromNano :: Word64 -> Double fromNano e = fromIntegral e * 1e-9@@ -39,6 +39,7 @@ data EL = EL { pargs :: Maybe [String]+ , clocktimeSec :: Word64 , samples :: Maybe (Word64, [Sample]) , frames :: [(Word64, [Sample])] , traces :: [Trace]@@ -46,7 +47,15 @@ , end :: Word64 } deriving Show initEL :: Word64 -> EL-initEL t = EL Nothing Nothing [] [] t 0+initEL t = EL+ { pargs = Nothing+ , clocktimeSec = 0+ , samples = Nothing+ , frames = []+ , traces = []+ , start = t+ , end = 0+ } foldEvents :: [Event] -> EL foldEvents (e:es) =@@ -67,9 +76,11 @@ --HeapProfSampleCostCentre {} -> True HeapProfSampleString _hid res k -> addSample (Sample k (fromIntegral res)) ProgramArgs _ as -> addArgs as+ WallClockTime _ s _ -> addClocktime s _ -> id -+addClocktime :: Word64 -> EL -> EL+addClocktime s el = el { clocktimeSec = s } addArgs :: [String] -> EL -> EL addArgs as el = el { pargs = Just as }@@ -95,13 +106,17 @@ updateLast :: Word64 -> EL -> EL updateLast t el = el { end = t } +formatDate :: Word64 -> T.Text+formatDate sec =+ let posixTime :: POSIXTime+ posixTime = realToFrac sec+ in+ T.pack $ formatTime defaultTimeLocale "%Y-%m-%d, %H:%M %Z" (posixSecondsToUTCTime posixTime) elHeader :: EL -> PartialHeader elHeader EL{..} = let title = maybe "" (T.unwords . map T.pack) pargs- -- dl = formatTime defaultTimeLocale "%c"- -- . posixSecondsToUTCTime $ realToFrac start-- in Header title "aaa" "" ""+ date = formatDate clocktimeSec+ in Header title date "" ""
src/Eventlog/HtmlTemplate.hs view
@@ -68,23 +68,37 @@ template header' dat as = docTypeHtml $ do htmlHeader dat as body $ H.div ! class_ "container" $ do- H.div ! class_ "tabcontent" $ do- h1 $ a ! href "https://mpickering.github.io/eventlog2html" $ "eventlog2html"- code $ toHtml $ hJob header'+ H.div ! class_ "row" $ do+ H.div ! class_ "column" $ do+ h1 $ a ! href "https://mpickering.github.io/eventlog2html" $ "eventlog2html" - button ! class_ "tablink button-black" ! onclick "changeTab('areachart', this)" ! A.id "defaultOpen" $ "Area Chart"- button ! class_ "tablink button-black" ! onclick "changeTab('normalizedchart', this)" $ "Normalized"- button ! class_ "tablink button-black" ! onclick "changeTab('streamgraph', this)" $ "Streamgraph"- button ! class_ "tablink button-black" ! onclick "changeTab('linechart', this)" $ "Linechart"+ H.div ! class_ "row" $ do+ H.div ! class_ "column" $ do+ "Options: "+ code $ toHtml $ hJob header' - mapM_ (\(vid, chartname, conf) ->- H.div ! A.id chartname ! class_ "tabviz" $ do- renderChart vid- (TL.toStrict (encodeToLazyText (vegaJson (htmlConf as conf)))))- [(1, "areachart", AreaChart Stacked)- ,(2, "normalizedchart", AreaChart Normalized)- ,(3, "streamgraph", AreaChart StreamGraph)- ,(4, "linechart", LineChart)]+ H.div ! class_ "row" $ do+ H.div ! class_ "column" $ do+ "Created at: "+ code $ toHtml $ hDate header'++ H.div ! class_ "row" $ do+ H.div ! class_ "column" $ do+ button ! class_ "tablink button-black" ! onclick "changeTab('areachart', this)" ! A.id "defaultOpen" $ "Area Chart"+ button ! class_ "tablink button-black" ! onclick "changeTab('normalizedchart', this)" $ "Normalized"+ button ! class_ "tablink button-black" ! onclick "changeTab('streamgraph', this)" $ "Streamgraph"+ button ! class_ "tablink button-black" ! onclick "changeTab('linechart', this)" $ "Linechart"++ H.div ! class_ "row" $ do+ H.div ! class_ "column" $ do+ mapM_ (\(vid, chartname, conf) ->+ H.div ! A.id chartname ! class_ "tabviz" $ do+ renderChart vid+ (TL.toStrict (encodeToLazyText (vegaJson (htmlConf as conf)))))+ [(1, "areachart", AreaChart Stacked)+ ,(2, "normalizedchart", AreaChart Normalized)+ ,(3, "streamgraph", AreaChart StreamGraph)+ ,(4, "linechart", LineChart)] script $ preEscapedToHtml tablogic