[CI] Benchmarking

.github/bench.hs

@@ -0,0 +1,73 @@
+#!/usr/bin/env cabal
+{- cabal:
+build-depends: base, split, text, cassava, vector, bytestring, directory, filepath, containers, extra
+-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings   #-}
+module Main where
+
+import           Control.Monad        (forM_)
+import qualified Data.ByteString.Lazy
+import           Data.Csv             (FromNamedRecord (..), Header,
+                                       decodeByName, decodeByNameWith, (.:))
+import           Data.List.Extra      (stripSuffix)
+import           Data.Map             (elems, intersectionWith, toList)
+import qualified Data.Map
+import           Data.Maybe           (fromJust)
+import qualified Data.Text            as T
+import qualified Data.Text.IO
+import qualified Data.Vector          (Vector, toList)
+import           System.Directory     (listDirectory)
+import           System.Environment   (getArgs)
+import           System.FilePath      ((</>))
+
+data CsvRecord = CsvRecord { name:: !String, success :: !T.Text, firstTime :: !Double, avgTime :: !Double}
+  deriving Show
+instance FromNamedRecord CsvRecord where
+    parseNamedRecord m = CsvRecord <$>
+                         m .: "name" <*>
+                         m .: "success" <*>
+                         m .: "1stBuildT" <*>
+                         m .: "avgPerRespT"
+
+
+readCsv :: FilePath -> IO ([CsvRecord])
+readCsv fp= do
+  contents <- Data.ByteString.Lazy.readFile fp
+  let Right csv = decodeByName contents :: Either String (Header,Data.Vector.Vector CsvRecord )
+  pure $ Data.Vector.toList $ snd csv
+
+readRts :: FilePath ->IO [(String,Double)]
+-- right now we don't worry about int vs double metrics
+readRts fp= do
+  contents <- Data.Text.IO.readFile fp
+  let contents' = T.unlines $ tail $ T.lines contents
+  let contents'' = read $ T.unpack contents' ::[(String,String)]
+  pure$ map (\(x,y) -> (x,read y)) contents''
+readAllRts :: FilePath -> IO [(FilePath,[(String,Double)])]
+readAllRts fp = do
+  files <- listDirectory fp
+  mapM (\x -> readRts (fp </> x) >>= \y -> pure (normalizeName x,y)) files
+  where
+    normalizeName :: String -> String
+    normalizeName s = fromJust $ stripSuffix ".rts"  s
+
+main :: IO ()
+main = do
+  (csvPath:rtsDir:_) <- getArgs
+  csv <- readCsv csvPath
+  let csvMap = Data.Map.fromList $ map (\x -> (map (\c -> if c == ' ' then '-' else c) $ name x,x)) csv
+  rtsMap<- Data.Map.fromList `fmap` readAllRts rtsDir
+  let measurements = intersectionWith (\x -> \y -> (x,y)) csvMap rtsMap
+
+  forM_ (elems measurements) printResult
+printResult :: (CsvRecord,[(String,Double)]) -> IO ()
+printResult (csv,xs) = do
+  putStrLn $ name csv
+  putStrLn $ "\tSuccess: " ++ ( T.unpack $ success csv)
+  if (T.unpack $ success csv) == "True" then do
+    putStrLn $ "\t1st time: " ++ ( show $ firstTime csv)
+    putStrLn $ "\tavg time: " ++ ( show $ avgTime csv)
+    forM_ xs (\ (n,m) -> putStrLn $ "\t"++n ++ ": "++ (show m))
+  else pure ()
+

.github/workflows/bench.yml

@@ -50,7 +50,7 @@ jobs:
                          , ".gitlab/**"
                          ]'
 
-  bench_init:
+  bench:
     if: needs.pre_job.outputs.should_skip != 'true'
     needs: pre_job
     runs-on: ${{ matrix.os }}
@@ -88,107 +88,23 @@ jobs:
     # for dependency resolution failure
     - run: cabal configure --enable-benchmarks --max-backjumps 12000
 
-    - name: Build
-      run: cabal build haskell-language-server:benchmark
-
-    - name: Bench init
-      run: cabal bench -j --benchmark-options="all-binaries"
-
-    # tar is required to preserve file permissions
-    # compression speeds up upload/download nicely
-    - name: tar workspace
-      run: tar -czf workspace.tar.gz * .git
-
-    - name: tar cabal
-      run: |
-        cd ~/.cabal
-        tar -czf cabal.tar.gz *
-
-    - name: Upload workspace
-      uses: actions/upload-artifact@v7
-      with:
-        name: workspace-${{ matrix.ghc }}-${{ matrix.os }}
-        retention-days: 1
-        path: workspace.tar.gz
-
-    - name: Upload .cabal
-      uses: actions/upload-artifact@v7
-      with:
-        name: cabal-home-${{ matrix.ghc }}-${{ matrix.os }}
-        retention-days: 1
-        path: ~/.cabal/cabal.tar.gz
-
-  bench_example:
-    if: contains(github.event.pull_request.labels.*.name, 'performance')
-    needs: [bench_init, pre_job]
-    runs-on: ${{ matrix.os }}
-
-    strategy:
-      fail-fast: false
-      matrix:
-        ghc: ${{ fromJSON(needs.pre_job.outputs.bench_ghc_versions) }}
-        os: [ubuntu-latest]
-        cabal: ['3.16']
-        example: ['cabal', 'lsp-types']
-
-    steps:
-    - uses: haskell-actions/setup@v2.11
-      with:
-        ghc-version  : ${{ matrix.ghc   }}
-        cabal-version: ${{ matrix.cabal }}
-        enable-stack: false
-
-    - name: Download cabal home
-      uses: actions/download-artifact@v8
-      with:
-        name: cabal-home-${{ matrix.ghc }}-${{ matrix.os }}
-        path: .
-
-    - name: Download workspace
-      uses: actions/download-artifact@v8
-      with:
-        name: workspace-${{ matrix.ghc }}-${{ matrix.os }}
-        path: .
+    - name: Build hls
+      run: cabal build exe:haskell-language-server
 
-    - name: untar
-      run: |
-        mkdir -p ~/.cabal
-        tar xzf workspace.tar.gz
-        tar xzf cabal.tar.gz --directory ~/.cabal
+    - name: Build
+      run: cabal build exe:ghcide-bench
 
     - name: Bench
-      run: cabal bench -j --benchmark-options="${{ matrix.example }}"
+      run: cabal run ghcide-bench -- --example-name cabal --samples 10 --no-clean --rts-profiling rts-stats --csv results.csv --ghcide $(cabal list-bin exe:haskell-language-server)
 
     - name: Display results
-      run: |
-        column -s, -t < bench-results/unprofiled/${{ matrix.example }}/results.csv | tee bench-results/unprofiled/${{ matrix.example }}/results.txt
-        echo
-        echo "Performance Diff(comparing to its previous Version):"
-        column -s, -t < bench-results/unprofiled/${{ matrix.example }}/resultDiff.csv | tee bench-results/unprofiled/${{ matrix.example }}/resultDiff.txt
+      run: .github/bench.hs results.csv rts-stats
 
-    - name: tar benchmarking artifacts
-      run:  find bench-results -name "*.csv" | xargs tar -czf benchmark-artifacts.tar.gz
-
-    - name: Archive benchmarking artifacts
-      uses: actions/upload-artifact@v7
-      with:
-        name: bench-results-${{ matrix.example }}-${{ runner.os }}-${{ matrix.ghc }}
-        path: benchmark-artifacts.tar.gz
-
-    - name: tar benchmarking logs
-      # We dont' store the eventlogs because the CI workers risk running out of disk space
-      run: find bench-results -name "*.log" -or -name "*.hp" | xargs tar -czf benchmark-logs.tar.gz
-
-    - name: Archive benchmark logs
-      uses: actions/upload-artifact@v7
-      with:
-        name: bench-logs-${{ matrix.example }}-${{ runner.os }}-${{ matrix.ghc }}
-        path: benchmark-logs.tar.gz
 
   bench_post_job:
     if: always()
     runs-on: ubuntu-latest
-    needs: [pre_job, bench_init, bench_example]
+    needs: [pre_job, bench]
     steps:
       - run: |
           echo "jobs info: ${{ toJSON(needs) }}"

ghcide-bench/src/Experiments.hs

@@ -402,7 +402,7 @@
 examplesPath = "bench/example"
 
 defConfig :: Config
 Success defConfig = execParserPure defaultPrefs (info configP fullDesc) ["--example-name", "examples"]
 
 quiet, verbose :: Config -> Bool
 verbose = (== All) . verbosity
@@ -419,6 +419,7 @@
         )
     <*> optional (strOption (long "shake-profiling" <> metavar "PATH"))
     <*> optional (strOption (long "ot-profiling" <> metavar "DIR" <> help "Enable OpenTelemetry and write eventlog for each benchmark in DIR"))
+    <*> optional (strOption (long "rts-profiling" <> metavar "DIR" <> help "Enable RTS profiling and write stats for each benchmark in DIR"))
     <*> strOption (long "csv" <> metavar "PATH" <> value "results.csv" <> showDefault)
     <*> flag Cabal Stack (long "stack" <> help "Use stack (by default cabal is used)")
     <*> many (strOption (long "ghcide-options" <> help "additional options for ghcide"))
@@ -495,6 +496,8 @@
 
   whenJust (otMemoryProfiling ?config) $ \eventlogDir ->
       createDirectoryIfMissing True eventlogDir
+  whenJust (rtsProfiling ?config) $ \rtsDir ->
+    createDirectoryIfMissing True rtsDir
 
   lspConfig <- if Experiments.Types.lspConfig ?config
     then either error id . eitherDecodeStrict' <$> BS.getContents
@@ -510,7 +513,7 @@
   results <- forM benchmarks $ \b@Bench{name} ->  do
     let p = (proc (ghcide ?config) (allArgs name dir))
                 { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
         run sess = withCreateProcess p $ \(Just inH) (Just outH) (Just errH) pH -> do
                     -- Need to continuously consume to stderr else it gets blocked
                     -- Can't pass NoStream either to std_err
                     hSetBuffering errH NoBuffering
@@ -523,7 +526,7 @@
 
   let headers = map fst summaryColumns
       summaryRow showTime b r = [ renderCell showTime (cell b r) | (_, cell) <- summaryColumns ]
-      csv = T.unlines $ map (T.intercalate ", ")
+      csv = T.unlines $ map (T.intercalate ",")
               (headers : [ summaryRow showMs b r | (b, r) <- results ])
   TIO.writeFile (outputCSV ?config) csv
 
@@ -547,6 +550,14 @@
                ]
              | Just dir <- [otMemoryProfiling ?config]
              ]
+          ++ concat
+             [ [ "+RTS"
+               , "-t" ++ (dir </> map (\c -> if c == ' ' then '-' else c) name <.> "rts")
+               , "--machine-readable"
+               , "-RTS"
+               ]
+             | Just dir <- [rtsProfiling ?config]
+             ]
           ++ ghcideOptions ?config
           ++ concat
             [ ["--shake-profiling", path] | Just path <- [shakeProfiling ?config]
@@ -624,7 +635,7 @@
         output $ "Setting up document contents took " <> showDuration d
         -- wait again, as the progress is restarted once while loading the cradle
         -- make an edit, to ensure this doesn't block
         let DocumentPositions{..} = head docs
         changeDoc doc [charEdit stringLiteralP]
         waitForProgressDone
         return docs

ghcide-bench/src/Experiments/Types.hs

@@ -22,6 +22,7 @@ data Config = Config
     -- For some reason, the Shake profile files are truncated and won't load
     shakeProfiling    :: !(Maybe FilePath),
     otMemoryProfiling :: !(Maybe FilePath),
+    rtsProfiling      :: !(Maybe FilePath),
     outputCSV         :: !FilePath,
     buildTool         :: !CabalStack,
     ghcideOptions     :: ![String],