mirror of
https://github.com/haskell/ghcide.git
synced 2024-08-15 08:30:31 +03:00
Opentelemetry traces and heapsize memory analysis (#922)
* Move tracing functions to own module
* Bump opentelemetry to 0.6.0
* Write Values map size to OpenTelemetry metric
* Trace all requests and notifications
Instead of doing it in `HoverDefinition`, do it in
with{Response,Notification,...}. These wrap all handlers, so this should
cover everything. It also means that the span covers the entire
processing time for the request, where before we missed the setup
happening in the with* functions.
* Add flag for OpenTelemetry profiling
Run GC regularly with --ot-profiling
* Add flag to enable OT profiling in benchmark
* Use heapsize instead of ghc-datasize
I renamed the fork to distringuish from the original.
It is still being pulled from git using stack. This will be addressed
once I can push the fork to hackage.
* Bump opentelemetry to 0.6.1 - fixes 8.6 build
* Use heapsize from hackage
* Address HLint messages
* Record size of each key independently
* Refactor `startTelemetry` function
* Remove delay between measuring memory loops
* Each key in values map gets own OT instrument
* Measure values map length more rarely
* Rename --ot-profiling to --ot-memory-profiling
* Add docs for how to use the opentelemetry output
* Add instructions to build release version of tracy
* Clarify dependencies in opentelemetry instructions
* Fix LSP traces
* otTraced: delete unused
* Extract types out of D.IDE.Core.Shake
to avoid circular module dependencies
* Extract startTelemetry out of D.IDE.Shake and upgrade to 0.2
No more segfaults
* [nix] install opentelemetry
* [nix] install tracy
* Fix merge wibble
* Measure recursive sizes with sharing
* Sort keys for cost attribution
* Remove debug traces
* Allocate less, group keys, clean up hlints
* Add -A4G to the flags used for --ot-memory-profiling
* Modularize D.IDE.Core.Tracing
I want to reuse this code more directly in the non lsp driver
* Direct driver: report closure sizes when --ot-memory-profiling
An eventlog memory analysis doesnt' seem so relevant since this mode is not
interactive, but we could easily produce both if wanted to
* Everything is reachable from GhcSessionIO, so compute it last
I suspect the ShakeExtras record is reachable from GhcSessionIO
* bound recursion and use logger
* hlint suggestions
* Fix 8.6 build
* Format imports
* Do the memory analysis with full sharing. GhcSessionIO last
* Fail fast in the memory analysis
* error handling
* runHeapsize now takes initSize as an input argument
* Trace Shake sessions
* Reduced frequency for sampling values length
* Drop the -fexternal-interpreter flag in the Windows stack build
* Produce more benchmark artifacts
* Fix stack descriptors to use heapsize-0.2 from Hackage
* Bump to heapsize-0.3.0
* Record completions snippets (#900)
* Add field for RecordSnippets to CachcedCompletion
* Initial version of local record snippets
* Supprt record snippet completion for non local declarations.
* Better integration of local completions with current implementation
* Clean up non-local completions.
* Remove commented code.
* Switch from String to Text
* Remove ununsed definition
* Treat only Records and leave other defintions as is.
* Differentiate Records from Data constructors for external declaration
* Update test to include snippet in local record completions expected list.
* Update completionTest to also compare insertText.
* Add test for record snippet completion for imported records.
* Hlint fixes
* Hlint fixes
* Hlint suggestions.
* Update type.
* Consolidate imports
* Unpack tuple with explicit names
* Idiomatic changes
* Remove unused variable
* Better variable name
* Hlint suggestions
* Handle exhaustive pattern warning
* Add _ to snippet field name suggestions
* Remove type information passed around but not used
* Update to list comprehension style
* Eliminate intermediate function
* HLint suggestions.
* Idiomatic list comprehension
Co-authored-by: Pepe Iborra <pepeiborra@me.com>
* [nix] use gitignore.nix (#920)
* Ignore import list while producing completions (#919)
* Drop any items in explicit import list
* Test if imports not included in explicit list show up in completions
* Update README.md (#924)
* Custom cradle loading (#928)
When using ghcide as a library, it may be desirable to host the hie.yaml file
in a location other than the project root, or even avoid the file system altogether
* Favor `lookupPathToId` over `pathToId` (#926)
* Favor `lookupPathToId` over `pathToId`
* Fix `typecheckParentsAction`
* Fix `needsCompilationRule`
* Return completion snippets only when client supports it (#929)
* Use the real client capabilities on completions
* Return completion snippets only when supported by the client
Restored from https://github.com/haskell/ghcide/pull/900
* Redundant import
* Fix stack windows build
Co-authored-by: Michalis Pardalos <m.pardalos@gmail.com>
Co-authored-by: Michalis Pardalos <mpardalos@gmail.com>
Co-authored-by: Guru Devanla <gdevanla@users.noreply.github.com>
Co-authored-by: Samuel Ainsworth <skainsworth@gmail.com>
This commit is contained in:
Pepe Iborra
GitHub
parent
28f33ccb1a
commit
e24a744a06
2
.github/workflows/bench.yml
vendored
2
.github/workflows/bench.yml
vendored
@ -55,4 +55,4 @@ jobs:
|
||||
name: bench-results-${{ runner.os }}-${{ matrix.ghc }}
|
||||
path: |
|
||||
bench-results/results.*
|
||||
bench-results/*.svg
|
||||
bench-results/**/*.svg
|
||||
|
||||
@ -40,7 +40,7 @@ import Numeric.Natural
|
||||
import Options.Applicative
|
||||
import System.Directory
|
||||
import System.Environment.Blank (getEnv)
|
||||
import System.FilePath ((</>))
|
||||
import System.FilePath ((</>), (<.>))
|
||||
import System.Process
|
||||
import System.Time.Extra
|
||||
import Text.ParserCombinators.ReadP (readP_to_S)
|
||||
@ -129,7 +129,6 @@ exampleModulePath = exampleModule (example ?config)
|
||||
examplesPath :: FilePath
|
||||
examplesPath = "bench/example"
|
||||
|
||||
|
||||
defConfig :: Config
|
||||
Success defConfig = execParserPure defaultPrefs (info configP fullDesc) []
|
||||
|
||||
@ -147,6 +146,7 @@ configP =
|
||||
<|> pure Normal
|
||||
)
|
||||
<*> 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"))
|
||||
<*> 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"))
|
||||
@ -212,6 +212,10 @@ runBenchmarksFun dir allBenchmarks = do
|
||||
let benchmarks = [ b{samples = fromMaybe (samples b) (repetitions ?config) }
|
||||
| b <- allBenchmarks
|
||||
, select b ]
|
||||
|
||||
whenJust (otMemoryProfiling ?config) $ \eventlogDir ->
|
||||
createDirectoryIfMissing True eventlogDir
|
||||
|
||||
results <- forM benchmarks $ \b@Bench{name} ->
|
||||
let run = runSessionWithConfig conf (cmd name dir) lspTestCaps dir
|
||||
in (b,) <$> runBench run b
|
||||
@ -278,14 +282,18 @@ runBenchmarksFun dir allBenchmarks = do
|
||||
"--cwd",
|
||||
dir,
|
||||
"+RTS",
|
||||
"-S" <> gcStats name,
|
||||
"-RTS"
|
||||
"-S" <> gcStats name
|
||||
]
|
||||
++ case otMemoryProfiling ?config of
|
||||
Just dir -> ["-l", "-ol" ++ (dir </> (map (\c -> if c == ' ' then '-' else c) name) <.> "eventlog")]
|
||||
Nothing -> []
|
||||
++ [ "-RTS" ]
|
||||
++ ghcideOptions ?config
|
||||
++ concat
|
||||
[ ["--shake-profiling", path] | Just path <- [shakeProfiling ?config]
|
||||
]
|
||||
++ ["--verbose" | verbose ?config]
|
||||
++ if isJust (otMemoryProfiling ?config) then [ "--ot-memory-profiling" ] else []
|
||||
lspTestCaps =
|
||||
fullCaps {_window = Just $ WindowClientCapabilities $ Just True}
|
||||
conf =
|
||||
|
||||
@ -18,6 +18,7 @@ data Config = Config
|
||||
{ verbosity :: !Verbosity,
|
||||
-- For some reason, the Shake profile files are truncated and won't load
|
||||
shakeProfiling :: !(Maybe FilePath),
|
||||
otMemoryProfiling :: !(Maybe FilePath),
|
||||
outputCSV :: !FilePath,
|
||||
buildTool :: !CabalStack,
|
||||
ghcideOptions :: ![String],
|
||||
|
||||
66
docs/opentelemetry.md
Normal file
66
docs/opentelemetry.md
Normal file
@ -0,0 +1,66 @@
|
||||
# Using opentelemetry
|
||||
|
||||
`ghcide` has support for opentelemetry-based tracing. This allows for tracing
|
||||
the execution of the process, seeing when Shake rules fire and for how long they
|
||||
run, when LSP messages are received, and (currently WIP) measuring the memory
|
||||
occupancy of different objects in memory.
|
||||
|
||||
## Capture opentlemetry data
|
||||
|
||||
Capturing of opentelemetry data can be enabled by first building ghcide with eventlog support:
|
||||
|
||||
```sh
|
||||
stack build --ghc-options -eventlog
|
||||
```
|
||||
|
||||
Then, you can run `ghcide`, giving it a file to dump eventlog information into.
|
||||
|
||||
```sh
|
||||
ghcide +RTS -l -ol ghcide.eventlog -RTS
|
||||
```
|
||||
|
||||
You can also optionally enable reporting detailed memory data with `--ot-memory-profiling`
|
||||
|
||||
```sh
|
||||
ghcide --ot-memory-profiling +RTS -A4G -l -ol ghcide.eventlog -RTS
|
||||
```
|
||||
|
||||
*Note:* This option, while functional, is extremely slow. You will notice this because the memory graph in the output will have datapoints spaced apart by a couple of minutes. The nursery must be big enough (-A1G or larger) or the measurements will self-abort.
|
||||
|
||||
## Viewing with tracy
|
||||
|
||||
After installing `opentelemetry-extra` and `tracy`, you can view the opentelementry output:
|
||||
|
||||
```sh
|
||||
eventlog-to-tracy ghcide.eventlog
|
||||
```
|
||||
|
||||
If everything has been set up correctly, this should open a tracy window with the tracing data you captured
|
||||
|
||||
### Installing opentelemetry-extra
|
||||
|
||||
This package includes a number of binaries for converting between the eventlog output and the formats that various opentelemetry viewers (like tracy) can display:
|
||||
|
||||
```sh
|
||||
cabal install openetelemetry-extra
|
||||
```
|
||||
|
||||
|
||||
|
||||
### Building tracy
|
||||
|
||||
1. Install the dependencies: `pkg-config` and `glfw, freetype, capstone, GTK3`, along
|
||||
with their header files (`<pkgname>-dev` on most distros. On Arch the header
|
||||
files are included with the normal packages).
|
||||
2. Download tracy from https://github.com/wolfpld/tracy
|
||||
3. `cd` into the directory containing the source you downloaded
|
||||
4. Build the `import-chrome` and `Tracy` libraries:
|
||||
```sh
|
||||
make -C profiler/build/unix release
|
||||
make -C import-chrome/build/unix release
|
||||
```
|
||||
5. Copy the binaries to your `$PATH`:
|
||||
```sh
|
||||
cp profiler/build/unix/Tracy-release ~/.local/bin/Tracy
|
||||
cp import-chrome/build/unix/import-chrome-release ~/.local/bin/import-chrome
|
||||
```
|
||||
@ -12,6 +12,7 @@ data Arguments = Arguments
|
||||
,argFiles :: [FilePath]
|
||||
,argsVersion :: Bool
|
||||
,argsShakeProfiling :: Maybe FilePath
|
||||
,argsOTMemoryProfiling :: Bool
|
||||
,argsTesting :: Bool
|
||||
,argsThreads :: Int
|
||||
,argsVerbose :: Bool
|
||||
@ -32,6 +33,7 @@ arguments = Arguments
|
||||
<*> many (argument str (metavar "FILES/DIRS..."))
|
||||
<*> switch (long "version" <> help "Show ghcide and GHC versions")
|
||||
<*> optional (strOption $ long "shake-profiling" <> metavar "DIR" <> help "Dump profiling reports to this directory")
|
||||
<*> switch (long "ot-memory-profiling" <> help "Record OpenTelemetry info to the eventlog. Needs the -l RTS flag to have an effect")
|
||||
<*> switch (long "test" <> help "Enable additional lsp messages used by the testsuite")
|
||||
<*> option auto (short 'j' <> help "Number of threads (0: automatic)" <> metavar "NUM" <> value 0 <> showDefault)
|
||||
<*> switch (long "verbose" <> help "Include internal events in logging output")
|
||||
|
||||
50
exe/Main.hs
50
exe/Main.hs
@ -51,6 +51,9 @@ import qualified Data.Aeson as J
|
||||
|
||||
import HIE.Bios.Cradle
|
||||
import Development.IDE (action)
|
||||
import Text.Printf
|
||||
import Development.IDE.Core.Tracing
|
||||
import Development.IDE.Types.Shake (Key(Key))
|
||||
|
||||
ghcideVersion :: IO String
|
||||
ghcideVersion = do
|
||||
@ -105,12 +108,13 @@ main = do
|
||||
sessionLoader <- loadSession $ fromMaybe dir rootPath
|
||||
config <- fromMaybe defaultLspConfig <$> getConfig
|
||||
let options = (defaultIdeOptions sessionLoader)
|
||||
{ optReportProgress = clientSupportsProgress caps
|
||||
, optShakeProfiling = argsShakeProfiling
|
||||
, optTesting = IdeTesting argsTesting
|
||||
, optThreads = argsThreads
|
||||
, optCheckParents = checkParents config
|
||||
, optCheckProject = checkProject config
|
||||
{ optReportProgress = clientSupportsProgress caps
|
||||
, optShakeProfiling = argsShakeProfiling
|
||||
, optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
|
||||
, optTesting = IdeTesting argsTesting
|
||||
, optThreads = argsThreads
|
||||
, optCheckParents = checkParents config
|
||||
, optCheckProject = checkProject config
|
||||
}
|
||||
logLevel = if argsVerbose then minBound else Info
|
||||
debouncer <- newAsyncDebouncer
|
||||
@ -139,22 +143,46 @@ main = do
|
||||
putStrLn "\nStep 3/4: Initializing the IDE"
|
||||
vfs <- makeVFSHandle
|
||||
debouncer <- newAsyncDebouncer
|
||||
let logLevel = if argsVerbose then minBound else Info
|
||||
dummyWithProg _ _ f = f (const (pure ()))
|
||||
let dummyWithProg _ _ f = f (const (pure ()))
|
||||
sessionLoader <- loadSession dir
|
||||
ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger logLevel) debouncer (defaultIdeOptions sessionLoader) vfs
|
||||
let options = (defaultIdeOptions sessionLoader)
|
||||
{ optShakeProfiling = argsShakeProfiling
|
||||
-- , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
|
||||
, optTesting = IdeTesting argsTesting
|
||||
, optThreads = argsThreads
|
||||
}
|
||||
logLevel = if argsVerbose then minBound else Info
|
||||
ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger logLevel) debouncer options vfs
|
||||
|
||||
putStrLn "\nStep 4/4: Type checking the files"
|
||||
setFilesOfInterest ide $ HashMap.fromList $ map ((, OnDisk) . toNormalizedFilePath') files
|
||||
results <- runAction "User TypeCheck" ide $ uses TypeCheck (map toNormalizedFilePath' files)
|
||||
_results <- runAction "GetHie" ide $ uses GetHieAst (map toNormalizedFilePath' files)
|
||||
_results <- runAction "GenerateCore" ide $ uses GenerateCore (map toNormalizedFilePath' files)
|
||||
let (worked, failed) = partition fst $ zip (map isJust results) files
|
||||
when (failed /= []) $
|
||||
putStr $ unlines $ "Files that failed:" : map ((++) " * " . snd) failed
|
||||
|
||||
let files xs = let n = length xs in if n == 1 then "1 file" else show n ++ " files"
|
||||
putStrLn $ "\nCompleted (" ++ files worked ++ " worked, " ++ files failed ++ " failed)"
|
||||
let nfiles xs = let n = length xs in if n == 1 then "1 file" else show n ++ " files"
|
||||
putStrLn $ "\nCompleted (" ++ nfiles worked ++ " worked, " ++ nfiles failed ++ " failed)"
|
||||
|
||||
when argsOTMemoryProfiling $ do
|
||||
let valuesRef = state $ shakeExtras ide
|
||||
values <- readVar valuesRef
|
||||
let consoleObserver Nothing = return $ \size -> printf "Total: %.2fMB\n" (fromIntegral @Int @Double size / 1e6)
|
||||
consoleObserver (Just k) = return $ \size -> printf " - %s: %.2fKB\n" (show k) (fromIntegral @Int @Double size / 1e3)
|
||||
|
||||
printf "# Shake value store contents(%d):\n" (length values)
|
||||
let keys = nub
|
||||
$ Key GhcSession : Key GhcSessionDeps
|
||||
: [ k | (_,k) <- HashMap.keys values, k /= Key GhcSessionIO]
|
||||
++ [Key GhcSessionIO]
|
||||
measureMemory (logger logLevel) [keys] consoleObserver valuesRef
|
||||
|
||||
unless (null failed) (exitWith $ ExitFailure (length failed))
|
||||
|
||||
{-# ANN main ("HLint: ignore Use nubOrd" :: String) #-}
|
||||
|
||||
expandFiles :: [FilePath] -> IO [FilePath]
|
||||
expandFiles = concatMapM $ \x -> do
|
||||
b <- IO.doesFileExist x
|
||||
|
||||
@ -57,6 +57,7 @@ library
|
||||
hie-compat,
|
||||
mtl,
|
||||
network-uri,
|
||||
parallel,
|
||||
prettyprinter-ansi-terminal,
|
||||
prettyprinter-ansi-terminal,
|
||||
prettyprinter,
|
||||
@ -73,7 +74,9 @@ library
|
||||
transformers,
|
||||
unordered-containers >= 0.2.10.0,
|
||||
utf8-string,
|
||||
hslogger
|
||||
hslogger,
|
||||
opentelemetry >=0.6.1,
|
||||
heapsize ==0.3.*
|
||||
if flag(ghc-lib)
|
||||
build-depends:
|
||||
ghc-lib >= 8.8,
|
||||
@ -134,6 +137,7 @@ library
|
||||
Development.IDE.Core.RuleTypes
|
||||
Development.IDE.Core.Service
|
||||
Development.IDE.Core.Shake
|
||||
Development.IDE.Core.Tracing
|
||||
Development.IDE.GHC.Compat
|
||||
Development.IDE.GHC.Error
|
||||
Development.IDE.GHC.Orphans
|
||||
@ -149,9 +153,11 @@ library
|
||||
Development.IDE.Spans.LocalBindings
|
||||
Development.IDE.Types.Diagnostics
|
||||
Development.IDE.Types.Exports
|
||||
Development.IDE.Types.KnownTargets
|
||||
Development.IDE.Types.Location
|
||||
Development.IDE.Types.Logger
|
||||
Development.IDE.Types.Options
|
||||
Development.IDE.Types.Shake
|
||||
Development.IDE.Plugin
|
||||
Development.IDE.Plugin.Completions
|
||||
Development.IDE.Plugin.CodeAction
|
||||
@ -262,6 +268,7 @@ executable ghcide
|
||||
hashable,
|
||||
haskell-lsp,
|
||||
haskell-lsp-types,
|
||||
heapsize,
|
||||
hie-bios,
|
||||
ghcide,
|
||||
lens,
|
||||
|
||||
@ -29,15 +29,19 @@ haskellPackagesForProject.shellFor {
|
||||
gmp
|
||||
zlib
|
||||
ncurses
|
||||
capstone
|
||||
tracy
|
||||
|
||||
haskellPackages.cabal-install
|
||||
haskellPackages.hlint
|
||||
haskellPackages.ormolu
|
||||
haskellPackages.stylish-haskell
|
||||
haskellPackages.opentelemetry-extra
|
||||
];
|
||||
src = null;
|
||||
shellHook = ''
|
||||
export LD_LIBRARY_PATH=${gmp}/lib:${zlib}/lib:${ncurses}/lib
|
||||
export LD_LIBRARY_PATH=${gmp}/lib:${zlib}/lib:${ncurses}/lib:${capstone}/lib
|
||||
export DYLD_LIBRARY_PATH=${gmp}/lib:${zlib}/lib:${ncurses}/lib:${capstone}/lib
|
||||
export PATH=$PATH:$HOME/.local/bin
|
||||
'';
|
||||
}
|
||||
|
||||
@ -8,8 +8,7 @@ module Development.IDE
|
||||
|
||||
import Development.IDE.Core.RuleTypes as X
|
||||
import Development.IDE.Core.Rules as X
|
||||
(GhcSessionIO(..)
|
||||
,getAtPoint
|
||||
(getAtPoint
|
||||
,getDefinition
|
||||
,getParsedModule
|
||||
,getTypeDefinition
|
||||
|
||||
@ -18,7 +18,7 @@ import Data.Binary
|
||||
import Development.IDE.Import.DependencyInformation
|
||||
import Development.IDE.GHC.Compat hiding (HieFileResult)
|
||||
import Development.IDE.GHC.Util
|
||||
import Development.IDE.Core.Shake (KnownTargets)
|
||||
import Development.IDE.Types.KnownTargets
|
||||
import Data.Hashable
|
||||
import Data.Typeable
|
||||
import qualified Data.Set as S
|
||||
@ -36,6 +36,7 @@ import Data.ByteString (ByteString)
|
||||
import Language.Haskell.LSP.Types (NormalizedFilePath)
|
||||
import TcRnMonad (TcGblEnv)
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import Development.IDE.Types.Options (IdeGhcSession)
|
||||
|
||||
data LinkableType = ObjectLinkable | BCOLinkable
|
||||
deriving (Eq,Ord,Show)
|
||||
@ -138,10 +139,10 @@ data HieAstResult
|
||||
-- Lazyness can't cause leaks here because the lifetime of `refMap` will be the same
|
||||
-- as that of `hieAst`
|
||||
}
|
||||
|
||||
|
||||
instance NFData HieAstResult where
|
||||
rnf (HAR m hf _rm) = rnf m `seq` rwhnf hf
|
||||
|
||||
|
||||
instance Show HieAstResult where
|
||||
show = show . hieModule
|
||||
|
||||
@ -335,3 +336,13 @@ instance NFData GetClientSettings
|
||||
instance Binary GetClientSettings
|
||||
|
||||
type instance RuleResult GetClientSettings = Hashed (Maybe Value)
|
||||
|
||||
-- A local rule type to get caching. We want to use newCache, but it has
|
||||
-- thread killed exception issues, so we lift it to a full rule.
|
||||
-- https://github.com/digital-asset/daml/pull/2808#issuecomment-529639547
|
||||
type instance RuleResult GhcSessionIO = IdeGhcSession
|
||||
|
||||
data GhcSessionIO = GhcSessionIO deriving (Eq, Show, Typeable, Generic)
|
||||
instance Hashable GhcSessionIO
|
||||
instance NFData GhcSessionIO
|
||||
instance Binary GhcSessionIO
|
||||
|
||||
@ -624,16 +624,6 @@ currentLinkables = do
|
||||
where
|
||||
go (mod, time) = LM time mod []
|
||||
|
||||
-- A local rule type to get caching. We want to use newCache, but it has
|
||||
-- thread killed exception issues, so we lift it to a full rule.
|
||||
-- https://github.com/digital-asset/daml/pull/2808#issuecomment-529639547
|
||||
type instance RuleResult GhcSessionIO = IdeGhcSession
|
||||
|
||||
data GhcSessionIO = GhcSessionIO deriving (Eq, Show, Typeable, Generic)
|
||||
instance Hashable GhcSessionIO
|
||||
instance NFData GhcSessionIO
|
||||
instance Binary GhcSessionIO
|
||||
|
||||
loadGhcSession :: Rules ()
|
||||
loadGhcSession = do
|
||||
-- This function should always be rerun because it tracks changes
|
||||
|
||||
@ -1,8 +1,7 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
|
||||
-- SPDX-License-Identifier: Apache-2.0
|
||||
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE RecursiveDo #-}
|
||||
@ -70,7 +69,6 @@ import Development.Shake hiding (ShakeValue, doesFileExist, Info)
|
||||
import Development.Shake.Database
|
||||
import Development.Shake.Classes
|
||||
import Development.Shake.Rule
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HMap
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
@ -78,17 +76,18 @@ import Data.Dynamic
|
||||
import Data.Maybe
|
||||
import Data.Map.Strict (Map)
|
||||
import Data.List.Extra (partition, takeEnd)
|
||||
import Data.HashSet (HashSet)
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Text as T
|
||||
import Data.Tuple.Extra
|
||||
import Data.Unique
|
||||
import Development.IDE.Core.Debouncer
|
||||
import Development.IDE.GHC.Compat (ModuleName, NameCacheUpdater(..), upNameCache )
|
||||
import Development.IDE.GHC.Compat (NameCacheUpdater(..), upNameCache )
|
||||
import Development.IDE.GHC.Orphans ()
|
||||
import Development.IDE.Core.PositionMapping
|
||||
import Development.IDE.Types.Action
|
||||
import Development.IDE.Types.Logger hiding (Priority)
|
||||
import Development.IDE.Types.KnownTargets
|
||||
import Development.IDE.Types.Shake
|
||||
import qualified Development.IDE.Types.Logger as Logger
|
||||
import Language.Haskell.LSP.Diagnostics
|
||||
import qualified Data.SortedList as SL
|
||||
@ -119,14 +118,15 @@ import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Data.Traversable
|
||||
import Data.Hashable
|
||||
import Development.IDE.Core.Tracing
|
||||
|
||||
import Data.IORef
|
||||
import NameCache
|
||||
import UniqSupply
|
||||
import PrelInfo
|
||||
import Data.Int (Int64)
|
||||
import qualified Data.HashSet as HSet
|
||||
import Language.Haskell.LSP.Types.Capabilities
|
||||
import OpenTelemetry.Eventlog
|
||||
|
||||
-- information we stash inside the shakeExtra field
|
||||
data ShakeExtras = ShakeExtras
|
||||
@ -168,16 +168,6 @@ data ShakeExtras = ShakeExtras
|
||||
,clientCapabilities :: ClientCapabilities
|
||||
}
|
||||
|
||||
-- | A mapping of module name to known files
|
||||
type KnownTargets = HashMap Target [NormalizedFilePath]
|
||||
|
||||
data Target = TargetModule ModuleName | TargetFile NormalizedFilePath
|
||||
deriving ( Eq, Generic, Show )
|
||||
deriving anyclass (Hashable, NFData)
|
||||
|
||||
toKnownFiles :: KnownTargets -> HashSet NormalizedFilePath
|
||||
toKnownFiles = HSet.fromList . concat . HMap.elems
|
||||
|
||||
type WithProgressFunc = forall a.
|
||||
T.Text -> LSP.ProgressCancellable -> ((LSP.Progress -> IO ()) -> IO a) -> IO a
|
||||
type WithIndefiniteProgressFunc = forall a.
|
||||
@ -228,22 +218,6 @@ getIdeGlobalState :: forall a . IsIdeGlobal a => IdeState -> IO a
|
||||
getIdeGlobalState = getIdeGlobalExtras . shakeExtras
|
||||
|
||||
|
||||
-- | The state of the all values.
|
||||
type Values = HMap.HashMap (NormalizedFilePath, Key) (Value Dynamic)
|
||||
|
||||
-- | Key type
|
||||
data Key = forall k . (Typeable k, Hashable k, Eq k, Show k) => Key k
|
||||
|
||||
instance Show Key where
|
||||
show (Key k) = show k
|
||||
|
||||
instance Eq Key where
|
||||
Key k1 == Key k2 | Just k2' <- cast k2 = k1 == k2'
|
||||
| otherwise = False
|
||||
|
||||
instance Hashable Key where
|
||||
hashWithSalt salt (Key key) = hashWithSalt salt (typeOf key, key)
|
||||
|
||||
newtype GlobalIdeOptions = GlobalIdeOptions IdeOptions
|
||||
instance IsIdeGlobal GlobalIdeOptions
|
||||
|
||||
@ -257,21 +231,6 @@ getIdeOptionsIO ide = do
|
||||
GlobalIdeOptions x <- getIdeGlobalExtras ide
|
||||
return x
|
||||
|
||||
data Value v
|
||||
= Succeeded TextDocumentVersion v
|
||||
| Stale TextDocumentVersion v
|
||||
| Failed
|
||||
deriving (Functor, Generic, Show)
|
||||
|
||||
instance NFData v => NFData (Value v)
|
||||
|
||||
-- | Convert a Value to a Maybe. This will only return `Just` for
|
||||
-- up2date results not for stale values.
|
||||
currentValue :: Value v -> Maybe v
|
||||
currentValue (Succeeded _ v) = Just v
|
||||
currentValue (Stale _ _) = Nothing
|
||||
currentValue Failed = Nothing
|
||||
|
||||
-- | Return the most recent, potentially stale, value and a PositionMapping
|
||||
-- for the version of that value.
|
||||
lastValueIO :: ShakeExtras -> NormalizedFilePath -> Value v -> IO (Maybe (v, PositionMapping))
|
||||
@ -446,6 +405,11 @@ shakeOpen getLspId eventer withProgress withIndefiniteProgress clientCapabilitie
|
||||
initSession <- newSession shakeExtras shakeDb []
|
||||
shakeSession <- newMVar initSession
|
||||
let ideState = IdeState{..}
|
||||
|
||||
IdeOptions{ optOTMemoryProfiling = IdeOTMemoryProfiling otProfilingEnabled } <- getIdeOptionsIO shakeExtras
|
||||
when otProfilingEnabled $
|
||||
startTelemetry logger $ state shakeExtras
|
||||
|
||||
return ideState
|
||||
where
|
||||
-- The progress thread is a state machine with two states:
|
||||
@ -619,11 +583,12 @@ newSession extras@ShakeExtras{..} shakeDb acts = do
|
||||
let
|
||||
-- A daemon-like action used to inject additional work
|
||||
-- Runs actions from the work queue sequentially
|
||||
pumpActionThread = do
|
||||
pumpActionThread otSpan = do
|
||||
d <- liftIO $ atomically $ popQueue actionQueue
|
||||
void $ parallel [run d, pumpActionThread]
|
||||
void $ parallel [run otSpan d, pumpActionThread otSpan]
|
||||
|
||||
run d = do
|
||||
-- TODO figure out how to thread the otSpan into defineEarlyCutoff
|
||||
run _otSpan d = do
|
||||
start <- liftIO offsetTime
|
||||
getAction d
|
||||
liftIO $ atomically $ doneQueue d actionQueue
|
||||
@ -634,8 +599,8 @@ newSession extras@ShakeExtras{..} shakeDb acts = do
|
||||
logPriority logger (actionPriority d) msg
|
||||
notifyTestingLogMessage extras msg
|
||||
|
||||
workRun restore = do
|
||||
let acts' = pumpActionThread : map run (reenqueued ++ acts)
|
||||
workRun restore = withSpan "Shake session" $ \otSpan -> do
|
||||
let acts' = pumpActionThread otSpan : map (run otSpan) (reenqueued ++ acts)
|
||||
res <- try @SomeException (restore $ shakeRunDatabase shakeDb acts')
|
||||
let res' = case res of
|
||||
Left e -> "exception: " <> displayException e
|
||||
@ -865,7 +830,7 @@ defineEarlyCutoff
|
||||
:: IdeRule k v
|
||||
=> (k -> NormalizedFilePath -> Action (Maybe BS.ByteString, IdeResult v))
|
||||
-> Rules ()
|
||||
defineEarlyCutoff op = addBuiltinRule noLint noIdentity $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode -> do
|
||||
defineEarlyCutoff op = addBuiltinRule noLint noIdentity $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file $ do
|
||||
extras@ShakeExtras{state, inProgress} <- getShakeExtras
|
||||
-- don't do progress for GetFileExists, as there are lots of non-nodes for just that one key
|
||||
(if show key == "GetFileExists" then id else withProgressVar inProgress file) $ do
|
||||
|
||||
179
src/Development/IDE/Core/Tracing.hs
Normal file
179
src/Development/IDE/Core/Tracing.hs
Normal file
@ -0,0 +1,179 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
module Development.IDE.Core.Tracing
|
||||
( otTracedHandler
|
||||
, otTracedAction
|
||||
, startTelemetry
|
||||
, measureMemory
|
||||
, getInstrumentCached
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent.Async (Async, async)
|
||||
import Control.Concurrent.Extra (Var, modifyVar_, newVar,
|
||||
readVar, threadDelay)
|
||||
import Control.Exception (evaluate)
|
||||
import Control.Exception.Safe (catch, SomeException)
|
||||
import Control.Monad (forM_, forever, (>=>))
|
||||
import Control.Monad.Extra (whenJust)
|
||||
import Control.Seq (r0, seqList, seqTuple2, using)
|
||||
import Data.Dynamic (Dynamic)
|
||||
import qualified Data.HashMap.Strict as HMap
|
||||
import Data.IORef (modifyIORef', newIORef,
|
||||
readIORef, writeIORef)
|
||||
import Data.List (nub)
|
||||
import Data.String (IsString (fromString))
|
||||
import Development.IDE.Core.RuleTypes (GhcSession (GhcSession),
|
||||
GhcSessionDeps (GhcSessionDeps),
|
||||
GhcSessionIO (GhcSessionIO))
|
||||
import Development.IDE.Types.Logger (logInfo, Logger, logDebug)
|
||||
import Development.IDE.Types.Shake (Key (..), Value, Values)
|
||||
import Development.Shake (Action, actionBracket, liftIO)
|
||||
import Foreign.Storable (Storable (sizeOf))
|
||||
import HeapSize (recursiveSize, runHeapsize)
|
||||
import Language.Haskell.LSP.Types (NormalizedFilePath,
|
||||
fromNormalizedFilePath)
|
||||
import Numeric.Natural (Natural)
|
||||
import OpenTelemetry.Eventlog (addEvent, beginSpan, endSpan,
|
||||
mkValueObserver, observe,
|
||||
setTag, withSpan, withSpan_)
|
||||
|
||||
-- | Trace a handler using OpenTelemetry. Adds various useful info into tags in the OpenTelemetry span.
|
||||
otTracedHandler
|
||||
:: String -- ^ Message type
|
||||
-> String -- ^ Message label
|
||||
-> IO a
|
||||
-> IO a
|
||||
otTracedHandler requestType label act =
|
||||
let !name =
|
||||
if null label
|
||||
then requestType
|
||||
else requestType <> ":" <> show label
|
||||
-- Add an event so all requests can be quickly seen in the viewer without searching
|
||||
in withSpan (fromString name) (\sp -> addEvent sp "" (fromString $ name <> " received") >> act)
|
||||
|
||||
-- | Trace a Shake action using opentelemetry.
|
||||
otTracedAction
|
||||
:: Show k
|
||||
=> k -- ^ The Action's Key
|
||||
-> NormalizedFilePath -- ^ Path to the file the action was run for
|
||||
-> Action a -- ^ The action
|
||||
-> Action a
|
||||
otTracedAction key file act = actionBracket
|
||||
(do
|
||||
sp <- beginSpan (fromString (show key))
|
||||
setTag sp "File" (fromString $ fromNormalizedFilePath file)
|
||||
return sp
|
||||
)
|
||||
endSpan
|
||||
(const act)
|
||||
|
||||
startTelemetry :: Logger -> Var Values -> IO ()
|
||||
startTelemetry logger stateRef = do
|
||||
instrumentFor <- getInstrumentCached
|
||||
mapCountInstrument <- mkValueObserver "values map count"
|
||||
|
||||
_ <- regularly (1 * seconds) $
|
||||
withSpan_ "Measure length" $
|
||||
readVar stateRef
|
||||
>>= observe mapCountInstrument . length
|
||||
|
||||
_ <- regularly (1 * seconds) $ do
|
||||
values <- readVar stateRef
|
||||
let keys = nub
|
||||
$ Key GhcSession : Key GhcSessionDeps
|
||||
: [ k | (_,k) <- HMap.keys values
|
||||
-- do GhcSessionIO last since it closes over stateRef itself
|
||||
, k /= Key GhcSessionIO]
|
||||
++ [Key GhcSessionIO]
|
||||
!groupedForSharing <- evaluate (keys `using` seqList r0)
|
||||
measureMemory logger [groupedForSharing] instrumentFor stateRef
|
||||
`catch` \(e::SomeException) ->
|
||||
logInfo logger ("MEMORY PROFILING ERROR: " <> fromString (show e))
|
||||
return ()
|
||||
where
|
||||
seconds = 1000000
|
||||
|
||||
regularly :: Int -> IO () -> IO (Async ())
|
||||
regularly delay act = async $ forever (act >> threadDelay delay)
|
||||
|
||||
{-# ANN startTelemetry ("HLint: ignore Use nubOrd" :: String) #-}
|
||||
|
||||
type OurValueObserver = Int -> IO ()
|
||||
|
||||
getInstrumentCached :: IO (Maybe Key -> IO OurValueObserver)
|
||||
getInstrumentCached = do
|
||||
instrumentMap <- newVar HMap.empty
|
||||
mapBytesInstrument <- mkValueObserver "value map size_bytes"
|
||||
|
||||
let instrumentFor k = do
|
||||
mb_inst <- HMap.lookup k <$> readVar instrumentMap
|
||||
case mb_inst of
|
||||
Nothing -> do
|
||||
instrument <- mkValueObserver (fromString (show k ++ " size_bytes"))
|
||||
modifyVar_ instrumentMap (return . HMap.insert k instrument)
|
||||
return $ observe instrument
|
||||
Just v -> return $ observe v
|
||||
return $ maybe (return $ observe mapBytesInstrument) instrumentFor
|
||||
|
||||
whenNothing :: IO () -> IO (Maybe a) -> IO ()
|
||||
whenNothing act mb = mb >>= f
|
||||
where f Nothing = act
|
||||
f Just{} = return ()
|
||||
|
||||
measureMemory
|
||||
:: Logger
|
||||
-> [[Key]] -- ^ Grouping of keys for the sharing-aware analysis
|
||||
-> (Maybe Key -> IO OurValueObserver)
|
||||
-> Var Values
|
||||
-> IO ()
|
||||
measureMemory logger groups instrumentFor stateRef = withSpan_ "Measure Memory" $ do
|
||||
values <- readVar stateRef
|
||||
valuesSizeRef <- newIORef $ Just 0
|
||||
let !groupsOfGroupedValues = groupValues values
|
||||
logDebug logger "STARTING MEMORY PROFILING"
|
||||
forM_ groupsOfGroupedValues $ \groupedValues -> do
|
||||
keepGoing <- readIORef valuesSizeRef
|
||||
whenJust keepGoing $ \_ ->
|
||||
whenNothing (writeIORef valuesSizeRef Nothing) $
|
||||
repeatUntilJust 3 $ do
|
||||
-- logDebug logger (fromString $ show $ map fst groupedValues)
|
||||
runHeapsize 25000000 $
|
||||
forM_ groupedValues $ \(k,v) -> withSpan ("Measure " <> (fromString $ show k)) $ \sp -> do
|
||||
acc <- liftIO $ newIORef 0
|
||||
observe <- liftIO $ instrumentFor $ Just k
|
||||
mapM_ (recursiveSize >=> \x -> liftIO (modifyIORef' acc (+ x))) v
|
||||
size <- liftIO $ readIORef acc
|
||||
let !byteSize = sizeOf (undefined :: Word) * size
|
||||
setTag sp "size" (fromString (show byteSize ++ " bytes"))
|
||||
() <- liftIO $ observe byteSize
|
||||
liftIO $ modifyIORef' valuesSizeRef (fmap (+ byteSize))
|
||||
|
||||
mbValuesSize <- readIORef valuesSizeRef
|
||||
case mbValuesSize of
|
||||
Just valuesSize -> do
|
||||
observe <- instrumentFor Nothing
|
||||
observe valuesSize
|
||||
logDebug logger "MEMORY PROFILING COMPLETED"
|
||||
Nothing ->
|
||||
logInfo logger "Memory profiling could not be completed: increase the size of your nursery (+RTS -Ax) and try again"
|
||||
|
||||
where
|
||||
groupValues :: Values -> [ [(Key, [Value Dynamic])] ]
|
||||
groupValues values =
|
||||
let !groupedValues =
|
||||
[ [ (k, vv)
|
||||
| k <- groupKeys
|
||||
, let vv = [ v | ((_,k'), v) <- HMap.toList values , k == k']
|
||||
]
|
||||
| groupKeys <- groups
|
||||
]
|
||||
-- force the spine of the nested lists
|
||||
in groupedValues `using` seqList (seqList (seqTuple2 r0 (seqList r0)))
|
||||
|
||||
repeatUntilJust :: Monad m => Natural -> m (Maybe a) -> m (Maybe a)
|
||||
repeatUntilJust 0 _ = return Nothing
|
||||
repeatUntilJust nattempts action = do
|
||||
res <- action
|
||||
case res of
|
||||
Nothing -> repeatUntilJust (nattempts-1) action
|
||||
Just{} -> return res
|
||||
@ -36,6 +36,7 @@ import Development.IDE.LSP.Notifications
|
||||
import Development.IDE.LSP.Outline
|
||||
import Development.IDE.Types.Logger
|
||||
import Development.IDE.Core.FileStore
|
||||
import Development.IDE.Core.Tracing
|
||||
import Language.Haskell.LSP.Core (LspFuncs(..))
|
||||
import Language.Haskell.LSP.Messages
|
||||
|
||||
@ -79,14 +80,16 @@ runLanguageServer options userHandlers onInitialConfig onConfigChange getIdeStat
|
||||
-- The set of requests that have been cancelled and are also in pendingRequests
|
||||
cancelledRequests <- newTVarIO Set.empty
|
||||
|
||||
let withResponse wrap f = Just $ \r@RequestMessage{_id} -> do
|
||||
let withResponse wrap f = Just $ \r@RequestMessage{_id, _method} -> do
|
||||
atomically $ modifyTVar pendingRequests (Set.insert _id)
|
||||
writeChan clientMsgChan $ Response r wrap f
|
||||
let withNotification old f = Just $ \r -> writeChan clientMsgChan $ Notification r (\lsp ide x -> f lsp ide x >> whenJust old ($ r))
|
||||
let withResponseAndRequest wrap wrapNewReq f = Just $ \r@RequestMessage{_id} -> do
|
||||
let withNotification old f = Just $ \r@NotificationMessage{_method} ->
|
||||
writeChan clientMsgChan $ Notification r (\lsp ide x -> f lsp ide x >> whenJust old ($ r))
|
||||
let withResponseAndRequest wrap wrapNewReq f = Just $ \r@RequestMessage{_id, _method} -> do
|
||||
atomically $ modifyTVar pendingRequests (Set.insert _id)
|
||||
writeChan clientMsgChan $ ResponseAndRequest r wrap wrapNewReq f
|
||||
let withInitialize f = Just $ \r -> writeChan clientMsgChan $ InitialParams r (\lsp ide x -> f lsp ide x)
|
||||
let withInitialize f = Just $ \r ->
|
||||
writeChan clientMsgChan $ InitialParams r (\lsp ide x -> f lsp ide x)
|
||||
let cancelRequest reqId = atomically $ do
|
||||
queued <- readTVar pendingRequests
|
||||
-- We want to avoid that the list of cancelled requests
|
||||
@ -144,18 +147,20 @@ runLanguageServer options userHandlers onInitialConfig onConfigChange getIdeStat
|
||||
-- We dispatch notifications synchronously and requests asynchronously
|
||||
-- This is to ensure that all file edits and config changes are applied before a request is handled
|
||||
case msg of
|
||||
Notification x@NotificationMessage{_params} act -> do
|
||||
Notification x@NotificationMessage{_params, _method} act -> otTracedHandler "Notification" (show _method) $ do
|
||||
catch (act lspFuncs ide _params) $ \(e :: SomeException) ->
|
||||
logError (ideLogger ide) $ T.pack $
|
||||
"Unexpected exception on notification, please report!\n" ++
|
||||
"Message: " ++ show x ++ "\n" ++
|
||||
"Exception: " ++ show e
|
||||
Response x@RequestMessage{_id, _params} wrap act -> void $ async $
|
||||
Response x@RequestMessage{_id, _method, _params} wrap act -> void $ async $
|
||||
otTracedHandler "Request" (show _method) $
|
||||
checkCancelled ide clearReqId waitForCancel lspFuncs wrap act x _id _params $
|
||||
\case
|
||||
Left e -> sendFunc $ wrap $ ResponseMessage "2.0" (responseId _id) (Left e)
|
||||
Right r -> sendFunc $ wrap $ ResponseMessage "2.0" (responseId _id) (Right r)
|
||||
ResponseAndRequest x@RequestMessage{_id, _params} wrap wrapNewReq act -> void $ async $
|
||||
ResponseAndRequest x@RequestMessage{_id, _method, _params} wrap wrapNewReq act -> void $ async $
|
||||
otTracedHandler "Request" (show _method) $
|
||||
checkCancelled ide clearReqId waitForCancel lspFuncs wrap act x _id _params $
|
||||
\(res, newReq) -> do
|
||||
case res of
|
||||
@ -164,7 +169,8 @@ runLanguageServer options userHandlers onInitialConfig onConfigChange getIdeStat
|
||||
whenJust newReq $ \(rm, newReqParams) -> do
|
||||
reqId <- getNextReqId
|
||||
sendFunc $ wrapNewReq $ RequestMessage "2.0" reqId rm newReqParams
|
||||
InitialParams x@RequestMessage{_id, _params} act -> do
|
||||
InitialParams x@RequestMessage{_id, _method, _params} act ->
|
||||
otTracedHandler "Initialize" (show _method) $
|
||||
catch (act lspFuncs ide _params) $ \(e :: SomeException) ->
|
||||
logError (ideLogger ide) $ T.pack $
|
||||
"Unexpected exception on InitializeRequest handler, please report!\n" ++
|
||||
|
||||
24
src/Development/IDE/Types/KnownTargets.hs
Normal file
24
src/Development/IDE/Types/KnownTargets.hs
Normal file
@ -0,0 +1,24 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
module Development.IDE.Types.KnownTargets (KnownTargets, Target(..), toKnownFiles) where
|
||||
|
||||
import Data.HashMap.Strict
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.GHC.Compat (ModuleName)
|
||||
import Development.IDE.GHC.Orphans ()
|
||||
import Data.Hashable
|
||||
import GHC.Generics
|
||||
import Control.DeepSeq
|
||||
import Data.HashSet
|
||||
import qualified Data.HashSet as HSet
|
||||
import qualified Data.HashMap.Strict as HMap
|
||||
|
||||
-- | A mapping of module name to known files
|
||||
type KnownTargets = HashMap Target [NormalizedFilePath]
|
||||
|
||||
data Target = TargetModule ModuleName | TargetFile NormalizedFilePath
|
||||
deriving ( Eq, Generic, Show )
|
||||
deriving anyclass (Hashable, NFData)
|
||||
|
||||
toKnownFiles :: KnownTargets -> HashSet NormalizedFilePath
|
||||
toKnownFiles = HSet.fromList . concat . HMap.elems
|
||||
@ -15,6 +15,7 @@ module Development.IDE.Types.Options
|
||||
, IdeReportProgress(..)
|
||||
, IdeDefer(..)
|
||||
, IdeTesting(..)
|
||||
, IdeOTMemoryProfiling(..)
|
||||
, clientSupportsProgress
|
||||
, IdePkgLocationOptions(..)
|
||||
, defaultIdeOptions
|
||||
@ -68,6 +69,9 @@ data IdeOptions = IdeOptions
|
||||
-- meaning we keep everything in memory but the daml CLI compiler uses this for incremental builds.
|
||||
, optShakeProfiling :: Maybe FilePath
|
||||
-- ^ Set to 'Just' to create a directory of profiling reports.
|
||||
, optOTMemoryProfiling :: IdeOTMemoryProfiling
|
||||
-- ^ Whether to record profiling information with OpenTelemetry. You must
|
||||
-- also enable the -l RTS flag for this to have any effect
|
||||
, optTesting :: IdeTesting
|
||||
-- ^ Whether to enable additional lsp messages used by the test suite for checking invariants
|
||||
, optReportProgress :: IdeReportProgress
|
||||
@ -134,9 +138,10 @@ data IdePreprocessedSource = IdePreprocessedSource
|
||||
-- ^ New parse tree emitted by the preprocessor.
|
||||
}
|
||||
|
||||
newtype IdeReportProgress = IdeReportProgress Bool
|
||||
newtype IdeDefer = IdeDefer Bool
|
||||
newtype IdeTesting = IdeTesting Bool
|
||||
newtype IdeReportProgress = IdeReportProgress Bool
|
||||
newtype IdeDefer = IdeDefer Bool
|
||||
newtype IdeTesting = IdeTesting Bool
|
||||
newtype IdeOTMemoryProfiling = IdeOTMemoryProfiling Bool
|
||||
|
||||
clientSupportsProgress :: LSP.ClientCapabilities -> IdeReportProgress
|
||||
clientSupportsProgress caps = IdeReportProgress $ Just True ==
|
||||
@ -151,6 +156,7 @@ defaultIdeOptions session = IdeOptions
|
||||
,optThreads = 0
|
||||
,optShakeFiles = Nothing
|
||||
,optShakeProfiling = Nothing
|
||||
,optOTMemoryProfiling = IdeOTMemoryProfiling False
|
||||
,optReportProgress = IdeReportProgress False
|
||||
,optLanguageSyntax = "haskell"
|
||||
,optNewColonConvention = False
|
||||
|
||||
41
src/Development/IDE/Types/Shake.hs
Normal file
41
src/Development/IDE/Types/Shake.hs
Normal file
@ -0,0 +1,41 @@
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
module Development.IDE.Types.Shake (Value(..), Values, Key(..), currentValue) where
|
||||
|
||||
import Control.DeepSeq
|
||||
import Data.Dynamic
|
||||
import Data.Hashable
|
||||
import Data.HashMap.Strict
|
||||
import Data.Typeable
|
||||
import GHC.Generics
|
||||
import Language.Haskell.LSP.Types
|
||||
|
||||
data Value v
|
||||
= Succeeded TextDocumentVersion v
|
||||
| Stale TextDocumentVersion v
|
||||
| Failed
|
||||
deriving (Functor, Generic, Show)
|
||||
|
||||
instance NFData v => NFData (Value v)
|
||||
|
||||
-- | Convert a Value to a Maybe. This will only return `Just` for
|
||||
-- up2date results not for stale values.
|
||||
currentValue :: Value v -> Maybe v
|
||||
currentValue (Succeeded _ v) = Just v
|
||||
currentValue (Stale _ _) = Nothing
|
||||
currentValue Failed = Nothing
|
||||
|
||||
-- | The state of the all values.
|
||||
type Values = HashMap (NormalizedFilePath, Key) (Value Dynamic)
|
||||
|
||||
-- | Key type
|
||||
data Key = forall k . (Typeable k, Hashable k, Eq k, Show k) => Key k
|
||||
|
||||
instance Show Key where
|
||||
show (Key k) = show k
|
||||
|
||||
instance Eq Key where
|
||||
Key k1 == Key k2 | Just k2' <- cast k2 = k1 == k2'
|
||||
| otherwise = False
|
||||
|
||||
instance Hashable Key where
|
||||
hashWithSalt salt (Key key) = hashWithSalt salt (typeOf key, key)
|
||||
@ -9,6 +9,11 @@ extra-deps:
|
||||
- lsp-test-0.11.0.6
|
||||
- ghc-check-0.5.0.1
|
||||
- hie-bios-0.7.1
|
||||
- ghc-events-0.13.0
|
||||
- ghc-trace-events-0.1.2.1
|
||||
- heapsize-0.3.0
|
||||
- opentelemetry-0.6.1
|
||||
- opentelemetry-extra-0.6.1
|
||||
|
||||
# not yet in stackage
|
||||
- Chart-diagrams-1.9.3
|
||||
@ -30,3 +35,24 @@ extra-deps:
|
||||
|
||||
nix:
|
||||
packages: [zlib]
|
||||
|
||||
configure-options:
|
||||
heapsize:
|
||||
- --disable-library-for-ghci
|
||||
- --disable-library-stripping
|
||||
# Otherwise the ghcide will fail with:
|
||||
# ```
|
||||
# ghcide > ghc.exe: unable to load package `heapsize-0.2'
|
||||
# ghcide > ghc-iserv: | D:\a\1\s\.stack-work\install\52d658b2\lib\x86_64-windows-ghc-8.10.1\heapsize-0.2-KCPoGpPDcevACNftTTY2at\HSheapsize-0.2-KCPoGpPDcevACNftTTY2at.o: unknown symbol `heap_view_closurePtrs'
|
||||
#
|
||||
# Cause:
|
||||
# The pre-linked object file is missing the heapsize_prim.o symbols table (from the cbits object)
|
||||
#
|
||||
# Reason: The ld invocation is stripping too much
|
||||
#
|
||||
# Quoting https://downloads.haskell.org/ghc/latest/docs/html/users_guide/packages.html
|
||||
#
|
||||
# > To load a package foo, GHCi can load its libHSfoo.a library directly, but it can also load a package in the form of a single HSfoo.o file that has been pre-linked. Loading the .o file is slightly quicker, but at the expense of having another copy of the compiled package. The rule of thumb is that if the modules of the package were compiled with -split-sections then building the HSfoo.o is worthwhile because it saves time when loading the package into GHCi. Without -split-sections, there is not much difference in load time between the .o and .a libraries, so it is better to save the disk space and only keep the .a around. In a GHC distribution we provide .o files for most packages except the GHC package itself.
|
||||
# > The HSfoo.o file is built by Cabal automatically; use --disable-library-for-ghci to disable it. To build one manually, the following GNU ld command can be used:
|
||||
|
||||
# > ld -r --whole-archive -o HSfoo.o libHSfoo.a
|
||||
|
||||
@ -9,6 +9,11 @@ extra-deps:
|
||||
- lsp-test-0.11.0.6
|
||||
- ghc-check-0.5.0.1
|
||||
- hie-bios-0.7.1
|
||||
- ghc-events-0.13.0
|
||||
- ghc-trace-events-0.1.2.1
|
||||
- heapsize-0.3.0
|
||||
- opentelemetry-0.6.1
|
||||
- opentelemetry-extra-0.6.1
|
||||
|
||||
# not yet in stackage
|
||||
- Chart-diagrams-1.9.3
|
||||
|
||||
Loading…
Reference in New Issue
Block a user