db456b0 · ghcide · git.iko.soy

git.iko.soy/ghcide

Add a new flag --shake-profiling DIR (#307)

The flag provides a way to enable Shake profiling reports without recompiling. Debug output prints links to the Shake reports for convenience

commitdb456b0e51bdec24f7ada0170ee08679de91020c authorPepe Iborra <pepeiborra@gmail.com> dateMon 6 Jan 2020, 18:56 (7 years ago) parentfd163cd

3 files changed+22−10

compare with master

unifiedsplit

exe/Arguments.hs+2 exe/Main.hs+3−1 src/Development/IDE/Core/Shake.hs+17−9

exe/Arguments.hs+2

@@ -11,6 +11,7 @@ data Arguments = Arguments

1111 ,argsCwd :: Maybe FilePath

1212 ,argFiles :: [FilePath]

1313 ,argsVersion :: Bool

14+ ,argsShakeProfiling :: Maybe FilePath

1415 }

1516

1617getArguments :: IO Arguments

@@ -27,3 +28,4 @@ arguments = Arguments

2728 <*> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory")

2829 <*> many (argument str (metavar "FILES/DIRS..."))

2930 <*> switch (long "version" <> help "Show ghcide and GHC versions")

31+ <*> optional (strOption $ long "shake-profiling" <> metavar "DIR" <> help "Dump profiling reports to this directory")

exe/Main.hs+3−1

@@ -93,7 +93,9 @@ main = do

9393 -- very important we only call loadSession once, and it's fast, so just do it before starting

9494 session <- loadSession dir

9595 let options = (defaultIdeOptions $ return session)

96− { optReportProgress = clientSupportsProgress caps }

96+ { optReportProgress = clientSupportsProgress caps

97+ , optShakeProfiling = argsShakeProfiling

98+ }

9799 initialise (mainRule >> action kick) getLspId event (logger minBound) options vfs

98100 else do

99101 putStrLn $ "Ghcide setup tester in " ++ dir ++ "."

src/Development/IDE/Core/Shake.hs+17−9

@@ -53,9 +53,10 @@ import qualified Data.ByteString.Internal as BS

5353import Data.Dynamic

5454import Data.Maybe

5555import Data.Map.Strict (Map)

56−import Data.List.Extra

56+import Data.List.Extra (foldl', partition, takeEnd)

5757import qualified Data.Set as Set

5858import qualified Data.Text as T

59+import Data.Traversable (for)

5960import Data.Tuple.Extra

6061import Data.Unique

6162import Development.IDE.Core.Debouncer

@@ -227,14 +228,15 @@ data IdeState = IdeState

227228

228229

229230-- This is debugging code that generates a series of profiles, if the Boolean is true

230−shakeRunDatabaseProfile :: Maybe FilePath -> ShakeDatabase -> [Action a] -> IO [a]

231+shakeRunDatabaseProfile :: Maybe FilePath -> ShakeDatabase -> [Action a] -> IO ([a], Maybe FilePath)

231232shakeRunDatabaseProfile mbProfileDir shakeDb acts = do

232233 (time, (res,_)) <- duration $ shakeRunDatabase shakeDb acts

233− whenJust mbProfileDir $ \dir -> do

234− count <- modifyVar profileCounter $ \x -> let !y = x+1 in return (y,y)

235− let file = "ide-" ++ profileStartTime ++ "-" ++ takeEnd 5 ("0000" ++ show count) ++ "-" ++ showDP 2 time <.> "html"

236− shakeProfileDatabase shakeDb $ dir </> file

237− return res

234+ proFile <- for mbProfileDir $ \dir -> do

235+ count <- modifyVar profileCounter $ \x -> let !y = x+1 in return (y,y)

236+ let file = "ide-" ++ profileStartTime ++ "-" ++ takeEnd 5 ("0000" ++ show count) ++ "-" ++ showDP 2 time <.> "html"

237+ shakeProfileDatabase shakeDb $ dir </> file

238+ return (dir </> file)

239+ return (res, proFile)

238240 where

239241

240242{-# NOINLINE profileStartTime #-}

@@ -392,9 +394,15 @@ shakeRun IdeState{shakeExtras=ShakeExtras{..}, ..} acts =

392394 let res' = case res of

393395 Left e -> "exception: " <> displayException e

394396 Right _ -> "completed"

397+ profile = case res of

398+ Right (_, Just fp) ->

399+ let link = case filePathToUri' $ toNormalizedFilePath fp of

400+ NormalizedUri x -> x

401+ in ", profile saved at " <> T.unpack link

402+ _ -> ""

395403 logDebug logger $ T.pack $

396− "Finishing shakeRun (took " ++ showDuration runTime ++ ", " ++ res' ++ ")"

397− signalBarrier bar res

404+ "Finishing shakeRun (took " ++ showDuration runTime ++ ", " ++ res' ++ profile ++ ")"

405+ signalBarrier bar (fst <$> res)

398406 -- important: we send an async exception to the thread, then wait for it to die, before continuing

399407 pure (killThread thread >> void (waitBarrier bar), either throwIO return =<< waitBarrier bar))

400408