Summary.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.Stress.Driver.Summary
  ( createSummaryPlots
  , eventlogToSvg
  ) where

import Control.Exception
import Data.ByteString.Lazy.Char8 qualified as BS.Lazy
import Data.List
import Data.Maybe
import Data.Word
import GHC.RTS.Events
import GHC.RTS.Events.Incremental
import Graphics.Rendering.Chart.Backend.Diagrams
import Graphics.Rendering.Chart.Easy hiding ((<.>))
import System.Directory
import System.Exit
import System.FilePath

import Test.Stress.Common

createSummaryPlots :: Bool -> Maybe FilePath -> IO ()
createSummaryPlots v mwd = do
    cwd <- getCurrentDirectory
    let wd = fromMaybe cwd mwd
    putStrLn $ "Creating summary plots in " ++ wd ++ "..."
    wdFiles <- map (wd </>) <$> listDirectory wd
    let wdElFiles = filter (".eventlog" `isSuffixOf`) wdFiles
    say' v $ "found event logs:"
    mapM_ (say' v) $ map ("  " ++) wdElFiles
    mapM_ (\e -> handleFailure e $ eventlogToSvg v e) wdElFiles
  where
    handleFailure :: FilePath -> IO () -> IO ()
    handleFailure f =
        handle $ \case
          e | Just UserInterrupt <- fromException e ->
              exitFailure
            | otherwise -> do
              putStrLn $ "failed to generate summary plot for " ++ f
              print e

eventlogToSvg :: Bool -> FilePath -> IO ()
eventlogToSvg v elFile = do
    say' v $ "generating plot file for " ++ elFile
    elBytes <- BS.Lazy.readFile elFile
    case readEventLog elBytes of
      Right (EventLog _ (Data events), _merr) -> do
        samples <- goEvents emptySamples events
        toFile def (elFile <.> "svg") $ do
          layout_title .= elFile
          layout_x_axis . laxis_title .= "Time (seconds)"
          layout_y_axis . laxis_title .= "Size (megabytes)"
          plot (line "live bytes" [samplesLiveBytes samples])
          plot (line "blocks size" [samplesBlocksSize samples])
          plot (line "heap size" [samplesHeapSize samples])
        say' v $ "finished plot for " ++ elFile
      Left err ->
        putStrLn $
          "Failed to create summary plot from " ++ elFile ++ ": " ++ err
  where
    goEvents :: Samples -> [Event] -> IO Samples
    goEvents acc [] =
        return acc
    goEvents acc (Event t ei _:es) = do
        acc' <- addEvent acc (t,ei)
          `catch` (\(_e :: SomeException) -> return acc)
        goEvents acc' es

    addEvent :: Samples -> (Timestamp, EventInfo) -> IO Samples
    addEvent acc (t, ei) =
        case ei of
          HeapLive _ s -> return $ acc {
              samplesLiveBytes =
                insertBy byFirst
                  (timeConv t, sizeConv s) (samplesLiveBytes acc)
            }
          BlocksSize _ s -> return $ acc {
              samplesBlocksSize =
                insertBy byFirst
                  (timeConv t, sizeConv s) (samplesBlocksSize acc)
            }
          HeapSize _ s -> return $ acc {
              samplesHeapSize =
                insertBy byFirst
                  (timeConv t, sizeConv s) (samplesHeapSize acc)
            }
          _ -> return acc
      where
        timeConv :: Word64 -> Double
        sizeConv :: Word64 -> Double
        timeConv = (/ 1_000_000_000) . fromIntegral -- nanoseconds to seconds
        sizeConv = (/ 1_000_000)     . fromIntegral -- bytes to megabytes

say' :: Bool -> String -> IO ()
say' v = say v . ("(summary) " ++)

byFirst :: Ord a => (a, b) -> (a, b) -> Ordering
byFirst (x1, _) (x2, _) = compare x1 x2

-------------------------------------------------------------------------------
-- Internal auxiliary
-------------------------------------------------------------------------------

data Samples = Samples {
      samplesLiveBytes  :: [(Double, Double)]
    , samplesBlocksSize :: [(Double, Double)]
    , samplesHeapSize   :: [(Double, Double)]
    }

emptySamples :: Samples
emptySamples = Samples [] [] []