haskell/haskell-language-server
1
1
Fork 0
mirror of https://github.com/haskell/haskell-language-server.git synced 2024-09-11 08:45:35 +03:00
Code Issues Projects Releases Wiki Activity

Reformat all files (#1439)

Browse Source 
* Update nix-shell excludes regexs

* Format all files
This commit is contained in:
Junyoung/Clare Jang 2021-02-24 21:34:35 -05:00 committed by GitHub
parent 2749371902
commit 679f1d0f62
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
141 changed files with 2876 additions and 2826 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CONTRIBUTING.md
View File

@ -18,7 +18,7 @@ If you don't want to use [nix](https://nixos.org/guides/install-nix.html), you c
"hooks": [
{
"entry": "stylish-haskell --inplace",
"exclude": "(test/testdata/.*|hie-compat/.*)",
"exclude": "(^Setup.hs$|test/testdata/.*$|test/data/.*$|^hie-compat/.*$)",
"files": "\\.l?hs$",
"id": "stylish-haskell",
"language": "system",

19
GenChangelogs.hs
View File

@ -3,16 +3,17 @@
build-depends: base, process, text, github, time
-}
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Format.ISO8601
import Data.Time.LocalTime
import System.Process
import GitHub
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Format.ISO8601
import Data.Time.LocalTime
import GitHub
import System.Process
main = do
callCommand "git fetch --tags"

7
exe/Main.hs
View File

@ -4,11 +4,10 @@
{-# LANGUAGE RecordWildCards #-}
module Main(main) where
import Ide.Arguments (Arguments (..), LspArguments (..),
getArguments)
import Ide.Main (defaultMain)
import Ide.Arguments (Arguments (..), LspArguments (..), getArguments)
import Ide.Main (defaultMain)
import Main.Utf8 (withUtf8)
import Plugins
import Main.Utf8 (withUtf8)
main :: IO ()
main = withUtf8 $ do

42
exe/Plugins.hs
View File

@ -2,77 +2,77 @@
{-# LANGUAGE OverloadedStrings #-}
module Plugins where
import Ide.Types (IdePlugins)
import Ide.PluginUtils (pluginDescToIdePlugins)
import Ide.PluginUtils (pluginDescToIdePlugins)
import Ide.Types (IdePlugins)
-- fixed plugins
import Ide.Plugin.Example as Example
import Ide.Plugin.Example2 as Example2
import Development.IDE (IdeState)
import Development.IDE.Plugin.HLS.GhcIde as GhcIde
import Development.IDE (IdeState)
import Development.IDE.Plugin.HLS.GhcIde as GhcIde
import Ide.Plugin.Example as Example
import Ide.Plugin.Example2 as Example2
-- haskell-language-server optional plugins
#if class
import Ide.Plugin.Class as Class
import Ide.Plugin.Class as Class
#endif
#if haddockComments
import Ide.Plugin.HaddockComments as HaddockComments
import Ide.Plugin.HaddockComments as HaddockComments
#endif
#if eval
import Ide.Plugin.Eval as Eval
import Ide.Plugin.Eval as Eval
#endif
#if importLens
import Ide.Plugin.ExplicitImports as ExplicitImports
import Ide.Plugin.ExplicitImports as ExplicitImports
#endif
#if retrie
import Ide.Plugin.Retrie as Retrie
import Ide.Plugin.Retrie as Retrie
#endif
#if tactic
import Ide.Plugin.Tactic as Tactic
import Ide.Plugin.Tactic as Tactic
#endif
#if hlint
import Ide.Plugin.Hlint as Hlint
import Ide.Plugin.Hlint as Hlint
#endif
#if moduleName
import Ide.Plugin.ModuleName as ModuleName
import Ide.Plugin.ModuleName as ModuleName
#endif
#if pragmas
import Ide.Plugin.Pragmas as Pragmas
import Ide.Plugin.Pragmas as Pragmas
#endif
#if splice
import Ide.Plugin.Splice as Splice
import Ide.Plugin.Splice as Splice
#endif
-- formatters
#if floskell
import Ide.Plugin.Floskell as Floskell
import Ide.Plugin.Floskell as Floskell
#endif
#if fourmolu
import Ide.Plugin.Fourmolu as Fourmolu
import Ide.Plugin.Fourmolu as Fourmolu
#endif
#if ormolu
import Ide.Plugin.Ormolu as Ormolu
import Ide.Plugin.Ormolu as Ormolu
#endif
#if stylishHaskell
import Ide.Plugin.StylishHaskell as StylishHaskell
import Ide.Plugin.StylishHaskell as StylishHaskell
#endif
#if AGPL && brittany
import Ide.Plugin.Brittany as Brittany
import Ide.Plugin.Brittany as Brittany
#endif
-- ---------------------------------------------------------------------

38
exe/Wrapper.hs
View File

@ -3,24 +3,24 @@
-- https://github.com/alanz/vscode-hie-server
module Main where
import Control.Monad.Extra
import Data.Default
import Data.Foldable
import Data.List
import Data.Void
import Development.IDE.Session (findCradle)
import HIE.Bios hiding (findCradle)
import HIE.Bios.Environment
import HIE.Bios.Types
import Ide.Arguments
import Ide.Version
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import System.Info
import System.Process
import Control.Monad.Extra
import Data.Default
import Data.Foldable
import Data.List
import Data.Void
import Development.IDE.Session (findCradle)
import HIE.Bios hiding (findCradle)
import HIE.Bios.Environment
import HIE.Bios.Types
import Ide.Arguments
import Ide.Version
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import System.Info
import System.Process
-- ---------------------------------------------------------------------
@ -50,7 +50,7 @@ launchHaskellLanguageServer :: Arguments -> IO ()
launchHaskellLanguageServer parsedArgs = do
case parsedArgs of
LspMode LspArguments{..} -> whenJust argsCwd setCurrentDirectory
_ -> pure ()
_ -> pure ()
d <- getCurrentDirectory

8
ghcide/bench/exe/Main.hs
View File

@ -34,11 +34,11 @@
{-# LANGUAGE ImplicitParams #-}
import Control.Exception.Safe
import Experiments
import Options.Applicative
import System.IO
import Control.Exception.Safe
import Control.Monad
import Experiments
import Options.Applicative
import System.IO
optsP :: Parser (Config, Bool)
optsP = (,) <$> configP <*> switch (long "no-clean")

46
ghcide/bench/hist/Main.hs
View File

@ -38,24 +38,24 @@
> cabal bench --benchmark-options "bench-results/HEAD/results.csv bench-results/HEAD/edit.diff.svg"
-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies#-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS -Wno-orphans #-}
import Data.Foldable (find)
import Data.Yaml (FromJSON (..), decodeFileThrow)
import Development.Benchmark.Rules
import Development.Shake
import Experiments.Types (Example, exampleToOptions)
import qualified Experiments.Types as E
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import Development.Shake.Classes
import System.Console.GetOpt
import Data.Maybe
import Control.Monad.Extra
import System.FilePath
import Control.Monad.Extra
import Data.Foldable (find)
import Data.Maybe
import Data.Yaml (FromJSON (..), decodeFileThrow)
import Development.Benchmark.Rules
import Development.Shake
import Development.Shake.Classes
import Experiments.Types (Example, exampleToOptions)
import qualified Experiments.Types as E
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import System.Console.GetOpt
import System.FilePath
configPath :: FilePath
@ -82,7 +82,7 @@ main = shakeArgsWith shakeOpts [configOpt] $ \configs wants -> pure $ Just $ do
_configStatic <- createBuildSystem config
case wants of
[] -> want ["all"]
_ -> want wants
_ -> want wants
ghcideBuildRules :: MkBuildRules BuildSystem
ghcideBuildRules = MkBuildRules findGhcForBuildSystem "ghcide" projectDepends buildGhcide
@ -95,13 +95,13 @@ ghcideBuildRules = MkBuildRules findGhcForBuildSystem "ghcide" projectDepends bu
--------------------------------------------------------------------------------
data Config buildSystem = Config
{ experiments :: [Unescaped String],
examples :: [Example],
samples :: Natural,
versions :: [GitCommit],
{ experiments :: [Unescaped String],
examples :: [Example],
samples :: Natural,
versions :: [GitCommit],
-- | Output folder ('foo' works, 'foo/bar' does not)
outputFolder :: String,
buildTool :: buildSystem,
outputFolder :: String,
buildTool :: buildSystem,
profileInterval :: Maybe Double
}
deriving (Generic, Show)

89
ghcide/bench/lib/Experiments.hs
View File

@ -1,8 +1,8 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# OPTIONS_GHC -Wno-deprecations -Wno-unticked-promoted-constructors #-}
module Experiments
@ -21,29 +21,30 @@ module Experiments
, runBench
, exampleToOptions
) where
import Control.Applicative.Combinators (skipManyTill)
import Control.Exception.Safe (IOException, handleAny, try)
import Control.Monad.Extra
import Control.Monad.IO.Class
import Data.Aeson (Value(Null), toJSON)
import Data.List
import Data.Maybe
import qualified Data.Text as T
import Data.Version
import Development.IDE.Plugin.Test
import Experiments.Types
import Language.LSP.Test
import Language.LSP.Types
import Language.LSP.Types.Capabilities
import Numeric.Natural
import Options.Applicative
import System.Directory
import System.Environment.Blank (getEnv)
import System.FilePath ((</>), (<.>))
import System.Process
import System.Time.Extra
import Text.ParserCombinators.ReadP (readP_to_S)
import Development.Shake (cmd_, CmdOption (Cwd, FileStdout))
import Control.Applicative.Combinators (skipManyTill)
import Control.Exception.Safe (IOException, handleAny, try)
import Control.Monad.Extra
import Control.Monad.IO.Class
import Data.Aeson (Value (Null), toJSON)
import Data.List
import Data.Maybe
import qualified Data.Text as T
import Data.Version
import Development.IDE.Plugin.Test
import Development.Shake (CmdOption (Cwd, FileStdout),
cmd_)
import Experiments.Types
import Language.LSP.Test
import Language.LSP.Types
import Language.LSP.Types.Capabilities
import Numeric.Natural
import Options.Applicative
import System.Directory
import System.Environment.Blank (getEnv)
import System.FilePath ((<.>), (</>))
import System.Process
import System.Time.Extra
import Text.ParserCombinators.ReadP (readP_to_S)
charEdit :: Position -> TextDocumentContentChangeEvent
charEdit p =
@ -54,9 +55,9 @@ charEdit p =
}
data DocumentPositions = DocumentPositions {
identifierP :: Maybe Position,
identifierP :: Maybe Position,
stringLiteralP :: !Position,
doc :: !TextDocumentIdentifier
doc :: !TextDocumentIdentifier
}
allWithIdentifierPos :: Monad m => (DocumentPositions -> m Bool) -> [DocumentPositions] -> m Bool
@ -225,9 +226,9 @@ type Experiment = [DocumentPositions] -> Session Bool
data Bench =
Bench
{ name :: !String,
enabled :: !Bool,
samples :: !Natural,
{ name :: !String,
enabled :: !Bool,
samples :: !Natural,
benchSetup :: [DocumentPositions] -> Session (),
experiment :: Experiment
}
@ -344,12 +345,12 @@ runBenchmarksFun dir allBenchmarks = do
}
data BenchRun = BenchRun
{ startup :: !Seconds,
runSetup :: !Seconds,
{ startup :: !Seconds,
runSetup :: !Seconds,
runExperiment :: !Seconds,
userWaits :: !Seconds,
delayedWork :: !Seconds,
success :: !Bool
userWaits :: !Seconds,
delayedWork :: !Seconds,
success :: !Bool
}
badRun :: BenchRun
@ -416,8 +417,8 @@ runBench runSess b = handleAny (\e -> print e >> return badRun)
data SetupResult = SetupResult {
runBenchmarks :: [Bench] -> IO (),
-- | Path to the setup benchmark example
benchDir :: FilePath,
cleanUp :: IO ()
benchDir :: FilePath,
cleanUp :: IO ()
}
callCommandLogging :: HasConfig => String -> IO ()
@ -456,9 +457,9 @@ setup = do
""
Stack -> do
let stackVerbosity = case verbosity ?config of
Quiet -> "--silent"
Quiet -> "--silent"
Normal -> ""
All -> "--verbose"
All -> "--verbose"
callCommandLogging $ "stack " <> stackVerbosity <> " unpack " <> package <> " --to " <> examplesPath
-- Generate the stack descriptor to match the one used to build ghcide
stack_yaml <- fromMaybe "stack.yaml" <$> getEnv "STACK_YAML"
@ -526,8 +527,8 @@ findEndOfImports _ = Nothing
--------------------------------------------------------------------------------------------
pad :: Int -> String -> String
pad n [] = replicate n ' '
pad 0 _ = error "pad"
pad n [] = replicate n ' '
pad 0 _ = error "pad"
pad n (x:xx) = x : pad (n-1) xx
-- | Search for a position where:
@ -568,6 +569,6 @@ searchSymbol doc@TextDocumentIdentifier{_uri} fileContents pos = do
defs <- getDefinitions doc pos
case defs of
(InL [Location uri _]) -> return $ uri /= _uri
_ -> return False
_ -> return False
checkCompletions pos =
not . null <$> getCompletions doc pos

36
ghcide/bench/lib/Experiments/Types.hs
View File

@ -1,14 +1,14 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
module Experiments.Types (module Experiments.Types ) where
import Data.Aeson
import Data.Version
import Numeric.Natural
import System.FilePath (isPathSeparator)
import Development.Shake.Classes
import GHC.Generics
import Data.Aeson
import Data.Version
import Development.Shake.Classes
import GHC.Generics
import Numeric.Natural
import System.FilePath (isPathSeparator)
data CabalStack = Cabal | Stack
deriving (Eq, Show)
@ -16,18 +16,18 @@ data CabalStack = Cabal | Stack
data Verbosity = Quiet | Normal | All
deriving (Eq, Show)
data Config = Config
{ verbosity :: !Verbosity,
{ verbosity :: !Verbosity,
-- For some reason, the Shake profile files are truncated and won't load
shakeProfiling :: !(Maybe FilePath),
shakeProfiling :: !(Maybe FilePath),
otMemoryProfiling :: !(Maybe FilePath),
outputCSV :: !FilePath,
buildTool :: !CabalStack,
ghcideOptions :: ![String],
matches :: ![String],
repetitions :: Maybe Natural,
ghcide :: FilePath,
timeoutLsp :: Int,
example :: Example
outputCSV :: !FilePath,
buildTool :: !CabalStack,
ghcideOptions :: ![String],
matches :: ![String],
repetitions :: Maybe Natural,
ghcide :: FilePath,
timeoutLsp :: Int,
example :: Example
}
deriving (Eq, Show)

22
ghcide/exe/Arguments.hs
View File

@ -3,24 +3,24 @@
module Arguments(Arguments, Arguments'(..), getArguments, IdeCmd(..)) where
import Options.Applicative
import HieDb.Run
import HieDb.Run
import Options.Applicative
type Arguments = Arguments' IdeCmd
data IdeCmd = Typecheck [FilePath] | DbCmd Options Command | LSP
data Arguments' a = Arguments
{argLSP :: Bool
,argsCwd :: Maybe FilePath
,argsVersion :: Bool
,argsShakeProfiling :: Maybe FilePath
{argLSP :: Bool
,argsCwd :: Maybe FilePath
,argsVersion :: Bool
,argsShakeProfiling :: Maybe FilePath
,argsOTMemoryProfiling :: Bool
,argsTesting :: Bool
,argsDisableKick :: Bool
,argsThreads :: Int
,argsVerbose :: Bool
,argFilesOrCmd :: a
,argsTesting :: Bool
,argsDisableKick :: Bool
,argsThreads :: Int
,argsVerbose :: Bool
,argFilesOrCmd :: a
}
getArguments :: IO Arguments

64
ghcide/exe/Main.hs
View File

@ -5,41 +5,45 @@
module Main(main) where
import Arguments ( Arguments'(..), IdeCmd(..), getArguments )
import Control.Concurrent.Extra ( newLock, withLock )
import Control.Monad.Extra ( unless, when, whenJust )
import Data.Default ( Default(def) )
import Data.List.Extra ( upper )
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Version ( showVersion )
import Development.GitRev ( gitHash )
import Development.IDE ( Logger(Logger), Priority(Info), action )
import Development.IDE.Core.OfInterest (kick)
import Development.IDE.Core.Rules (mainRule)
import Arguments (Arguments' (..),
IdeCmd (..), getArguments)
import Control.Concurrent.Extra (newLock, withLock)
import Control.Monad.Extra (unless, when, whenJust)
import Data.Default (Default (def))
import Data.List.Extra (upper)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Version (showVersion)
import Development.GitRev (gitHash)
import Development.IDE (Logger (Logger),
Priority (Info), action)
import Development.IDE.Core.OfInterest (kick)
import Development.IDE.Core.Rules (mainRule)
import qualified Development.IDE.Main as Main
import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
import qualified Development.IDE.Plugin.Test as Test
import Development.IDE.Session (setInitialDynFlags, getHieDbLoc)
import Development.IDE.Types.Options
import qualified Development.IDE.Main as Main
import Development.Shake (ShakeOptions(shakeThreads))
import Ide.Plugin.Config (Config(checkParents, checkProject))
import Ide.PluginUtils (pluginDescToIdePlugins)
import HieDb.Run (Options(..), runCommand)
import Paths_ghcide ( version )
import qualified System.Directory.Extra as IO
import System.Environment ( getExecutablePath )
import System.Exit ( ExitCode(ExitFailure), exitSuccess, exitWith )
import System.Info ( compilerVersion )
import System.IO ( stderr, hPutStrLn )
import qualified Development.IDE.Plugin.Test as Test
import Development.IDE.Session (getHieDbLoc,
setInitialDynFlags)
import Development.IDE.Types.Options
import Development.Shake (ShakeOptions (shakeThreads))
import HieDb.Run (Options (..), runCommand)
import Ide.Plugin.Config (Config (checkParents, checkProject))
import Ide.PluginUtils (pluginDescToIdePlugins)
import Paths_ghcide (version)
import qualified System.Directory.Extra as IO
import System.Environment (getExecutablePath)
import System.Exit (ExitCode (ExitFailure),
exitSuccess, exitWith)
import System.IO (hPutStrLn, stderr)
import System.Info (compilerVersion)
ghcideVersion :: IO String
ghcideVersion = do
path <- getExecutablePath
let gitHashSection = case $(gitHash) of
x | x == "UNKNOWN" -> ""
x -> " (GIT hash: " <> x <> ")"
x -> " (GIT hash: " <> x <> ")"
return $ "ghcide version: " <> showVersion version
<> " (GHC: " <> showVersion compilerVersion
<> ") (PATH: " <> path <> ")"
@ -68,7 +72,7 @@ main = do
dbLoc <- getHieDbLoc dir
mlibdir <- setInitialDynFlags def
case mlibdir of
Nothing -> exitWith $ ExitFailure 1
Nothing -> exitWith $ ExitFailure 1
Just libdir -> runCommand libdir opts{database = dbLoc} cmd
_ -> do
@ -82,7 +86,7 @@ main = do
Main.defaultMain def
{Main.argFiles = case argFilesOrCmd of
Typecheck x | not argLSP -> Just x
_ -> Nothing
_ -> Nothing
,Main.argsLogger = logger

171
ghcide/session-loader/Development/IDE/Session.hs
View File

@ -1,5 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE CPP #-}
#include "ghc-api-version.h"
{-|
@ -19,85 +19,88 @@ module Development.IDE.Session
-- the real GHC library and the types are incompatible. Furthermore, when
-- building with ghc-lib we need to make this Haskell agnostic, so no hie-bios!
import Control.Concurrent.Async
import Control.Concurrent.Extra
import Control.Exception.Safe
import Control.Monad
import Control.Monad.Extra
import Control.Monad.IO.Class
import qualified Crypto.Hash.SHA1 as H
import qualified Data.ByteString.Char8 as B
import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Data.Aeson
import Data.Bifunctor
import qualified Data.ByteString.Base16 as B16
import Data.Default
import Data.Either.Extra
import Data.Function
import Data.Hashable
import Data.List
import Data.IORef
import Data.Maybe
import Data.Time.Clock
import Data.Version
import Development.IDE.Core.Shake
import Development.IDE.Core.RuleTypes
import Development.IDE.GHC.Compat hiding (Target, TargetModule, TargetFile)
import qualified Development.IDE.GHC.Compat as GHC
import Development.IDE.GHC.Util
import Development.IDE.Session.VersionCheck
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Exports
import Development.IDE.Types.HscEnvEq (HscEnvEq, newHscEnvEqPreserveImportPaths, newHscEnvEq)
import Development.IDE.Types.Location
import Development.IDE.Types.Logger
import Development.IDE.Types.Options
import Development.Shake (Action)
import GHC.Check
import qualified HIE.Bios as HieBios
import HIE.Bios.Environment hiding (getCacheDir)
import HIE.Bios.Types
import Hie.Implicit.Cradle (loadImplicitHieCradle)
import Language.LSP.Server
import Language.LSP.Types
import System.Directory
import qualified System.Directory.Extra as IO
import System.FilePath
import System.Info
import System.IO
import Control.Concurrent.Async
import Control.Concurrent.Extra
import Control.Exception.Safe
import Control.Monad
import Control.Monad.Extra
import Control.Monad.IO.Class
import qualified Crypto.Hash.SHA1 as H
import Data.Aeson
import Data.Bifunctor
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as B
import Data.Default
import Data.Either.Extra
import Data.Function
import qualified Data.HashMap.Strict as HM
import Data.Hashable
import Data.IORef
import Data.List
import qualified Data.Map.Strict as Map
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Clock
import Data.Version
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake
import Development.IDE.GHC.Compat hiding (Target,
TargetFile, TargetModule)
import qualified Development.IDE.GHC.Compat as GHC
import Development.IDE.GHC.Util
import Development.IDE.Session.VersionCheck
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Exports
import Development.IDE.Types.HscEnvEq (HscEnvEq, newHscEnvEq,
newHscEnvEqPreserveImportPaths)
import Development.IDE.Types.Location
import Development.IDE.Types.Logger
import Development.IDE.Types.Options
import Development.Shake (Action)
import GHC.Check
import qualified HIE.Bios as HieBios
import HIE.Bios.Environment hiding (getCacheDir)
import HIE.Bios.Types
import Hie.Implicit.Cradle (loadImplicitHieCradle)
import Language.LSP.Server
import Language.LSP.Types
import System.Directory
import qualified System.Directory.Extra as IO
import System.FilePath
import System.IO
import System.Info
import GHCi
import HscTypes (ic_dflags, hsc_IC, hsc_dflags, hsc_NC)
import Linker
import Module
import NameCache
import Packages
import Control.Exception (evaluate)
import Data.Void
import Control.Applicative (Alternative((<|>)))
import Control.Applicative (Alternative ((<|>)))
import Control.Exception (evaluate)
import Data.Void
import GHCi
import HscTypes (hsc_IC, hsc_NC,
hsc_dflags, ic_dflags)
import Linker
import Module
import NameCache
import Packages
import HieDb.Create
import HieDb.Types
import HieDb.Utils
import Database.SQLite.Simple
import Control.Concurrent.STM.TQueue
import Control.Concurrent.STM (atomically)
import Maybes (MaybeT(runMaybeT))
import HIE.Bios.Cradle (yamlConfig)
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TQueue
import Database.SQLite.Simple
import HIE.Bios.Cradle (yamlConfig)
import HieDb.Create
import HieDb.Types
import HieDb.Utils
import Maybes (MaybeT (runMaybeT))
data CacheDirs = CacheDirs
{ hiCacheDir, hieCacheDir, oCacheDir :: Maybe FilePath}
data SessionLoadingOptions = SessionLoadingOptions
{ findCradle :: FilePath -> IO (Maybe FilePath)
, loadCradle :: FilePath -> IO (HieBios.Cradle Void)
{ findCradle :: FilePath -> IO (Maybe FilePath)
, loadCradle :: FilePath -> IO (HieBios.Cradle Void)
-- | Given the project name and a set of command line flags,
-- return the path for storing generated GHC artifacts,
-- or 'Nothing' to respect the cradle setting
, getCacheDirs :: String -> [String] -> IO CacheDirs
, getCacheDirs :: String -> [String] -> IO CacheDirs
-- | Return the GHC lib dir to use for the 'unsafeGlobalDynFlags'
, getInitialGhcLibDir :: IO (Maybe LibDir)
}
@ -480,10 +483,10 @@ cradleToOptsAndLibDir cradle file = do
case libDirRes of
-- This is the successful path
CradleSuccess libDir -> pure (Right (r, libDir))
CradleFail err -> return (Left [err])
CradleFail err -> return (Left [err])
-- For the None cradle perhaps we still want to report an Info
-- message about the fact that the file is being ignored.
CradleNone -> return (Left [])
CradleNone -> return (Left [])
CradleFail err -> return (Left [err])
-- Same here
@ -497,9 +500,9 @@ emptyHscEnv nc libDir = do
data TargetDetails = TargetDetails
{
targetTarget :: !Target,
targetEnv :: !(IdeResult HscEnvEq),
targetDepends :: !DependencyInfo,
targetTarget :: !Target,
targetEnv :: !(IdeResult HscEnvEq),
targetDepends :: !DependencyInfo,
targetLocations :: ![NormalizedFilePath]
}
@ -643,16 +646,16 @@ type FilesMap = HM.HashMap NormalizedFilePath (Maybe FilePath)
-- This is pristine information about a component
data RawComponentInfo = RawComponentInfo
{ rawComponentUnitId :: InstalledUnitId
{ rawComponentUnitId :: InstalledUnitId
-- | Unprocessed DynFlags. Contains inplace packages such as libraries.
-- We do not want to use them unprocessed.
, rawComponentDynFlags :: DynFlags
, rawComponentDynFlags :: DynFlags
-- | All targets of this components.
, rawComponentTargets :: [GHC.Target]
, rawComponentTargets :: [GHC.Target]
-- | Filepath which caused the creation of this component
, rawComponentFP :: NormalizedFilePath
, rawComponentFP :: NormalizedFilePath
-- | Component Options used to load the component.
, rawComponentCOptions :: ComponentOptions
, rawComponentCOptions :: ComponentOptions
-- | Maps cradle dependencies, such as `stack.yaml`, or `.cabal` file
-- to last modification time. See Note [Multi Cradle Dependency Info].
, rawComponentDependencyInfo :: DependencyInfo
@ -660,20 +663,20 @@ data RawComponentInfo = RawComponentInfo
-- This is processed information about the component, in particular the dynflags will be modified.
data ComponentInfo = ComponentInfo
{ componentUnitId :: InstalledUnitId
{ componentUnitId :: InstalledUnitId
-- | Processed DynFlags. Does not contain inplace packages such as local
-- libraries. Can be used to actually load this Component.
, componentDynFlags :: DynFlags
, componentDynFlags :: DynFlags
-- | Internal units, such as local libraries, that this component
-- is loaded with. These have been extracted from the original
-- ComponentOptions.
, _componentInternalUnits :: [InstalledUnitId]
-- | All targets of this components.
, componentTargets :: [GHC.Target]
, componentTargets :: [GHC.Target]
-- | Filepath which caused the creation of this component
, componentFP :: NormalizedFilePath
, componentFP :: NormalizedFilePath
-- | Component Options used to load the component.
, _componentCOptions :: ComponentOptions
, _componentCOptions :: ComponentOptions
-- | Maps cradle dependencies, such as `stack.yaml`, or `.cabal` file
-- to last modification time. See Note [Multi Cradle Dependency Info]
, componentDependencyInfo :: DependencyInfo

6
ghcide/session-loader/Development/IDE/Session/VersionCheck.hs
View File

@ -5,13 +5,13 @@
-- See https://github.com/haskell/ghcide/pull/697
module Development.IDE.Session.VersionCheck (ghcVersionChecker) where
import Data.Maybe
import GHC.Check
import Data.Maybe
import GHC.Check
-- Only use this for checking against the compile time GHC libDir!
-- Use getRuntimeGhcLibDir from hie-bios instead for everything else
-- otherwise binaries will not be distributable since paths will be baked into them
import qualified GHC.Paths
import System.Environment
import System.Environment
ghcVersionChecker :: GhcVersionChecker
ghcVersionChecker = $$(makeGhcVersionChecker (fromMaybe GHC.Paths.libdir <$> lookupEnv "NIX_GHC_LIBDIR"))

153
ghcide/src/Development/IDE/Core/Compile.hs
View File

@ -1,9 +1,9 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE CPP #-}
#include "ghc-api-version.h"
-- | Based on https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/API.
@ -33,89 +33,94 @@ module Development.IDE.Core.Compile
, lookupName
) where
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Preprocessor
import Development.IDE.Core.Shake
import Development.IDE.GHC.Error
import Development.IDE.GHC.Warnings
import Development.IDE.Spans.Common
import Development.IDE.Types.Diagnostics
import Development.IDE.GHC.Orphans()
import Development.IDE.GHC.Util
import Development.IDE.Types.Options
import Development.IDE.Types.Location
import Outputable hiding ((<>))
import Development.IDE.Core.Preprocessor
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake
import Development.IDE.GHC.Error
import Development.IDE.GHC.Orphans ()
import Development.IDE.GHC.Util
import Development.IDE.GHC.Warnings
import Development.IDE.Spans.Common
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import Development.IDE.Types.Options
import Outputable hiding ((<>))
import HieDb
import HieDb
import Language.LSP.Types (DiagnosticTag(..))
import Language.LSP.Types (DiagnosticTag (..))
import LoadIface (loadModuleInterface)
import DriverPhases
import HscTypes
import DriverPipeline hiding (unP)
import DriverPhases
import DriverPipeline hiding (unP)
import HscTypes
import LoadIface (loadModuleInterface)
import qualified Parser
import Lexer
import qualified Parser
#if MIN_GHC_API_VERSION(8,10,0)
import Control.DeepSeq (force, rnf)
import Control.DeepSeq (force, rnf)
#else
import Control.DeepSeq (rnf)
import ErrUtils
import Control.DeepSeq (rnf)
import ErrUtils
#endif
import Development.IDE.GHC.Compat hiding (parseModule,
typecheckModule,
writeHieFile)
import qualified Development.IDE.GHC.Compat as Compat
import qualified Development.IDE.GHC.Compat as GHC
import Finder
import Development.IDE.GHC.Compat hiding (parseModule, typecheckModule, writeHieFile)
import qualified Development.IDE.GHC.Compat as GHC
import qualified Development.IDE.GHC.Compat as Compat
import GhcMonad
import GhcPlugins as GHC hiding (fst3, (<>))
import HscMain (makeSimpleDetails, hscDesugar, hscTypecheckRename, hscSimplify, hscGenHardCode, hscInteractive)
import MkIface
import StringBuffer as SB
import TcRnMonad hiding (newUnique)
import TcIface (typecheckIface)
import TidyPgm
import GhcPlugins as GHC hiding (fst3, (<>))
import Hooks
import HscMain (hscDesugar, hscGenHardCode,
hscInteractive, hscSimplify,
hscTypecheckRename,
makeSimpleDetails)
import MkIface
import StringBuffer as SB
import TcIface (typecheckIface)
import TcRnMonad hiding (newUnique)
import TcSplice
import TidyPgm
import Control.Exception.Safe
import Control.Lens hiding (List)
import Control.Monad.Extra
import Control.Monad.Except
import Control.Monad.Trans.Except
import Data.Bifunctor (first, second)
import qualified Data.ByteString as BS
import qualified Data.Text as T
import Bag
import Control.Exception (evaluate)
import Control.Exception.Safe
import Control.Lens hiding (List)
import Control.Monad.Except
import Control.Monad.Extra
import Control.Monad.Trans.Except
import Data.Bifunctor (first, second)
import qualified Data.ByteString as BS
import qualified Data.DList as DL
import Data.IORef
import Data.List.Extra
import qualified Data.Map.Strict as Map
import Data.Maybe
import qualified Data.Map.Strict as Map
import System.FilePath
import qualified Data.Text as T
import Data.Time (UTCTime, getCurrentTime)
import qualified GHC.LanguageExtensions as LangExt
import HeaderInfo
import Linker (unload)
import Maybes (orElse)
import PrelNames
import System.Directory
import System.IO.Extra ( fixIO, newTempFileWithin )
import Control.Exception (evaluate)
import TcEnv (tcLookup)
import qualified Data.DList as DL
import Data.Time (UTCTime, getCurrentTime)
import Bag
import Linker (unload)
import qualified GHC.LanguageExtensions as LangExt
import PrelNames
import HeaderInfo
import Maybes (orElse)
import System.FilePath
import System.IO.Extra (fixIO, newTempFileWithin)
import TcEnv (tcLookup)
import qualified Data.HashMap.Strict as HashMap
import qualified Language.LSP.Types as LSP
import qualified Language.LSP.Server as LSP
import Control.Concurrent.STM hiding (orElse)
import Control.Concurrent.Extra
import Data.Functor
import Data.Unique
import GHC.Fingerprint
import Data.Coerce
import Data.Aeson (toJSON)
import Data.Tuple.Extra (dupe)
import Control.Concurrent.Extra
import Control.Concurrent.STM hiding (orElse)
import Data.Aeson (toJSON)
import Data.Coerce
import Data.Functor
import qualified Data.HashMap.Strict as HashMap
import Data.Tuple.Extra (dupe)
import Data.Unique
import GHC.Fingerprint
import qualified Language.LSP.Server as LSP
import qualified Language.LSP.Types as LSP
-- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
parseModule
@ -218,7 +223,7 @@ tcRnModule hsc_env keep_lbls pmod = do
hpm_src_files = pm_extra_src_files pmod,
hpm_annotations = pm_annotations pmod }
let rn_info = case mrn_info of
Just x -> x
Just x -> x
Nothing -> error "no renamed info tcRnModule"
pure (TcModuleResult pmod rn_info tc_gbl_env splices False)
@ -250,7 +255,7 @@ mkHiFileResultCompile session' tcm simplified_guts ltype = catchErrs $ do
let genLinkable = case ltype of
ObjectLinkable -> generateObjectCode
BCOLinkable -> generateByteCode
BCOLinkable -> generateByteCode
(linkable, details, diags) <-
if mg_hsc_src simplified_guts == HsBootFile
@ -522,7 +527,7 @@ indexHieFile se mod_summary srcPath hash hf = atomically $ do
newerScheduled <- atomically $ do
pending <- readTVar indexPending
pure $ case HashMap.lookup srcPath pending of
Nothing -> False
Nothing -> False
-- If the hash in the pending list doesn't match the current hash, then skip
Just pendingHash -> pendingHash /= hash
unless newerScheduled $ do
@ -677,7 +682,7 @@ loadModulesHome mod_infos e =
withBootSuffix :: HscSource -> ModLocation -> ModLocation
withBootSuffix HsBootFile = addBootSuffixLocnOut
withBootSuffix _ = id
withBootSuffix _ = id
-- | Given a buffer, env and filepath, produce a module summary by parsing only the imports.
-- Runs preprocessors as needed.
@ -905,7 +910,7 @@ loadInterface session ms sourceMod linkableNeeded regen = do
-- We don't need to regenerate if the object is up do date, or we don't need one
let objUpToDate = isNothing linkableNeeded || case linkable of
Nothing -> False
Nothing -> False
Just (LM obj_time _ _) -> obj_time > ms_hs_date ms
if objUpToDate
then do
@ -943,14 +948,14 @@ getDocsBatch hsc_env _mod _names = do
else pure (Right ( Map.lookup name dmap
, Map.findWithDefault Map.empty name amap))
case res of
Just x -> return $ map (first $ T.unpack . showGhc) x
Just x -> return $ map (first $ T.unpack . showGhc) x
Nothing -> throwErrors errs
where
throwErrors = liftIO . throwIO . mkSrcErr
compiled n =
-- TODO: Find a more direct indicator.
case nameSrcLoc n of
RealSrcLoc {} -> False
RealSrcLoc {} -> False
UnhelpfulLoc {} -> True
fakeSpan :: RealSrcSpan
@ -969,5 +974,5 @@ lookupName hsc_env mod name = do
case tcthing of
AGlobal thing -> return thing
ATcId{tct_id=id} -> return (AnId id)
_ -> panic "tcRnLookupName'"
_ -> panic "tcRnLookupName'"
return res

16
ghcide/src/Development/IDE/Core/Debouncer.hs
View File

@ -8,14 +8,14 @@ module Development.IDE.Core.Debouncer
, noopDebouncer
) where
import Control.Concurrent.Extra
import Control.Concurrent.Async
import Control.Exception
import Control.Monad.Extra
import Data.Hashable
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as Map
import System.Time.Extra
import Control.Concurrent.Async
import Control.Concurrent.Extra
import Control.Exception
import Control.Monad.Extra
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as Map
import Data.Hashable
import System.Time.Extra
-- | A debouncer can be used to avoid triggering many events
-- (e.g. diagnostics) for the same key (e.g. the same file)

14
ghcide/src/Development/IDE/Core/FileExists.hs
View File

@ -14,9 +14,9 @@ import Control.Concurrent.Extra
import Control.Exception
import Control.Monad.Extra
import Data.Binary
import qualified Data.ByteString as BS
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.ByteString as BS
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe
import Development.IDE.Core.FileStore
import Development.IDE.Core.IdeConfiguration
@ -26,11 +26,11 @@ import Development.IDE.Types.Options
import Development.Shake
import Development.Shake.Classes
import GHC.Generics
import Language.LSP.Server hiding (getVirtualFile)
import Language.LSP.Server hiding (getVirtualFile)
import Language.LSP.Types
import Language.LSP.Types.Capabilities
import qualified System.Directory as Dir
import qualified System.FilePath.Glob as Glob
import qualified System.Directory as Dir
import qualified System.FilePath.Glob as Glob
{- Note [File existence cache and LSP file watchers]
Some LSP servers provide the ability to register file watches with the client, which will then notify
@ -212,7 +212,7 @@ fileExistsFast vfs file = do
Just exist -> pure exist
-- We don't know about it: use the slow route.
-- Note that we do *not* call 'fileExistsSlow', as that would trigger 'alwaysRerun'.
Nothing -> liftIO $ getFileExistsVFS vfs file
Nothing -> liftIO $ getFileExistsVFS vfs file
pure (summarizeExists exist, ([], Just exist))
summarizeExists :: Bool -> Maybe BS.ByteString

82
ghcide/src/Development/IDE/Core/FileStore.hs
View File

@ -1,6 +1,6 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
module Development.IDE.Core.FileStore(
@ -17,51 +17,53 @@ module Development.IDE.Core.FileStore(
isFileOfInterestRule
) where
import Development.IDE.GHC.Orphans()
import Development.IDE.Core.Shake
import Control.Concurrent.Extra
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TQueue (writeTQueue)
import qualified Data.Map.Strict as Map
import qualified Data.HashMap.Strict as HM
import Data.Maybe
import qualified Data.Text as T
import Control.Concurrent.Extra
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TQueue (writeTQueue)
import Control.Exception
import Control.Monad.Extra
import qualified Data.ByteString.Char8 as BS
import Data.Either.Extra
import qualified Data.HashMap.Strict as HM
import Data.Int (Int64)
import qualified Data.Map.Strict as Map
import Data.Maybe
import qualified Data.Rope.UTF16 as Rope
import qualified Data.Text as T
import Data.Time
import Development.IDE.Core.OfInterest (getFilesOfInterest)
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake
import Development.IDE.GHC.Orphans ()
import Development.IDE.Import.DependencyInformation
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import Development.IDE.Types.Options
import Development.Shake
import Development.Shake.Classes
import Control.Exception
import Data.Either.Extra
import Data.Int (Int64)
import Data.Time
import System.IO.Error
import qualified Data.ByteString.Char8 as BS
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import Development.IDE.Core.OfInterest (getFilesOfInterest)
import Development.IDE.Core.RuleTypes
import Development.IDE.Types.Options
import qualified Data.Rope.UTF16 as Rope
import Development.IDE.Import.DependencyInformation
import Ide.Plugin.Config (CheckParents(..))
import HieDb.Create (deleteMissingRealFiles)
import HieDb.Create (deleteMissingRealFiles)
import Ide.Plugin.Config (CheckParents (..))
import System.IO.Error
#ifdef mingw32_HOST_OS
import qualified System.Directory as Dir
import qualified System.Directory as Dir
#else
import Data.Time.Clock.System (systemToUTCTime, SystemTime(MkSystemTime))
import Foreign.Ptr
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal (alloca)
import Foreign.Storable
import qualified System.Posix.Error as Posix
import Data.Time.Clock.System (SystemTime (MkSystemTime),
systemToUTCTime)
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal (alloca)
import Foreign.Ptr
import Foreign.Storable
import qualified System.Posix.Error as Posix
#endif
import qualified Development.IDE.Types.Logger as L
import qualified Development.IDE.Types.Logger as L
import Language.LSP.Server hiding (getVirtualFile)
import qualified Language.LSP.Server as LSP
import Language.LSP.VFS
import Language.LSP.Server hiding
(getVirtualFile)
import qualified Language.LSP.Server as LSP
import Language.LSP.VFS
makeVFSHandle :: IO VFSHandle
makeVFSHandle = do
@ -161,7 +163,7 @@ getFileContentsRule vfs =
mbVirtual <- getVirtualFile vfs $ filePathToUri' file
pure $ Rope.toText . _text <$> mbVirtual
case res of
Left err -> return ([err], Nothing)
Left err -> return ([err], Nothing)
Right contents -> return ([], Just (time, contents))
ideTryIOException :: NormalizedFilePath -> IO a -> IO (Either FileDiagnostic a)
@ -203,9 +205,9 @@ setFileModified state saved nfp = do
ideOptions <- getIdeOptionsIO $ shakeExtras state
doCheckParents <- optCheckParents ideOptions
let checkParents = case doCheckParents of
AlwaysCheck -> True
AlwaysCheck -> True
CheckOnSaveAndClose -> saved
_ -> False
_ -> False
VFSHandle{..} <- getIdeGlobalState state
when (isJust setVirtualFileContents) $
fail "setFileModified can't be called on this type of VFSHandle"

10
ghcide/src/Development/IDE/Core/IdeConfiguration.hs
View File

@ -14,20 +14,20 @@ where
import Control.Concurrent.Extra
import Control.Monad
import Data.Hashable (Hashed, hashed, unhashed)
import Data.HashSet (HashSet, singleton)
import Data.Text (Text, isPrefixOf)
import Data.Aeson.Types (Value)
import Data.HashSet (HashSet, singleton)
import Data.Hashable (Hashed, hashed, unhashed)
import Data.Text (Text, isPrefixOf)
import Development.IDE.Core.Shake
import Development.IDE.Types.Location
import Development.Shake
import Language.LSP.Types
import System.FilePath (isRelative)
import System.FilePath (isRelative)
-- | Lsp client relevant configuration details
data IdeConfiguration = IdeConfiguration
{ workspaceFolders :: HashSet NormalizedUri
, clientSettings :: Hashed (Maybe Value)
, clientSettings :: Hashed (Maybe Value)
}
deriving (Show)

52
ghcide/src/Development/IDE/Core/OfInterest.hs
View File

@ -1,8 +1,8 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
-- | Utilities and state for the files of interest - those which are currently
-- open in the editor. The useful function is 'getFilesOfInterest'.
@ -12,32 +12,32 @@ module Development.IDE.Core.OfInterest(
kick, FileOfInterestStatus(..)
) where
import Control.Concurrent.Extra
import Data.Binary
import Data.Hashable
import Control.DeepSeq
import GHC.Generics
import Data.Typeable
import qualified Data.ByteString.UTF8 as BS
import Control.Exception
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as T
import Data.Tuple.Extra
import Development.Shake
import Control.Monad
import Control.Concurrent.Extra
import Control.DeepSeq
import Control.Exception
import Control.Monad
import Data.Binary
import qualified Data.ByteString.UTF8 as BS
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Hashable
import qualified Data.Text as T
import Data.Tuple.Extra
import Data.Typeable
import Development.Shake
import GHC.Generics
import Development.IDE.Types.Exports
import Development.IDE.Types.Location
import Development.IDE.Types.Logger
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake
import Data.Maybe (catMaybes)
import Data.List.Extra (nubOrd)
import Development.IDE.Import.DependencyInformation
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Class
import Development.IDE.Types.Options
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import Data.List.Extra (nubOrd)
import Data.Maybe (catMaybes)
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake
import Development.IDE.Import.DependencyInformation
import Development.IDE.Types.Exports
import Development.IDE.Types.Location
import Development.IDE.Types.Logger
import Development.IDE.Types.Options
newtype OfInterestVar = OfInterestVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))
instance IsIdeGlobal OfInterestVar

22
ghcide/src/Development/IDE/Core/PositionMapping.hs
View File

@ -22,14 +22,14 @@ module Development.IDE.Core.PositionMapping
, fromCurrent
) where
import Control.Monad
import qualified Data.Text as T
import Language.LSP.Types
import Data.List
import Data.Algorithm.Diff
import Data.Bifunctor
import Control.DeepSeq
import Control.DeepSeq
import Control.Monad
import Data.Algorithm.Diff
import Data.Bifunctor
import Data.List
import qualified Data.Text as T
import qualified Data.Vector.Unboxed as V
import Language.LSP.Types
-- | Either an exact position, or the range of text that was substituted
data PositionResult a
@ -40,16 +40,16 @@ data PositionResult a
deriving (Eq,Ord,Show,Functor)
lowerRange :: PositionResult a -> a
lowerRange (PositionExact a) = a
lowerRange (PositionExact a) = a
lowerRange (PositionRange lower _) = lower
upperRange :: PositionResult a -> a
upperRange (PositionExact a) = a
upperRange (PositionExact a) = a
upperRange (PositionRange _ upper) = upper
positionResultToMaybe :: PositionResult a -> Maybe a
positionResultToMaybe (PositionExact a) = Just a
positionResultToMaybe _ = Nothing
positionResultToMaybe _ = Nothing
instance Applicative PositionResult where
pure = PositionExact
@ -66,7 +66,7 @@ instance Monad PositionResult where
-- The position delta is the difference between two versions
data PositionDelta = PositionDelta
{ toDelta :: !(Position -> PositionResult Position)
{ toDelta :: !(Position -> PositionResult Position)
, fromDelta :: !(Position -> PositionResult Position)
}

58
ghcide/src/Development/IDE/Core/Preprocessor.hs
View File

@ -5,32 +5,34 @@ module Development.IDE.Core.Preprocessor
( preprocessor
) where
import Development.IDE.GHC.CPP
import Development.IDE.GHC.Orphans()
import Development.IDE.GHC.Compat
import GhcMonad
import StringBuffer as SB
import Development.IDE.GHC.CPP
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Orphans ()
import GhcMonad
import StringBuffer as SB
import Data.List.Extra
import System.FilePath
import System.IO.Extra
import Data.Char
import qualified HeaderInfo as Hdr
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import Development.IDE.GHC.Error
import SysTools (Option (..), runUnlit, runPp)
import Control.Monad.Trans.Except
import qualified GHC.LanguageExtensions as LangExt
import Data.Maybe
import Control.Exception.Safe (catch, throw)
import Data.IORef (IORef, modifyIORef, newIORef, readIORef)
import Data.Text (Text)
import qualified Data.Text as T
import Outputable (showSDoc)
import Control.DeepSeq (NFData(rnf))
import Control.Exception (evaluate)
import HscTypes (HscEnv(hsc_dflags))
import Control.DeepSeq (NFData (rnf))
import Control.Exception (evaluate)
import Control.Exception.Safe (catch, throw)
import Control.Monad.Trans.Except
import Data.Char
import Data.IORef (IORef, modifyIORef,
newIORef, readIORef)
import Data.List.Extra
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Development.IDE.GHC.Error
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import qualified GHC.LanguageExtensions as LangExt
import qualified HeaderInfo as Hdr
import HscTypes (HscEnv (hsc_dflags))
import Outputable (showSDoc)
import SysTools (Option (..), runPp,
runUnlit)
import System.FilePath
import System.IO.Extra
-- | Given a file and some contents, apply any necessary preprocessors,
@ -62,7 +64,7 @@ preprocessor env filename mbContents = do
( \(e :: GhcException) -> do
logs <- readIORef cppLogs
case diagsFromCPPLogs filename (reverse logs) of
[] -> throw e
[] -> throw e
diags -> return $ Left diags
)
dflags <- ExceptT $ parsePragmasIntoDynFlags env filename contents
@ -88,9 +90,9 @@ data CPPLog = CPPLog Severity SrcSpan Text
data CPPDiag
= CPPDiag
{ cdRange :: Range,
{ cdRange :: Range,
cdSeverity :: Maybe DiagnosticSeverity,
cdMessage :: [Text]
cdMessage :: [Text]
}
deriving (Show)

82
ghcide/src/Development/IDE/Core/RuleTypes.hs
View File

@ -1,12 +1,12 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
-- | A Shake implementation of the compiler service, built
-- using the "Shaker" abstraction layer for in-memory use.
@ -16,33 +16,37 @@ module Development.IDE.Core.RuleTypes(
) where
import Control.DeepSeq
import Control.Lens
import Data.Aeson.Types (Value)
import Data.Binary
import Development.IDE.Import.DependencyInformation
import Development.IDE.GHC.Compat hiding (HieFileResult)
import Development.IDE.GHC.Util
import Development.IDE.Types.HscEnvEq (HscEnvEq)
import Development.IDE.Types.KnownTargets
import Control.Lens
import Data.Aeson.Types (Value)
import Data.Binary
import Data.Hashable
import qualified Data.Map as M
import Data.Typeable
import qualified Data.Map as M
import Development.IDE.GHC.Compat hiding
(HieFileResult)
import Development.IDE.GHC.Util
import Development.IDE.Import.DependencyInformation
import Development.IDE.Types.HscEnvEq (HscEnvEq)
import Development.IDE.Types.KnownTargets
import Development.Shake
import GHC.Generics (Generic)
import GHC.Generics (Generic)
import HscTypes (ModGuts, hm_iface, HomeModInfo, hm_linkable)
import HscTypes (HomeModInfo,
ModGuts,
hm_iface,
hm_linkable)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Int (Int64)
import Data.Text (Text)
import Development.IDE.Import.FindImports (ArtifactsLocation)
import Development.IDE.Spans.Common
import Development.IDE.Spans.LocalBindings
import Development.IDE.Import.FindImports (ArtifactsLocation)
import Data.ByteString (ByteString)
import Language.LSP.Types (NormalizedFilePath)
import TcRnMonad (TcGblEnv)
import qualified Data.ByteString.Char8 as BS
import Development.IDE.Types.Options (IdeGhcSession)
import Data.Text (Text)
import Data.Int (Int64)
import GHC.Serialized (Serialized)
import Development.IDE.Types.Options (IdeGhcSession)
import GHC.Serialized (Serialized)
import Language.LSP.Types (NormalizedFilePath)
import TcRnMonad (TcGblEnv)
data LinkableType = ObjectLinkable | BCOLinkable
deriving (Eq,Ord,Show, Generic)
@ -101,10 +105,10 @@ newtype ImportMap = ImportMap
data Splices = Splices
{ exprSplices :: [(LHsExpr GhcTc, LHsExpr GhcPs)]
, patSplices :: [(LHsExpr GhcTc, LPat GhcPs)]
, patSplices :: [(LHsExpr GhcTc, LPat GhcPs)]
, typeSplices :: [(LHsExpr GhcTc, LHsType GhcPs)]
, declSplices :: [(LHsExpr GhcTc, [LHsDecl GhcPs])]
, awSplices :: [(LHsExpr GhcTc, Serialized)]
, awSplices :: [(LHsExpr GhcTc, Serialized)]
}
instance Semigroup Splices where
@ -128,12 +132,12 @@ instance NFData Splices where
-- | Contains the typechecked module and the OrigNameCache entry for
-- that module.
data TcModuleResult = TcModuleResult
{ tmrParsed :: ParsedModule
, tmrRenamed :: RenamedSource
, tmrTypechecked :: TcGblEnv
{ tmrParsed :: ParsedModule
, tmrRenamed :: RenamedSource
, tmrTypechecked :: TcGblEnv
, tmrTopLevelSplices :: Splices
-- ^ Typechecked splice information
, tmrDeferedError :: !Bool
, tmrDeferedError :: !Bool
-- ^ Did we defer any type errors for this module?
}
instance Show TcModuleResult where
@ -149,7 +153,7 @@ data HiFileResult = HiFileResult
{ hirModSummary :: !ModSummary
-- Bang patterns here are important to stop the result retaining
-- a reference to a typechecked module
, hirHomeMod :: !HomeModInfo
, hirHomeMod :: !HomeModInfo
-- ^ Includes the Linkable iff we need object files
}
@ -159,7 +163,7 @@ hiFileFingerPrint hfr = ifaceBS <> linkableBS
ifaceBS = fingerprintToBS . getModuleHash . hirModIface $ hfr -- will always be two bytes
linkableBS = case hm_linkable $ hirHomeMod hfr of
Nothing -> ""
Just l -> BS.pack $ show $ linkableTime l
Just l -> BS.pack $ show $ linkableTime l
hirModIface :: HiFileResult -> ModIface
hirModIface = hm_iface . hirHomeMod
@ -174,14 +178,14 @@ instance Show HiFileResult where
data HieAstResult
= forall a. HAR
{ hieModule :: Module
, hieAst :: !(HieASTs a)
, refMap :: RefMap a
, hieAst :: !(HieASTs a)
, refMap :: RefMap a
-- ^ Lazy because its value only depends on the hieAst, which is bundled in this type
-- Lazyness can't cause leaks here because the lifetime of `refMap` will be the same
-- as that of `hieAst`
, typeRefs :: M.Map Name [RealSrcSpan]
, typeRefs :: M.Map Name [RealSrcSpan]
-- ^ type references in this file
, hieKind :: !(HieKind a)
, hieKind :: !(HieKind a)
-- ^ Is this hie file loaded from the disk, or freshly computed?
}
@ -191,7 +195,7 @@ data HieKind a where
instance NFData (HieKind a) where
rnf (HieFromDisk hf) = rnf hf
rnf HieFresh = ()
rnf HieFresh = ()
instance NFData HieAstResult where
rnf (HAR m hf _rm _tr kind) = rnf m `seq` rwhnf hf `seq` rnf kind
@ -285,7 +289,7 @@ data FileVersion
instance NFData FileVersion
vfsVersion :: FileVersion -> Maybe Int
vfsVersion (VFSVersion i) = Just i
vfsVersion (VFSVersion i) = Just i
vfsVersion ModificationTime{} = Nothing
data GetFileContents = GetFileContents

163
ghcide/src/Development/IDE/Core/Rules.hs
View File

@ -2,9 +2,9 @@
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
#include "ghc-api-version.h"
-- | A Shake implementation of the compiler service, built
@ -64,81 +64,94 @@ module Development.IDE.Core.Rules(
typeCheckRuleDefinition,
) where
import Fingerprint
import Fingerprint
import Data.Aeson (toJSON, Result(Success))
import Data.Binary hiding (get, put)
import Data.Tuple.Extra
import Control.Monad.Extra
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import Development.IDE.Core.Compile
import Development.IDE.Core.OfInterest
import Development.IDE.Types.Options
import Development.IDE.Spans.Documentation
import Development.IDE.Spans.LocalBindings
import Development.IDE.Import.DependencyInformation
import Development.IDE.Import.FindImports
import Development.IDE.Core.FileExists
import Development.IDE.Core.FileStore (modificationTime, getFileContents)
import Development.IDE.Types.Diagnostics as Diag
import Development.IDE.Types.Location
import Development.IDE.GHC.Compat hiding (parseModule, typecheckModule, writeHieFile, TargetModule, TargetFile)
import Development.IDE.GHC.ExactPrint
import Development.IDE.GHC.Util
import qualified Development.IDE.Types.Logger as L
import Data.Maybe
import Control.Monad.Extra
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import Data.Aeson (Result (Success),
toJSON)
import Data.Binary hiding (get, put)
import qualified Data.ByteString.Char8 as BS
import Data.Foldable
import qualified Data.IntMap.Strict as IntMap
import Data.IntMap.Strict (IntMap)
import Data.List
import qualified Data.Set as Set
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.List
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Tuple.Extra
import Development.IDE.Core.Compile
import Development.IDE.Core.FileExists
import Development.IDE.Core.FileStore (getFileContents,
modificationTime)
import Development.IDE.Core.OfInterest
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes
import Development.IDE.GHC.Compat hiding
(TargetFile,
TargetModule,
parseModule,
typecheckModule,
writeHieFile)
import Development.IDE.GHC.Error
import Development.Shake hiding (Diagnostic)
import Development.IDE.Core.RuleTypes
import qualified Data.ByteString.Char8 as BS
import Development.IDE.Core.PositionMapping
import Language.LSP.Types (DocumentHighlight (..), SymbolInformation(..), SMethod(SCustomMethod))
import qualified Language.LSP.Server as LSP
import Language.LSP.VFS
import Development.IDE.GHC.ExactPrint
import Development.IDE.GHC.Util
import Development.IDE.Import.DependencyInformation
import Development.IDE.Import.FindImports
import Development.IDE.Spans.Documentation
import Development.IDE.Spans.LocalBindings
import Development.IDE.Types.Diagnostics as Diag
import Development.IDE.Types.Location
import qualified Development.IDE.Types.Logger as L
import Development.IDE.Types.Options
import Development.Shake hiding
(Diagnostic)
import qualified Language.LSP.Server as LSP
import Language.LSP.Types (DocumentHighlight (..),
SMethod (SCustomMethod),
SymbolInformation (..))
import Language.LSP.VFS
import qualified GHC.LanguageExtensions as LangExt
import HscTypes hiding (TargetModule, TargetFile)
import GHC.Generics(Generic)
import GHC.Generics (Generic)
import qualified GHC.LanguageExtensions as LangExt
import HscTypes hiding
(TargetFile,
TargetModule)
import qualified Development.IDE.Spans.AtPoint as AtPoint
import Development.IDE.Core.IdeConfiguration
import Development.IDE.Core.Service
import Development.IDE.Core.Shake
import Development.IDE.Types.HscEnvEq
import Development.Shake.Classes hiding (get, put)
import Control.Monad.Trans.Except (runExceptT,ExceptT,except)
import Control.Concurrent.Async (concurrently)
import Control.Monad.Reader
import Control.Exception.Safe
import Control.Concurrent.Async (concurrently)
import Control.Exception.Safe
import Control.Monad.Reader
import Control.Monad.Trans.Except (ExceptT, except,
runExceptT)
import Development.IDE.Core.IdeConfiguration
import Development.IDE.Core.Service
import Development.IDE.Core.Shake
import qualified Development.IDE.Spans.AtPoint as AtPoint
import Development.IDE.Types.HscEnvEq
import Development.Shake.Classes hiding (get, put)
import Data.Coerce
import Control.Monad.State
import FastString (FastString(uniq))
import qualified HeaderInfo as Hdr
import Data.Time (UTCTime(..))
import Data.Hashable
import qualified Data.HashSet as HashSet
import qualified Data.HashMap.Strict as HM
import TcRnMonad (tcg_dependent_files)
import Data.IORef
import Control.Concurrent.Extra
import Module
import qualified Data.Rope.UTF16 as Rope
import GHC.IO.Encoding
import Data.ByteString.Encoding as T
import Control.Concurrent.Extra
import Control.Monad.State
import Data.ByteString.Encoding as T
import Data.Coerce
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HashSet
import Data.Hashable
import Data.IORef
import qualified Data.Rope.UTF16 as Rope
import Data.Time (UTCTime (..))
import FastString (FastString (uniq))
import GHC.IO.Encoding
import qualified HeaderInfo as Hdr
import Module
import TcRnMonad (tcg_dependent_files)
import qualified Data.Aeson.Types as A
import qualified HieDb
import Ide.Plugin.Config
import qualified Data.Aeson.Types as A
import Ide.Plugin.Config
-- | This is useful for rules to convert rules that can only produce errors or
-- a result into the more general IdeResult type that supports producing
@ -262,7 +275,7 @@ getSourceFileSource :: NormalizedFilePath -> Action BS.ByteString
getSourceFileSource nfp = do
(_, msource) <- getFileContents nfp
case msource of
Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath nfp)
Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath nfp)
Just source -> pure $ T.encodeUtf8 source
-- | Parse the contents of a haskell file.
@ -405,9 +418,9 @@ getLocatedImportsRule =
(diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do
diagOrImp <- locateModule dflags import_dirs (optExtensions opt) getTargetExists modName mbPkgName isSource
case diagOrImp of
Left diags -> pure (diags, Just (modName, Nothing))
Left diags -> pure (diags, Just (modName, Nothing))
Right (FileImport path) -> pure ([], Just (modName, Just path))
Right PackageImport -> pure ([], Nothing)
Right PackageImport -> pure ([], Nothing)
let moduleImports = catMaybes imports'
pure (concat diags, Just moduleImports)
@ -499,7 +512,7 @@ rawDependencyInformation fs = do
-> ([Located ModuleName], [(Located ModuleName, ArtifactsLocation)])
splitImports = foldr splitImportsLoop ([],[])
splitImportsLoop (imp, Nothing) (ns, ls) = (imp:ns, ls)
splitImportsLoop (imp, Nothing) (ns, ls) = (imp:ns, ls)
splitImportsLoop (imp, Just artifact) (ns, ls) = (ns, (imp,artifact) : ls)
updateBootMap pm boot_mod_id ArtifactsLocation{..} bm =
@ -625,7 +638,7 @@ getBindingsRule =
define $ \GetBindings f -> do
HAR{hieKind=kind, refMap=rm} <- use_ GetHieAst f
case kind of
HieFresh -> pure ([], Just $ bindings rm)
HieFresh -> pure ([], Just $ bindings rm)
HieFromDisk _ -> pure ([], Nothing)
getDocMapRule :: Rules ()
@ -1036,7 +1049,7 @@ getClientConfigAction defValue = do
mbVal <- unhashed <$> useNoFile_ GetClientSettings
case A.parse (parseConfig defValue) <$> mbVal of
Just (Success c) -> return c
_ -> return defValue
_ -> return defValue
-- | For now we always use bytecode unless something uses unboxed sums and tuples along with TH
getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType)

188
ghcide/src/Development/IDE/Core/Shake.hs
View File

@ -1,13 +1,13 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TypeFamilies #-}
-- | A Shake implementation of the compiler service.
--
@ -73,86 +73,88 @@ module Development.IDE.Core.Shake(
addPersistentRule
) where
import Development.Shake hiding (ShakeValue, doesFileExist, Info)
import Development.Shake.Database
import Development.Shake.Classes
import Development.Shake.Rule
import qualified Data.HashMap.Strict as HMap
import qualified Data.Map.Strict as Map
import qualified Data.ByteString.Char8 as BS
import Data.Dynamic
import Data.Maybe
import Data.Map.Strict (Map)
import Data.List.Extra (partition, takeEnd)
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Data.Tuple.Extra
import Data.Unique
import Development.IDE.Core.Debouncer
import Development.IDE.GHC.Compat (NameCacheUpdater(..), upNameCache )
import Development.IDE.GHC.Orphans ()
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes
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.LSP.Diagnostics
import qualified Data.SortedList as SL
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Exports
import Development.IDE.Types.Location
import Development.IDE.Types.Options
import Control.Concurrent.Async
import Control.Concurrent.Extra
import Control.Concurrent.STM
import Control.DeepSeq
import System.Time.Extra
import Data.Typeable
import qualified Language.LSP.Server as LSP
import qualified Language.LSP.Types as LSP
import System.FilePath hiding (makeRelative)
import qualified Development.Shake as Shake
import Control.Monad.Extra
import Control.Monad.IO.Class
import Control.Monad.Reader
import qualified Control.Monad.STM as STM
import Control.Monad.Trans.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.Dynamic
import qualified Data.HashMap.Strict as HMap
import Data.Hashable
import Data.List.Extra (partition, takeEnd)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import qualified Data.Set as Set
import qualified Data.SortedList as SL
import qualified Data.Text as T
import Data.Time
import Data.Traversable
import Data.Tuple.Extra
import Data.Typeable
import Data.Unique
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Development.IDE.Core.Debouncer
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Tracing
import Development.IDE.GHC.Compat (NameCacheUpdater (..),
upNameCache)
import Development.IDE.GHC.Orphans ()
import Development.IDE.Types.Action
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Exports
import Development.IDE.Types.KnownTargets
import Development.IDE.Types.Location
import Development.IDE.Types.Logger hiding (Priority)
import qualified Development.IDE.Types.Logger as Logger
import Development.IDE.Types.Options
import Development.IDE.Types.Shake
import Development.Shake hiding (Info, ShakeValue,
doesFileExist)
import qualified Development.Shake as Shake
import Development.Shake.Classes
import Development.Shake.Database
import Development.Shake.Rule
import GHC.Generics
import Language.LSP.Types
import qualified Control.Monad.STM as STM
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.Trans.Maybe
import Data.Traversable
import Data.Hashable
import Development.IDE.Core.Tracing
import Language.LSP.VFS
import Language.LSP.Diagnostics
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
import qualified Language.LSP.Types as LSP
import Language.LSP.VFS
import System.FilePath hiding (makeRelative)
import System.Time.Extra
import Data.IORef
import NameCache
import UniqSupply
import PrelInfo
import Language.LSP.Types.Capabilities
import OpenTelemetry.Eventlog
import GHC.Fingerprint
import Data.IORef
import GHC.Fingerprint
import Language.LSP.Types.Capabilities
import NameCache
import OpenTelemetry.Eventlog
import PrelInfo
import UniqSupply
import HieDb.Types
import Control.Exception.Extra hiding (bracket_)
import UnliftIO.Exception (bracket_)
import Control.Exception.Extra hiding (bracket_)
import Data.Default
import HieDb.Types
import Ide.Plugin.Config
import Data.Default
import qualified Ide.PluginUtils as HLS
import Ide.Types ( PluginId )
import qualified Ide.PluginUtils as HLS
import Ide.Types (PluginId)
import UnliftIO.Exception (bracket_)
-- | We need to serialize writes to the database, so we send any function that
-- needs to write to the database over the channel, where it will be picked up by
-- a worker thread.
data HieDbWriter
= HieDbWriter
{ indexQueue :: IndexQueue
, indexPending :: TVar (HMap.HashMap NormalizedFilePath Fingerprint) -- ^ Avoid unnecessary/out of date indexing
, indexCompleted :: TVar Int -- ^ to report progress
{ indexQueue :: IndexQueue
, indexPending :: TVar (HMap.HashMap NormalizedFilePath Fingerprint) -- ^ Avoid unnecessary/out of date indexing
, indexCompleted :: TVar Int -- ^ to report progress
, indexProgressToken :: Var (Maybe LSP.ProgressToken)
-- ^ This is a Var instead of a TVar since we need to do IO to initialise/update, so we need a lock
}
@ -253,7 +255,7 @@ class Typeable a => IsIdeGlobal a where
-- the builtin VFS without spawning up an LSP server. To be able to test things
-- like `setBufferModified` we abstract over the VFS implementation.
data VFSHandle = VFSHandle
{ getVirtualFile :: NormalizedUri -> IO (Maybe VirtualFile)
{ getVirtualFile :: NormalizedUri -> IO (Maybe VirtualFile)
-- ^ get the contents of a virtual file
, setVirtualFileContents :: Maybe (NormalizedUri -> Maybe T.Text -> IO ())
-- ^ set a specific file to a value. If Nothing then we are ignoring these
@ -331,7 +333,7 @@ lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do
-- Old failed, we can update it preserving diagnostics
Failed{} -> ValueWithDiagnostics new diags
-- Something already succeeded before, leave it alone
_ -> old
_ -> old
case HMap.lookup (file,Key k) hm of
Nothing -> readPersistent
@ -351,8 +353,8 @@ lastValue key file = do
valueVersion :: Value v -> Maybe TextDocumentVersion
valueVersion = \case
Succeeded ver _ -> Just ver
Stale _ ver _ -> Just ver
Failed _ -> Nothing
Stale _ ver _ -> Just ver
Failed _ -> Nothing
mappingForVersion
:: HMap.HashMap NormalizedUri (Map TextDocumentVersion (a, PositionMapping))
@ -382,11 +384,11 @@ newtype ShakeSession = ShakeSession
-- | A Shake database plus persistent store. Can be thought of as storing
-- mappings from @(FilePath, k)@ to @RuleResult k@.
data IdeState = IdeState
{shakeDb :: ShakeDatabase
,shakeSession :: MVar ShakeSession
,shakeClose :: IO ()
,shakeExtras :: ShakeExtras
,shakeDatabaseProfile :: ShakeDatabase -> IO (Maybe FilePath)
{shakeDb :: ShakeDatabase
,shakeSession :: MVar ShakeSession
,shakeClose :: IO ()
,shakeExtras :: ShakeExtras
,shakeDatabaseProfile :: ShakeDatabase -> IO (Maybe FilePath)
,stopProgressReporting :: IO ()
}
@ -456,8 +458,8 @@ knownTargets = do
seqValue :: Value v -> b -> b
seqValue v b = case v of
Succeeded ver v -> rnf ver `seq` v `seq` b
Stale d ver v -> rnf d `seq` rnf ver `seq` v `seq` b
Failed _ -> b
Stale d ver v -> rnf d `seq` rnf ver `seq` v `seq` b
Failed _ -> b
-- | Open a 'IdeState', should be shut using 'shakeShut'.
shakeOpen :: Maybe (LSP.LanguageContextEnv Config)
@ -534,14 +536,14 @@ shakeOpen lspEnv defaultConfig logger debouncer
v <- readTVar mostRecentProgressEvent
case v of
KickCompleted -> STM.retry
KickStarted -> return ()
KickStarted -> return ()
asyncReporter <- async $ mRunLspT lspEnv lspShakeProgress
progressLoopReporting asyncReporter
progressLoopReporting asyncReporter = do
atomically $ do
v <- readTVar mostRecentProgressEvent
case v of
KickStarted -> STM.retry
KickStarted -> STM.retry
KickCompleted -> return ()
cancel asyncReporter
progressLoopIdle
@ -643,7 +645,7 @@ shakeRestart IdeState{..} acts =
res <- shakeDatabaseProfile shakeDb
let profile = case res of
Just fp -> ", profile saved at " <> fp
_ -> ""
_ -> ""
let msg = T.pack $ "Restarting build session (aborting the previous one took "
++ showDuration stopTime ++ profile ++ ")"
logDebug (logger shakeExtras) msg
@ -712,7 +714,7 @@ newSession extras@ShakeExtras{..} shakeDb acts = 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
Left e -> "exception: " <> displayException e
Right _ -> "completed"
let msg = T.pack $ "Finishing build session(" ++ res' ++ ")"
return $ do
@ -753,7 +755,7 @@ instantiateDelayedAction (DelayedAction _ s p a) = do
mRunLspT :: Applicative m => Maybe (LSP.LanguageContextEnv c ) -> LSP.LspT c m () -> m ()
mRunLspT (Just lspEnv) f = LSP.runLspT lspEnv f
mRunLspT Nothing _ = pure ()
mRunLspT Nothing _ = pure ()
mRunLspTCallback :: Monad m
=> Maybe (LSP.LanguageContextEnv c)
@ -761,7 +763,7 @@ mRunLspTCallback :: Monad m
-> m a
-> m a
mRunLspTCallback (Just lspEnv) f g = LSP.runLspT lspEnv $ f (lift g)
mRunLspTCallback Nothing _ g = g
mRunLspTCallback Nothing _ g = g
getDiagnostics :: IdeState -> IO [FileDiagnostic]
getDiagnostics IdeState{shakeExtras = ShakeExtras{diagnostics}} = do
@ -818,7 +820,7 @@ usesWithStale_ key files = do
res <- usesWithStale key files
case sequence res of
Nothing -> liftIO $ throwIO $ BadDependency (show key)
Just v -> return v
Just v -> return v
newtype IdeAction a = IdeAction { runIdeActionT :: (ReaderT ShakeExtras IO) a }
deriving newtype (MonadReader ShakeExtras, MonadIO, Functor, Applicative, Monad)
@ -886,7 +888,7 @@ uses_ key files = do
res <- uses key files
case sequence res of
Nothing -> liftIO $ throwIO $ BadDependency (show key)
Just v -> return v
Just v -> return v
-- | Plural version of 'use'
uses :: IdeRule k v
@ -947,10 +949,10 @@ defineEarlyCutoff op = addBuiltinRule noLint noIdentity $ \(Q (key, file)) (old
updateFileDiagnostics file (Key key) extras $ map (\(_,y,z) -> (y,z)) diags
let eq = case (bs, fmap decodeShakeValue old) of
(ShakeResult a, Just (ShakeResult b)) -> a == b
(ShakeStale a, Just (ShakeStale b)) -> a == b
(ShakeStale a, Just (ShakeStale b)) -> a == b
-- If we do not have a previous result
-- or we got ShakeNoCutoff we always return False.
_ -> False
_ -> False
return $ RunResult
(if eq then ChangedRecomputeSame else ChangedRecomputeDiff)
(encodeShakeValue bs) $
@ -965,7 +967,7 @@ defineEarlyCutoff op = addBuiltinRule noLint noIdentity $ \(Q (key, file)) (old
isSuccess :: RunResult (A v) -> Bool
isSuccess (RunResult _ _ (A Failed{})) = False
isSuccess _ = True
isSuccess _ = True
-- | Rule type, input file
data QDisk k = QDisk k NormalizedFilePath

27
ghcide/src/Development/IDE/Core/Tracing.hs
View File

@ -13,35 +13,40 @@ 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 (void, when, unless, forM_, forever, (>=>))
import Control.Exception.Safe (SomeException, catch)
import Control.Monad (forM_, forever, unless, void,
when, (>=>))
import Control.Monad.Extra (whenJust)
import Control.Monad.IO.Unlift
import Control.Seq (r0, seqList, seqTuple2, using)
import Data.ByteString (ByteString)
import Data.Dynamic (Dynamic)
import qualified Data.HashMap.Strict as HMap
import Data.IORef (modifyIORef', newIORef,
readIORef, writeIORef)
import Data.String (IsString (fromString))
import Data.Text.Encoding (encodeUtf8)
import Development.IDE.Core.RuleTypes (GhcSession (GhcSession),
GhcSessionDeps (GhcSessionDeps),
GhcSessionIO (GhcSessionIO))
import Development.IDE.Types.Logger (logInfo, Logger, logDebug)
import Development.IDE.Types.Shake (ValueWithDiagnostics(..), Key (..), Value, Values)
import Development.IDE.Types.Location (Uri (..))
import Development.IDE.Types.Logger (Logger, logDebug, logInfo)
import Development.IDE.Types.Shake (Key (..), Value,
ValueWithDiagnostics (..),
Values)
import Development.Shake (Action, actionBracket)
import Ide.PluginUtils (installSigUsr1Handler)
import Foreign.Storable (Storable (sizeOf))
import HeapSize (recursiveSize, runHeapsize)
import Ide.PluginUtils (installSigUsr1Handler)
import Ide.Types (PluginId (..))
import Language.LSP.Types (NormalizedFilePath,
fromNormalizedFilePath)
import Numeric.Natural (Natural)
import OpenTelemetry.Eventlog (SpanInFlight, Synchronicity(Asynchronous), Instrument, addEvent, beginSpan, endSpan,
import OpenTelemetry.Eventlog (Instrument, SpanInFlight,
Synchronicity (Asynchronous),
addEvent, beginSpan, endSpan,
mkValueObserver, observe,
setTag, withSpan, withSpan_)
import Data.ByteString (ByteString)
import Data.Text.Encoding (encodeUtf8)
import Ide.Types (PluginId (..))
import Development.IDE.Types.Location (Uri (..))
import Control.Monad.IO.Unlift
-- | Trace a handler using OpenTelemetry. Adds various useful info into tags in the OpenTelemetry span.
otTracedHandler

39
ghcide/src/Development/IDE/GHC/CPP.hs
View File

@ -7,7 +7,10 @@
{- HLINT ignore -} -- since copied from upstream
{-# LANGUAGE CPP, NamedFieldPuns, NondecreasingIndentation, BangPatterns, MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
#include "ghc-api-version.h"
@ -22,29 +25,29 @@
module Development.IDE.GHC.CPP(doCpp, addOptP)
where
import Development.IDE.GHC.Compat
import Packages
import SysTools
import Module
import Panic
import FileCleanup
import Development.IDE.GHC.Compat
import FileCleanup
import Module
import Packages
import Panic
import SysTools
#if MIN_GHC_API_VERSION(8,8,2)
import LlvmCodeGen (llvmVersionList)
import LlvmCodeGen (llvmVersionList)
#elif MIN_GHC_API_VERSION(8,8,0)
import LlvmCodeGen (LlvmVersion (..))
import LlvmCodeGen (LlvmVersion (..))
#endif
#if MIN_GHC_API_VERSION (8,10,0)
import Fingerprint
import ToolSettings
import Fingerprint
import ToolSettings
#endif
import System.Directory
import System.FilePath
import Control.Monad
import System.Info
import Data.List ( intercalate )
import Data.Maybe
import Data.Version
import Control.Monad
import Data.List (intercalate)
import Data.Maybe
import Data.Version
import System.Directory
import System.FilePath
import System.Info

28
ghcide/src/Development/IDE/GHC/Error.hs
View File

@ -29,20 +29,20 @@ module Development.IDE.GHC.Error
, toDSeverity
) where
import Development.IDE.Types.Diagnostics as D
import qualified Data.Text as T
import Data.Maybe
import Development.IDE.Types.Location
import Development.IDE.GHC.Orphans()
import qualified FastString as FS
import GHC
import Bag
import HscTypes
import Panic
import Data.Maybe
import Data.String (fromString)
import qualified Data.Text as T
import Development.IDE.GHC.Orphans ()
import Development.IDE.Types.Diagnostics as D
import Development.IDE.Types.Location
import ErrUtils
import qualified FastString as FS
import GHC
import HscTypes
import qualified Outputable as Out
import Panic
import SrcLoc
import qualified Outputable as Out
import Data.String (fromString)
@ -92,7 +92,7 @@ realSrcLocToPosition real =
-- | Extract a file name from a GHC SrcSpan (use message for unhelpful ones)
-- FIXME This may not be an _absolute_ file name, needs fixing.
srcSpanToFilename :: SrcSpan -> Maybe FilePath
srcSpanToFilename (UnhelpfulSpan _) = Nothing
srcSpanToFilename (UnhelpfulSpan _) = Nothing
srcSpanToFilename (RealSrcSpan real) = Just $ FS.unpackFS $ srcSpanFile real
realSrcSpanToLocation :: RealSrcSpan -> Location
@ -123,7 +123,7 @@ positionToRealSrcLoc nfp (Position l c)=
isInsideSrcSpan :: Position -> SrcSpan -> Bool
p `isInsideSrcSpan` r = case srcSpanToRange r of
Just (Range sp ep) -> sp <= p && p <= ep
_ -> False
_ -> False
-- | Convert a GHC severity to a DAML compiler Severity. Severities below
-- "Warning" level are dropped (returning Nothing).
@ -160,7 +160,7 @@ zeroSpan file = realSrcLocSpan (mkRealSrcLoc file 1 1)
realSpan :: SrcSpan
-> Maybe RealSrcSpan
realSpan = \case
RealSrcSpan r -> Just r
RealSrcSpan r -> Just r
UnhelpfulSpan _ -> Nothing

8
ghcide/src/Development/IDE/GHC/Orphans.hs
View File

@ -12,16 +12,16 @@ module Development.IDE.GHC.Orphans() where
import Bag
import Control.DeepSeq
import Data.Aeson
import Data.Aeson
import Data.Hashable
import Data.String (IsString (fromString))
import Data.Text (Text)
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Util
import GHC ()
import GhcPlugins
import Retrie.ExactPrint (Annotated)
import qualified StringBuffer as SB
import Data.Text (Text)
import Data.String (IsString(fromString))
import Retrie.ExactPrint (Annotated)
-- Orphan instances for types from the GHC API.

87
ghcide/src/Development/IDE/GHC/Util.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP #-}
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
@ -28,46 +28,53 @@ module Development.IDE.GHC.Util(
disableWarningsAsErrors,
) where
import Control.Concurrent
import Data.List.Extra
import Data.ByteString.Internal (ByteString(..))
import Data.Maybe
import Data.Typeable
import qualified Data.ByteString.Internal as BS
import Fingerprint
import GhcMonad
import DynFlags
import Control.Exception
import Data.IORef
import FileCleanup
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import GHC.IO.BufferedIO (BufferedIO)
import GHC.IO.Device as IODevice
import GHC.IO.Encoding
import GHC.IO.Exception
import GHC.IO.Handle.Types
import GHC.IO.Handle.Internals
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import qualified Data.ByteString as BS
import Lexer
import StringBuffer
import System.FilePath
import HscTypes (cg_binds, md_types, cg_module, ModDetails, CgGuts, ic_dflags, hsc_IC, HscEnv(hsc_dflags))
import PackageConfig (PackageConfig)
import Outputable (SDoc, showSDocUnsafe, ppr, Outputable, mkUserStyle, renderWithStyle, neverQualify, Depth(..))
import Packages (getPackageConfigMap, lookupPackage')
import SrcLoc (mkRealSrcLoc)
import FastString (mkFastString)
import Module (moduleNameSlashes)
import OccName (parenSymOcc)
import RdrName (nameRdrName, rdrNameOcc)
import Control.Concurrent
import Control.Exception
import qualified Data.ByteString as BS
import Data.ByteString.Internal (ByteString (..))
import qualified Data.ByteString.Internal as BS
import Data.IORef
import Data.List.Extra
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import Data.Typeable
import DynFlags
import FastString (mkFastString)
import FileCleanup
import Fingerprint
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import GHC.IO.BufferedIO (BufferedIO)
import GHC.IO.Device as IODevice
import GHC.IO.Encoding
import GHC.IO.Exception
import GHC.IO.Handle.Internals
import GHC.IO.Handle.Types
import GhcMonad
import HscTypes (CgGuts, HscEnv (hsc_dflags),
ModDetails, cg_binds,
cg_module, hsc_IC, ic_dflags,
md_types)
import Lexer
import Module (moduleNameSlashes)
import OccName (parenSymOcc)
import Outputable (Depth (..), Outputable, SDoc,
mkUserStyle, neverQualify, ppr,
renderWithStyle,
showSDocUnsafe)
import PackageConfig (PackageConfig)
import Packages (getPackageConfigMap,
lookupPackage')
import RdrName (nameRdrName, rdrNameOcc)
import SrcLoc (mkRealSrcLoc)
import StringBuffer
import System.FilePath
import Development.IDE.GHC.Compat as GHC
import Development.IDE.Types.Location
import Development.IDE.GHC.Compat as GHC
import Development.IDE.Types.Location
----------------------------------------------------------------------

16
ghcide/src/Development/IDE/GHC/Warnings.hs
View File

@ -4,16 +4,16 @@
module Development.IDE.GHC.Warnings(withWarnings) where
import Data.List
import ErrUtils
import GhcPlugins as GHC hiding (Var, (<>))
import Data.List
import ErrUtils
import GhcPlugins as GHC hiding (Var, (<>))
import Control.Concurrent.Extra
import qualified Data.Text as T
import qualified Data.Text as T
import Development.IDE.Types.Diagnostics
import Development.IDE.GHC.Error
import Language.LSP.Types (type (|?)(..))
import Development.IDE.Types.Diagnostics
import Language.LSP.Types (type (|?) (..))
-- | Take a GHC monadic action (e.g. @typecheckModule pm@ for some
@ -40,8 +40,8 @@ attachReason :: WarnReason -> Diagnostic -> Diagnostic
attachReason wr d = d{_code = InR <$> showReason wr}
where
showReason = \case
NoReason -> Nothing
Reason flag -> showFlag flag
NoReason -> Nothing
Reason flag -> showFlag flag
ErrReason flag -> showFlag =<< flag
showFlag :: WarningFlag -> Maybe T.Text

84
ghcide/src/Development/IDE/Import/DependencyInformation.hs
View File

@ -28,31 +28,31 @@ module Development.IDE.Import.DependencyInformation
, insertBootId
) where
import Control.DeepSeq
import Data.Bifunctor
import Data.Coerce
import Data.List
import Data.Tuple.Extra hiding (first, second)
import Development.IDE.GHC.Orphans()
import Data.Either
import Data.Graph
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HMS
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.IntMap.Lazy as IntMapLazy
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Maybe
import GHC.Generics (Generic)
import Control.DeepSeq
import Data.Bifunctor
import Data.Coerce
import Data.Either
import Data.Graph
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HMS
import Data.IntMap (IntMap)
import qualified Data.IntMap.Lazy as IntMapLazy
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe
import Data.Tuple.Extra hiding (first, second)
import Development.IDE.GHC.Orphans ()
import GHC.Generics (Generic)
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import Development.IDE.Import.FindImports (ArtifactsLocation(..))
import Development.IDE.Import.FindImports (ArtifactsLocation (..))
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import GHC
import GHC
-- | The imports for a given module.
newtype ModuleImports = ModuleImports
@ -122,28 +122,28 @@ insertBootId k = IntMap.insert (getFilePathId k)
-- | Unprocessed results that we find by following imports recursively.
data RawDependencyInformation = RawDependencyInformation
{ rawImports :: !(FilePathIdMap (Either ModuleParseError ModuleImports))
{ rawImports :: !(FilePathIdMap (Either ModuleParseError ModuleImports))
, rawPathIdMap :: !PathIdMap
-- The rawBootMap maps the FilePathId of a hs-boot file to its
-- corresponding hs file. It is used when topologically sorting as we
-- need to add edges between .hs-boot and .hs so that the .hs files
-- appear later in the sort.
, rawBootMap :: !BootIdMap
, rawBootMap :: !BootIdMap
} deriving Show
data DependencyInformation =
DependencyInformation
{ depErrorNodes :: !(FilePathIdMap (NonEmpty NodeError))
{ depErrorNodes :: !(FilePathIdMap (NonEmpty NodeError))
-- ^ Nodes that cannot be processed correctly.
, depModuleNames :: !(FilePathIdMap ShowableModuleName)
, depModuleDeps :: !(FilePathIdMap FilePathIdSet)
, depModuleNames :: !(FilePathIdMap ShowableModuleName)
, depModuleDeps :: !(FilePathIdMap FilePathIdSet)
-- ^ For a non-error node, this contains the set of module immediate dependencies
-- in the same package.
, depReverseModuleDeps :: !(IntMap IntSet)
-- ^ Contains a reverse mapping from a module to all those that immediately depend on it.
, depPathIdMap :: !PathIdMap
, depPathIdMap :: !PathIdMap
-- ^ Map from FilePath to FilePathId
, depBootMap :: !BootIdMap
, depBootMap :: !BootIdMap
-- ^ Map from hs-boot file to the corresponding hs file
} deriving (Show, Generic)
@ -188,10 +188,10 @@ data NodeError
deriving (Show, Generic)
instance NFData NodeError where
rnf (PartOfCycle m fs) = m `seq` rnf fs
rnf (PartOfCycle m fs) = m `seq` rnf fs
rnf (FailedToLocateImport m) = m `seq` ()
rnf (ParseError e) = rnf e
rnf (ParentOfErrorNode m) = m `seq` ()
rnf (ParseError e) = rnf e
rnf (ParentOfErrorNode m) = m `seq` ()
-- | A processed node in the dependency graph. If there was any error
-- during processing the node or any of its dependencies, this is an
@ -205,14 +205,14 @@ partitionNodeResults
:: [(a, NodeResult)]
-> ([(a, NonEmpty NodeError)], [(a, [(Located ModuleName, FilePathId)])])
partitionNodeResults = partitionEithers . map f
where f (a, ErrorNode errs) = Left (a, errs)
where f (a, ErrorNode errs) = Left (a, errs)
f (a, SuccessNode imps) = Right (a, imps)
instance Semigroup NodeResult where
ErrorNode errs <> ErrorNode errs' = ErrorNode (errs <> errs')
ErrorNode errs <> SuccessNode _ = ErrorNode errs
SuccessNode _ <> ErrorNode errs = ErrorNode errs
SuccessNode a <> SuccessNode _ = SuccessNode a
ErrorNode errs <> SuccessNode _ = ErrorNode errs
SuccessNode _ <> ErrorNode errs = ErrorNode errs
SuccessNode a <> SuccessNode _ = SuccessNode a
processDependencyInformation :: RawDependencyInformation -> DependencyInformation
processDependencyInformation RawDependencyInformation{..} =
@ -267,11 +267,11 @@ buildResultGraph g = propagatedErrors
otherErrorsForFile :: Either ModuleParseError ModuleImports -> NodeResult
otherErrorsForFile (Left err) = ErrorNode (ParseError err :| [])
otherErrorsForFile (Right ModuleImports{moduleImports}) =
let toEither (imp, Nothing) = Left imp
let toEither (imp, Nothing) = Left imp
toEither (imp, Just path) = Right (imp, path)
(errs, imports') = partitionEithers (map toEither moduleImports)
in case nonEmpty errs of
Nothing -> SuccessNode imports'
Nothing -> SuccessNode imports'
Just errs' -> ErrorNode (NonEmpty.map FailedToLocateImport errs')
unpropagatedErrors = IntMap.unionWith (<>) cycleErrors otherErrors
@ -300,7 +300,7 @@ graphEdges :: FilePathIdMap (Either ModuleParseError ModuleImports) -> [(FilePat
graphEdges g =
map (\(k, v) -> (FilePathId k, FilePathId k, deps v)) $ IntMap.toList g
where deps :: Either e ModuleImports -> [FilePathId]
deps (Left _) = []
deps (Left _) = []
deps (Right ModuleImports{moduleImports}) = mapMaybe snd moduleImports
partitionSCC :: [SCC a] -> ([a], [[a]])
@ -361,8 +361,8 @@ newtype TransitiveDependencies = TransitiveDependencies
instance NFData TransitiveDependencies
data NamedModuleDep = NamedModuleDep {
nmdFilePath :: !NormalizedFilePath,
nmdModuleName :: !ModuleName,
nmdFilePath :: !NormalizedFilePath,
nmdModuleName :: !ModuleName,
nmdModLocation :: !(Maybe ModLocation)
}
deriving Generic

30
ghcide/src/Development/IDE/Import/FindImports.hs
View File

@ -14,26 +14,26 @@ module Development.IDE.Import.FindImports
, mkImportDirs
) where
import Development.IDE.GHC.Error as ErrUtils
import Development.IDE.GHC.Orphans()
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Error as ErrUtils
import Development.IDE.GHC.Orphans ()
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
-- GHC imports
import Control.DeepSeq
import FastString
import qualified Module as M
import Packages
import Outputable (showSDoc, ppr, pprPanic)
import Finder
import Control.DeepSeq
import qualified Module as M
import Outputable (ppr, pprPanic, showSDoc)
import Packages
-- standard imports
import Control.Monad.Extra
import Control.Monad.IO.Class
import Data.List (isSuffixOf)
import Data.Maybe
import DriverPhases
import System.FilePath
import DriverPhases
import Data.Maybe
import Data.List (isSuffixOf)
data Import
= FileImport !ArtifactsLocation
@ -55,13 +55,13 @@ isBootLocation = not . artifactIsSource
instance NFData Import where
rnf (FileImport x) = rnf x
rnf PackageImport = ()
rnf PackageImport = ()
modSummaryToArtifactsLocation :: NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation
modSummaryToArtifactsLocation nfp ms = ArtifactsLocation nfp (ms_location <$> ms) source
where
isSource HsSrcFile = True
isSource _ = False
isSource _ = False
source = case ms of
Nothing -> "-boot" `isSuffixOf` fromNormalizedFilePath nfp
Just ms -> isSource (ms_hsc_src ms)
@ -121,7 +121,7 @@ locateModule dflags comp_info exts doesExist modName mbPkgName isSource = do
-- each component will end up being found in the wrong place and cause a multi-cradle match failure.
mbFile <- locateModuleFile (importPaths dflags : map snd import_paths) exts doesExist isSource $ unLoc modName
case mbFile of
Nothing -> lookupInPackageDB dflags
Nothing -> lookupInPackageDB dflags
Just file -> toModLocation file
where
import_paths = mapMaybe (mkImportDirs dflags) comp_info

8
ghcide/src/Development/IDE/LSP/HoverDefinition.hs
View File

@ -1,7 +1,7 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
-- | Display information on hover.
module Development.IDE.LSP.HoverDefinition
@ -12,16 +12,16 @@ module Development.IDE.LSP.HoverDefinition
, gotoTypeDefinition
) where
import Control.Monad.IO.Class
import Control.Monad.IO.Class
import Development.IDE.Core.Rules
import Development.IDE.Core.Shake
import Development.IDE.LSP.Server
import Development.IDE.Types.Location
import Development.IDE.Types.Logger
import qualified Language.LSP.Server as LSP
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
import qualified Data.Text as T
import qualified Data.Text as T
gotoDefinition :: IdeState -> TextDocumentPositionParams -> LSP.LspM c (Either ResponseError (ResponseResult TextDocumentDefinition))
hover :: IdeState -> TextDocumentPositionParams -> LSP.LspM c (Either ResponseError (Maybe Hover))

66
ghcide/src/Development/IDE/LSP/LanguageServer.hs
View File

@ -1,10 +1,10 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
-- WARNING: A copy of DA.Daml.LanguageServer, try to keep them in sync
-- This version removes the daml: handling
@ -12,37 +12,39 @@ module Development.IDE.LSP.LanguageServer
( runLanguageServer
) where
import Language.LSP.Types
import Control.Concurrent.Extra (newBarrier,
signalBarrier,
waitBarrier)
import Control.Concurrent.STM
import Control.Monad.Extra
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Aeson (Value)
import Data.Maybe
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Development.IDE.GHC.Util as Ghcide
import Development.IDE.LSP.Server
import qualified Development.IDE.GHC.Util as Ghcide
import qualified Language.LSP.Server as LSP
import Control.Concurrent.Extra (newBarrier, signalBarrier, waitBarrier)
import Control.Concurrent.STM
import Data.Maybe
import Data.Aeson (Value)
import qualified Data.Set as Set
import qualified Data.Text as T
import GHC.IO.Handle (hDuplicate)
import System.IO
import Control.Monad.Extra
import UnliftIO.Exception
import UnliftIO.Async
import UnliftIO.Concurrent
import UnliftIO.Directory
import Control.Monad.IO.Class
import Control.Monad.Reader
import Ide.Types (traceWithSpan)
import Development.IDE.Session (runWithDb)
import Development.IDE.Session (runWithDb)
import GHC.IO.Handle (hDuplicate)
import Ide.Types (traceWithSpan)
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
import System.IO
import UnliftIO.Async
import UnliftIO.Concurrent
import UnliftIO.Directory
import UnliftIO.Exception
import Development.IDE.Core.IdeConfiguration
import Development.IDE.Core.Shake
import Development.IDE.LSP.HoverDefinition
import Development.IDE.LSP.Notifications
import Development.IDE.Types.Logger
import Development.IDE.Core.FileStore
import Development.IDE.Core.Tracing
import Development.IDE.Core.FileStore
import Development.IDE.Core.IdeConfiguration
import Development.IDE.Core.Shake
import Development.IDE.Core.Tracing
import Development.IDE.LSP.HoverDefinition
import Development.IDE.LSP.Notifications
import Development.IDE.Types.Logger
import System.IO.Unsafe (unsafeInterleaveIO)
import System.IO.Unsafe (unsafeInterleaveIO)
runLanguageServer
:: forall config. (Show config)

29
ghcide/src/Development/IDE/LSP/Notifications.hs
View File

@ -2,39 +2,42 @@
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
module Development.IDE.LSP.Notifications
( setHandlersNotifications
) where
import qualified Language.LSP.Server as LSP
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
import qualified Language.LSP.Types as LSP
import qualified Language.LSP.Types.Capabilities as LSP
import qualified Language.LSP.Types as LSP
import qualified Language.LSP.Types.Capabilities as LSP
import Development.IDE.Core.IdeConfiguration
import Development.IDE.Core.Service
import Development.IDE.LSP.Server
import Development.IDE.Core.Shake
import Development.IDE.LSP.Server
import Development.IDE.Types.Location
import Development.IDE.Types.Logger
import Development.IDE.Types.Options
import Control.Monad.Extra
import Data.Foldable as F
import Data.Foldable as F
import qualified Data.HashMap.Strict as M
import qualified Data.HashSet as S
import Data.Maybe
import qualified Data.HashMap.Strict as M
import qualified Data.HashSet as S
import qualified Data.Text as Text
import qualified Data.Text as Text
import Development.IDE.Core.FileStore (setSomethingModified, setFileModified, typecheckParents)
import Development.IDE.Core.FileExists (modifyFileExists, watchedGlobs)
import Control.Monad.IO.Class
import Development.IDE.Core.FileExists (modifyFileExists,
watchedGlobs)
import Development.IDE.Core.FileStore (setFileModified,
setSomethingModified,
typecheckParents)
import Development.IDE.Core.OfInterest
import Ide.Plugin.Config (CheckParents(CheckOnClose))
import Control.Monad.IO.Class
import Ide.Plugin.Config (CheckParents (CheckOnClose))
whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()

24
ghcide/src/Development/IDE/LSP/Outline.hs
View File

@ -1,8 +1,8 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
#include "ghc-api-version.h"
module Development.IDE.LSP.Outline
@ -10,25 +10,21 @@ module Development.IDE.LSP.Outline
)
where
import Language.LSP.Types
import Language.LSP.Server (LspM)
import Control.Monad.IO.Class
import Data.Functor
import Data.Generics
import Data.Maybe
import Data.Text ( Text
, pack
)
import qualified Data.Text as T
import Data.Text (Text, pack)
import qualified Data.Text as T
import Development.IDE.Core.Rules
import Development.IDE.Core.Shake
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Error ( realSrcSpanToRange )
import Development.IDE.GHC.Error (realSrcSpanToRange)
import Development.IDE.Types.Location
import Outputable ( Outputable
, ppr
, showSDocUnsafe
)
import Language.LSP.Server (LspM)
import Language.LSP.Types
import Outputable (Outputable, ppr,
showSDocUnsafe)
moduleOutline
:: IdeState -> DocumentSymbolParams -> LspM c (Either ResponseError (List DocumentSymbol |? List SymbolInformation))

26
ghcide/src/Development/IDE/LSP/Server.hs
View File

@ -1,12 +1,12 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
module Development.IDE.LSP.Server
( ReactorMessage(..)
, ReactorChan
@ -15,14 +15,14 @@ module Development.IDE.LSP.Server
, notificationHandler
) where
import Language.LSP.Server (LspM, Handlers)
import Language.LSP.Types
import qualified Language.LSP.Server as LSP
import Development.IDE.Core.Shake
import UnliftIO.Chan
import Control.Monad.Reader
import Ide.Types (HasTracing, traceWithSpan)
import Development.IDE.Core.Tracing
import Control.Monad.Reader
import Development.IDE.Core.Shake
import Development.IDE.Core.Tracing
import Ide.Types (HasTracing, traceWithSpan)
import Language.LSP.Server (Handlers, LspM)
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
import UnliftIO.Chan
data ReactorMessage
= ReactorNotification (IO ())

133
ghcide/src/Development/IDE/Main.hs
View File

@ -1,75 +1,66 @@
module Development.IDE.Main (Arguments(..), defaultMain) where
import Control.Concurrent.Extra (readVar)
import Control.Exception.Safe (
Exception (displayException),
catchAny,
)
import Control.Monad.Extra (concatMapM, unless, when)
import Data.Default (Default (def))
import qualified Data.HashMap.Strict as HashMap
import Data.List.Extra (
intercalate,
isPrefixOf,
nub,
nubOrd,
partition,
)
import Data.Maybe (catMaybes, fromMaybe, isJust)
import qualified Data.Text as T
import Development.IDE (Action, Rules, noLogging)
import Development.IDE.Core.Debouncer (newAsyncDebouncer)
import Development.IDE.Core.FileStore (makeVFSHandle)
import Development.IDE.Core.OfInterest (
FileOfInterestStatus (OnDisk),
kick,
setFilesOfInterest,
)
import Development.IDE.Core.RuleTypes (
GenerateCore (GenerateCore),
GetHieAst (GetHieAst),
GhcSession (GhcSession),
GhcSessionDeps (GhcSessionDeps),
TypeCheck (TypeCheck),
)
import Development.IDE.Core.Rules (
GhcSessionIO (GhcSessionIO),
mainRule,
)
import Development.IDE.Core.Service (initialise, runAction)
import Development.IDE.Core.Shake (
IdeState (shakeExtras),
ShakeExtras (state),
uses,
)
import Development.IDE.Core.Tracing (measureMemory)
import Development.IDE.LSP.LanguageServer (runLanguageServer)
import Development.IDE.Plugin (
Plugin (pluginHandlers, pluginRules),
)
import Development.IDE.Plugin.HLS (asGhcIdePlugin)
import Development.IDE.Session (SessionLoadingOptions, loadSessionWithOptions, setInitialDynFlags, getHieDbLoc, runWithDb)
import Development.IDE.Types.Location (toNormalizedFilePath')
import Development.IDE.Types.Logger (Logger)
import Development.IDE.Types.Options (
IdeGhcSession,
IdeOptions (optCheckParents, optCheckProject, optReportProgress),
clientSupportsProgress,
defaultIdeOptions,
)
import Development.IDE.Types.Shake (Key (Key))
import Development.Shake (action)
import HIE.Bios.Cradle (findCradle)
import Ide.Plugin.Config (CheckParents (NeverCheck), Config, getConfigFromNotification)
import Ide.PluginUtils (allLspCmdIds', getProcessID, pluginDescToIdePlugins)
import Ide.Types (IdePlugins)
import qualified Language.LSP.Server as LSP
import qualified System.Directory.Extra as IO
import System.Exit (ExitCode (ExitFailure), exitWith)
import System.FilePath (takeExtension, takeFileName)
import System.IO (hPutStrLn, hSetEncoding, stderr, stdout, utf8)
import System.Time.Extra (offsetTime, showDuration)
import Text.Printf (printf)
import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
import Control.Concurrent.Extra (readVar)
import Control.Exception.Safe (Exception (displayException),
catchAny)
import Control.Monad.Extra (concatMapM, unless, when)
import Data.Default (Default (def))
import qualified Data.HashMap.Strict as HashMap
import Data.List.Extra (intercalate, isPrefixOf,
nub, nubOrd, partition)
import Data.Maybe (catMaybes, fromMaybe,
isJust)
import qualified Data.Text as T
import Development.IDE (Action, Rules, noLogging)
import Development.IDE.Core.Debouncer (newAsyncDebouncer)
import Development.IDE.Core.FileStore (makeVFSHandle)
import Development.IDE.Core.OfInterest (FileOfInterestStatus (OnDisk),
kick, setFilesOfInterest)
import Development.IDE.Core.RuleTypes (GenerateCore (GenerateCore),
GetHieAst (GetHieAst),
GhcSession (GhcSession),
GhcSessionDeps (GhcSessionDeps),
TypeCheck (TypeCheck))
import Development.IDE.Core.Rules (GhcSessionIO (GhcSessionIO),
mainRule)
import Development.IDE.Core.Service (initialise, runAction)
import Development.IDE.Core.Shake (IdeState (shakeExtras),
ShakeExtras (state), uses)
import Development.IDE.Core.Tracing (measureMemory)
import Development.IDE.LSP.LanguageServer (runLanguageServer)
import Development.IDE.Plugin (Plugin (pluginHandlers, pluginRules))
import Development.IDE.Plugin.HLS (asGhcIdePlugin)
import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
import Development.IDE.Session (SessionLoadingOptions,
getHieDbLoc,
loadSessionWithOptions,
runWithDb,
setInitialDynFlags)
import Development.IDE.Types.Location (toNormalizedFilePath')
import Development.IDE.Types.Logger (Logger)
import Development.IDE.Types.Options (IdeGhcSession,
IdeOptions (optCheckParents, optCheckProject, optReportProgress),
clientSupportsProgress,
defaultIdeOptions)
import Development.IDE.Types.Shake (Key (Key))
import Development.Shake (action)
import HIE.Bios.Cradle (findCradle)
import Ide.Plugin.Config (CheckParents (NeverCheck),
Config,
getConfigFromNotification)
import Ide.PluginUtils (allLspCmdIds',
getProcessID,
pluginDescToIdePlugins)
import Ide.Types (IdePlugins)
import qualified Language.LSP.Server as LSP
import qualified System.Directory.Extra as IO
import System.Exit (ExitCode (ExitFailure),
exitWith)
import System.FilePath (takeExtension,
takeFileName)
import System.IO (hPutStrLn, hSetEncoding,
stderr, stdout, utf8)
import System.Time.Extra (offsetTime, showDuration)
import Text.Printf (printf)
data Arguments = Arguments
{ argsOTMemoryProfiling :: Bool

10
ghcide/src/Development/IDE/Plugin.hs
View File

@ -1,13 +1,13 @@
module Development.IDE.Plugin ( Plugin(..) ) where
import Data.Default
import Development.Shake
import Data.Default
import Development.Shake
import Development.IDE.LSP.Server
import qualified Language.LSP.Server as LSP
import Development.IDE.LSP.Server
import qualified Language.LSP.Server as LSP
data Plugin c = Plugin
{pluginRules :: Rules ()
{pluginRules :: Rules ()
,pluginHandlers :: LSP.Handlers (ServerM c)
}

155
ghcide/src/Development/IDE/Plugin/CodeAction.hs
View File

@ -1,10 +1,10 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
#include "ghc-api-version.h"
-- | Go to the definition of a variable.
@ -15,59 +15,68 @@ module Development.IDE.Plugin.CodeAction
, matchRegExMultipleImports
) where
import Control.Monad (join, guard)
import Control.Monad.IO.Class
import Development.IDE.GHC.Compat
import Development.IDE.Core.Rules
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service
import Development.IDE.Core.Shake
import Development.IDE.GHC.Error
import Development.IDE.GHC.ExactPrint
import Development.IDE.Plugin.CodeAction.ExactPrint
import Development.IDE.Plugin.CodeAction.PositionIndexed
import Development.IDE.Plugin.TypeLenses (suggestSignature)
import Development.IDE.Types.Exports
import Development.IDE.Types.HscEnvEq
import Development.IDE.Types.Location
import Development.IDE.Types.Options
import qualified Data.HashMap.Strict as Map
import qualified Language.LSP.Server as LSP
import Language.LSP.VFS
import Language.LSP.Types
import qualified Data.Rope.UTF16 as Rope
import Data.Char
import Data.Maybe
import Data.List.Extra
import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import Text.Regex.TDFA (mrAfter, (=~), (=~~))
import Outputable (Outputable, ppr, showSDoc, showSDocUnsafe)
import Data.Function
import Control.Arrow ((>>>), second)
import Data.Functor
import Control.Applicative ((<|>))
import Safe (atMay)
import Bag (isEmptyBag)
import qualified Data.HashSet as Set
import Control.Concurrent.Extra (readVar)
import Development.IDE.GHC.Util (printRdrName, prettyPrint)
import Ide.PluginUtils (subRange)
import Ide.Types
import qualified Data.DList as DL
import Development.IDE.Spans.Common
import OccName
import qualified GHC.LanguageExtensions as Lang
import Control.Lens (alaf)
import Data.Monoid (Ap(..))
import TcRnTypes (TcGblEnv(..), ImportAvails(..))
import HscTypes (ImportedModsVal(..), importedByUser)
import RdrName (GlobalRdrElt(..), lookupGlobalRdrEnv)
import SrcLoc (realSrcSpanStart)
import Module (moduleEnvElts)
import qualified Data.Map as M
import qualified Data.Set as S
import Bag (isEmptyBag)
import Control.Applicative ((<|>))
import Control.Arrow (second,
(>>>))
import Control.Concurrent.Extra (readVar)
import Control.Lens (alaf)
import Control.Monad (guard, join)
import Control.Monad.IO.Class
import Data.Char
import qualified Data.DList as DL
import Data.Function
import Data.Functor
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set
import Data.List.Extra
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid (Ap (..))
import qualified Data.Rope.UTF16 as Rope
import qualified Data.Set as S
import qualified Data.Text as T
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Rules
import Development.IDE.Core.Service
import Development.IDE.Core.Shake
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Error
import Development.IDE.GHC.ExactPrint
import Development.IDE.GHC.Util (prettyPrint,
printRdrName)
import Development.IDE.Plugin.CodeAction.ExactPrint
import Development.IDE.Plugin.CodeAction.PositionIndexed
import Development.IDE.Plugin.TypeLenses (suggestSignature)
import Development.IDE.Spans.Common
import Development.IDE.Types.Exports
import Development.IDE.Types.HscEnvEq
import Development.IDE.Types.Location
import Development.IDE.Types.Options
import qualified GHC.LanguageExtensions as Lang
import HscTypes (ImportedModsVal (..),
importedByUser)
import Ide.PluginUtils (subRange)
import Ide.Types
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
import Language.LSP.VFS
import Module (moduleEnvElts)
import OccName
import Outputable (Outputable,
ppr,
showSDoc,
showSDocUnsafe)
import RdrName (GlobalRdrElt (..),
lookupGlobalRdrEnv)
import Safe (atMay)
import SrcLoc (realSrcSpanStart)
import TcRnTypes (ImportAvails (..),
TcGblEnv (..))
import Text.Regex.TDFA (mrAfter,
(=~), (=~~))
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId =
@ -223,7 +232,7 @@ suggestHideShadow pm@(L _ HsModule {hsmodImports}) mTcM mHar Diagnostic {_messag
findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName decls modName = flip find decls $ \case
(L _ ImportDecl {..}) -> modName == moduleNameString (unLoc ideclName)
_ -> error "impossible"
_ -> error "impossible"
isTheSameLine :: SrcSpan -> SrcSpan -> Bool
isTheSameLine s1 s2
@ -364,7 +373,7 @@ suggestRemoveRedundantExport ParsedModule{pm_parsed_source = L _ HsModule{..}} D
matchExportItem msg = regexSingleMatch msg "The export item ‘([^’]+)’"
matchDupExport msg = regexSingleMatch msg "Duplicate ‘([^’]+)’ in export list"
getRanges exports txt = case smallerRangesForBindingExport exports (T.unpack txt) of
[] -> (txt, [_range])
[] -> (txt, [_range])
ranges -> (txt, ranges)
suggestRemoveRedundantExport _ _ = Nothing
@ -533,9 +542,9 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul
in loc >= Just l && loc <= Just r
printExport :: ExportsAs -> T.Text -> T.Text
printExport ExportName x = parenthesizeIfNeeds False x
printExport ExportName x = parenthesizeIfNeeds False x
printExport ExportPattern x = "pattern " <> x
printExport ExportAll x = parenthesizeIfNeeds True x <> "(..)"
printExport ExportAll x = parenthesizeIfNeeds True x <> "(..)"
isTopLevel :: Range -> Bool
isTopLevel l = (_character . _start) l == 0
@ -732,7 +741,7 @@ processHoleSuggestions mm = (holeSuggestions, refSuggestions)
return holeFit
mapHead f (a:aa) = f a : aa
mapHead _ [] = []
mapHead _ [] = []
-- > getIndentedGroups [" H1", " l1", " l2", " H2", " l3"] = [[" H1,", " l1", " l2"], [" H2", " l3"]]
getIndentedGroups :: [T.Text] -> [[T.Text]]
@ -760,7 +769,7 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_
= mod_srcspan >>= uncurry (suggestions hsmodImports binding)
| otherwise = []
where
unImportStyle (ImportTopLevel x) = (Nothing, T.unpack x)
unImportStyle (ImportTopLevel x) = (Nothing, T.unpack x)
unImportStyle (ImportViaParent x y) = (Just $ T.unpack y, T.unpack x)
suggestions decls binding mod srcspan
| range <- case [ x | (x,"") <- readSrcSpan (T.unpack srcspan)] of
@ -803,13 +812,13 @@ data ModuleTarget
deriving (Show)
targetImports :: ModuleTarget -> [LImportDecl GhcPs]
targetImports (ExistingImp ne) = NE.toList ne
targetImports (ExistingImp ne) = NE.toList ne
targetImports (ImplicitPrelude xs) = xs
oneAndOthers :: [a] -> [(a, [a])]
oneAndOthers = go
where
go [] = []
go [] = []
go (x : xs) = (x, xs) : map (second (x :)) (go xs)
isPreludeImplicit :: DynFlags -> Bool
@ -871,7 +880,7 @@ suggestImportDisambiguation df (Just txt) ps@(L _ HsModule {hsmodImports}) diag@
(targetImports modTarget)
|| case modTarget of
ImplicitPrelude{} -> True
_ -> False
_ -> False
]
]
| otherwise = []
@ -1157,10 +1166,10 @@ suggestNewImport packageExportsMap ParsedModule {pm_parsed_source = L _ HsModule
, Just insertLine <- case hsmodImports of
[] -> case srcSpanStart $ getLoc (head hsmodDecls) of
RealSrcLoc s -> Just $ srcLocLine s - 1
_ -> Nothing
_ -> Nothing
_ -> case srcSpanEnd $ getLoc (last hsmodImports) of
RealSrcLoc s -> Just $ srcLocLine s
_ -> Nothing
_ -> Nothing
, insertPos <- Position insertLine 0
, extendImportSuggestions <- matchRegexUnifySpaces msg
"Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’"
@ -1203,9 +1212,9 @@ data NotInScope
deriving Show
notInScope :: NotInScope -> T.Text
notInScope (NotInScopeDataConstructor t) = t
notInScope (NotInScopeDataConstructor t) = t
notInScope (NotInScopeTypeConstructorOrClass t) = t
notInScope (NotInScopeThing t) = t
notInScope (NotInScopeThing t) = t
extractNotInScopeName :: T.Text -> Maybe NotInScope
extractNotInScopeName x
@ -1352,7 +1361,7 @@ allMatchRegexUnifySpaces message =
matchRegex :: T.Text -> T.Text -> Maybe [T.Text]
matchRegex message regex = case message =~~ regex of
Just (_ :: T.Text, _ :: T.Text, _ :: T.Text, bindings) -> Just bindings
Nothing -> Nothing
Nothing -> Nothing
-- | Returns Just (all matches) for the first capture, or Nothing.
allMatchRegex :: T.Text -> T.Text -> Maybe [[T.Text]]
@ -1368,7 +1377,7 @@ unifySpaces = T.unwords . T.words
regexSingleMatch :: T.Text -> T.Text -> Maybe T.Text
regexSingleMatch msg regex = case matchRegexUnifySpaces msg regex of
Just (h:_) -> Just h
_ -> Nothing
_ -> Nothing
-- | Parses tuples like (‘Data.Map’, (app/ModuleB.hs:2:1-18)) and
-- | return (Data.Map, app/ModuleB.hs:2:1-18)
@ -1396,7 +1405,7 @@ matchRegExMultipleImports message = do
let pat = T.pack "Perhaps you want to add ‘([^’]*)’ to one of these import lists: *(‘.*\\))$"
(binding, imports) <- case matchRegexUnifySpaces message pat of
Just [x, xs] -> Just (x, xs)
_ -> Nothing
_ -> Nothing
imps <- regExImports imports
return (binding, imps)
@ -1439,6 +1448,6 @@ importStyles IdentInfo {parent, rendered, isDatacon}
= ImportTopLevel rendered :| []
renderImportStyle :: ImportStyle -> T.Text
renderImportStyle (ImportTopLevel x) = x
renderImportStyle (ImportTopLevel x) = x
renderImportStyle (ImportViaParent x p) = p <> "(" <> x <> ")"

76
ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs
View File

@ -1,7 +1,7 @@
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Development.IDE.Plugin.CodeAction.ExactPrint
( Rewrite (..),
@ -18,31 +18,37 @@ module Development.IDE.Plugin.CodeAction.ExactPrint
)
where
import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import Data.Char (isAlphaNum)
import Data.Data (Data)
import Data.Functor
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust, isNothing, mapMaybe)
import qualified Data.Text as T
import Development.IDE.GHC.Compat hiding (parseExpr)
import Development.IDE.GHC.ExactPrint
( Annotate, ASTElement(parseAST) )
import FieldLabel (flLabel)
import GhcPlugins (sigPrec, mkRealSrcLoc)
import Language.Haskell.GHC.ExactPrint
import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP), KeywordId (G), mkAnnKey)
import Language.LSP.Types
import OccName
import Outputable (ppr, showSDocUnsafe, showSDoc)
import Retrie.GHC (rdrNameOcc, unpackFS, mkRealSrcSpan, realSrcSpanEnd)
import Development.IDE.Spans.Common
import Development.IDE.GHC.Error
import Data.Generics (listify)
import GHC.Exts (IsList (fromList))
import Control.Monad.Extra (whenJust)
import Control.Applicative
import Control.Monad
import Control.Monad.Extra (whenJust)
import Control.Monad.Trans
import Data.Char (isAlphaNum)
import Data.Data (Data)
import Data.Functor
import Data.Generics (listify)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust, isNothing,
mapMaybe)
import qualified Data.Text as T
import Development.IDE.GHC.Compat hiding (parseExpr)
import Development.IDE.GHC.Error
import Development.IDE.GHC.ExactPrint (ASTElement (parseAST),
Annotate)
import Development.IDE.Spans.Common
import FieldLabel (flLabel)
import GHC.Exts (IsList (fromList))
import GhcPlugins (mkRealSrcLoc, sigPrec)
import Language.Haskell.GHC.ExactPrint
import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP),
KeywordId (G), mkAnnKey)
import Language.LSP.Types
import OccName
import Outputable (ppr, showSDoc,
showSDocUnsafe)
import Retrie.GHC (mkRealSrcSpan,
rdrNameOcc,
realSrcSpanEnd,
unpackFS)
------------------------------------------------------------------------------
@ -115,7 +121,7 @@ fixParens openDP closeDP ctxt@(L _ elems) = do
dropHsParTy :: LHsType pass -> LHsType pass
dropHsParTy (L _ (HsParTy _ ty)) = ty
dropHsParTy other = other
dropHsParTy other = other
-- | Append a constraint at the end of a type context.
-- If no context is present, a new one will be created.
@ -161,7 +167,7 @@ appendConstraint constraintT = go
liftParseAST :: ASTElement ast => DynFlags -> String -> TransformT (Either String) (Located ast)
liftParseAST df s = case parseAST df "" s of
Right (anns, x) -> modifyAnnsT (anns <>) $> x
Left _ -> lift $ Left $ "No parse: " <> s
Left _ -> lift $ Left $ "No parse: " <> s
lookupAnn :: (Data a, Monad m) => KeywordId -> Located a -> TransformT m (Maybe DeltaPos)
lookupAnn comment la = do
@ -172,16 +178,16 @@ dp00 :: DeltaPos
dp00 = DP (0, 0)
headMaybe :: [a] -> Maybe a
headMaybe [] = Nothing
headMaybe [] = Nothing
headMaybe (a : _) = Just a
lastMaybe :: [a] -> Maybe a
lastMaybe [] = Nothing
lastMaybe [] = Nothing
lastMaybe other = Just $ last other
liftMaybe :: String -> Maybe a -> TransformT (Either String) a
liftMaybe _ (Just x) = return x
liftMaybe s _ = lift $ Left s
liftMaybe s _ = lift $ Left s
-- | Copy anns attached to a into b with modification, then delete anns of a
transferAnn :: (Data a, Data b) => Located a -> Located b -> (Annotation -> Annotation) -> TransformT (Either String) ()
@ -198,7 +204,7 @@ extendImport mparent identifier lDecl@(L l _) =
Rewrite l $ \df -> do
case mparent of
Just parent -> extendImportViaParent df parent identifier lDecl
_ -> extendImportTopLevel df identifier lDecl
_ -> extendImportTopLevel df identifier lDecl
-- | Add an identifier to import list
--
@ -311,7 +317,7 @@ unIEWrappedName (occName -> occ) = showSDocUnsafe $ parenSymOcc occ (ppr occ)
hasParen :: String -> Bool
hasParen ('(' : _) = True
hasParen _ = False
hasParen _ = False
unqalDP :: Bool -> [(KeywordId, DeltaPos)]
unqalDP paren =

4
ghcide/src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs
View File

@ -126,7 +126,7 @@ extendToIncludePreviousNewlineIfPossible indexedString range
| Just (before, _, _) <- unconsRange range indexedString
, maybeFirstSpacePos <- lastSpacePos $ reverse before
= case maybeFirstSpacePos of
Nothing -> range
Nothing -> range
Just pos -> range { _start = pos }
| otherwise = range
where
@ -137,4 +137,4 @@ extendToIncludePreviousNewlineIfPossible indexedString range
then Nothing -- didn't find any space
else case xs of
(y:ys) | isSpace $ snd y -> lastSpacePos (y:ys)
_ -> Just pos
_ -> Just pos

16
ghcide/src/Development/IDE/Plugin/CodeAction/RuleTypes.hs
View File

@ -4,14 +4,14 @@ module Development.IDE.Plugin.CodeAction.RuleTypes
,IdentInfo(..)
) where
import Data.Hashable (Hashable)
import Control.DeepSeq (NFData)
import Data.Binary (Binary)
import Development.IDE.Types.HscEnvEq (HscEnvEq)
import Development.IDE.Types.Exports
import Development.Shake (RuleResult)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import Data.Binary (Binary)
import Data.Hashable (Hashable)
import Data.Typeable (Typeable)
import Development.IDE.Types.Exports
import Development.IDE.Types.HscEnvEq (HscEnvEq)
import Development.Shake (RuleResult)
import GHC.Generics (Generic)
-- Rule type for caching Package Exports
type instance RuleResult PackageExports = ExportsMap

105
ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
View File

@ -1,6 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs#-}
#include "ghc-api-version.h"
@ -13,52 +13,55 @@ module Development.IDE.Plugin.Completions.Logic (
, getCompletions
) where
import Control.Applicative
import Data.Char (isUpper)
import Data.Generics
import Data.List.Extra as List hiding (stripPrefix)
import qualified Data.Map as Map
import Control.Applicative
import Data.Char (isUpper)
import Data.Generics
import Data.List.Extra as List hiding
(stripPrefix)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, isJust, listToMaybe, mapMaybe)
import qualified Data.Text as T
import qualified Text.Fuzzy as Fuzzy
import Data.Maybe (fromMaybe, isJust,
listToMaybe,
mapMaybe)
import qualified Data.Text as T
import qualified Text.Fuzzy as Fuzzy
import HscTypes
import Name
import RdrName
import Type
import HscTypes
import Name
import RdrName
import Type
#if MIN_GHC_API_VERSION(8,10,0)
import Predicate (isDictTy)
import Pair
import Coercion
import Coercion
import Pair
import Predicate (isDictTy)
#endif
import Language.LSP.Types
import Language.LSP.Types.Capabilities
import qualified Language.LSP.VFS as VFS
import Development.IDE.Core.Compile
import Development.IDE.Core.PositionMapping
import Development.IDE.Plugin.Completions.Types
import Development.IDE.Spans.Documentation
import Development.IDE.Spans.LocalBindings
import Development.IDE.GHC.Compat as GHC
import Development.IDE.GHC.Error
import Development.IDE.Types.Options
import Development.IDE.Spans.Common
import Development.IDE.GHC.Util
import Outputable (Outputable)
import qualified Data.Set as Set
import ConLike
import GhcPlugins (
flLabel,
unpackFS)
import Data.Either (fromRight)
import Data.Aeson (ToJSON (toJSON))
import Data.Functor
import Ide.PluginUtils (mkLspCommand)
import Ide.Types (CommandId (..), PluginId, WithSnippets (..))
import Control.Monad
import Development.IDE.Types.HscEnvEq
import ConLike
import Control.Monad
import Data.Aeson (ToJSON (toJSON))
import Data.Either (fromRight)
import Data.Functor
import qualified Data.Set as Set
import Development.IDE.Core.Compile
import Development.IDE.Core.PositionMapping
import Development.IDE.GHC.Compat as GHC
import Development.IDE.GHC.Error
import Development.IDE.GHC.Util
import Development.IDE.Plugin.Completions.Types
import Development.IDE.Spans.Common
import Development.IDE.Spans.Documentation
import Development.IDE.Spans.LocalBindings
import Development.IDE.Types.HscEnvEq
import Development.IDE.Types.Options
import GhcPlugins (flLabel, unpackFS)
import Ide.PluginUtils (mkLspCommand)
import Ide.Types (CommandId (..),
PluginId,
WithSnippets (..))
import Language.LSP.Types
import Language.LSP.Types.Capabilities
import qualified Language.LSP.VFS as VFS
import Outputable (Outputable)
-- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs
@ -195,7 +198,7 @@ mkCompl
where kind = Just compKind
docs' = imported : spanDocToMarkdown docs
imported = case importedFrom of
Left pos -> "*Defined at '" <> ppr pos <> "'*\n'"
Left pos -> "*Defined at '" <> ppr pos <> "'*\n'"
Right mod -> "*Defined in '" <> mod <> "'*\n"
colon = if optNewColonConvention then ": " else ":: "
documentation = Just $ CompletionDocMarkup $
@ -215,7 +218,7 @@ mkNameCompItem doc thingParent origName origMod thingType isInfix docs !imp = CI
label = stripPrefix $ showGhc origName
insertText = case isInfix of
Nothing -> case getArgText <$> thingType of
Nothing -> label
Nothing -> label
Just argText -> label <> " " <> argText
Just LeftSide -> label <> "`"
@ -447,9 +450,9 @@ findRecordCompl uri pmod mn DataDecl {tcdLName, tcdDataDefn} = result
getFlds :: HsConDetails arg (Located [LConDeclField GhcPs]) -> Maybe [ConDeclField GhcPs]
getFlds conArg = case conArg of
RecCon rec -> Just $ unLoc <$> unLoc rec
RecCon rec -> Just $ unLoc <$> unLoc rec
PrefixCon _ -> Just []
_ -> Nothing
_ -> Nothing
extract ConDeclField{..}
-- TODO: Why is cd_fld_names a list?
@ -522,10 +525,10 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor
-- completions specific to the current context
ctxCompls' = case mcc of
Nothing -> compls
Just TypeContext -> filter isTypeCompl compls
Nothing -> compls
Just TypeContext -> filter isTypeCompl compls
Just ValueContext -> filter (not . isTypeCompl) compls
Just _ -> filter (not . isTypeCompl) compls
Just _ -> filter (not . isTypeCompl) compls
-- Add whether the text to insert has backticks
ctxCompls = map (\comp -> comp { isInfix = infixCompls }) ctxCompls'
@ -546,7 +549,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor
ty = ppr <$> typ
thisModName = case nameModule_maybe name of
Nothing -> Left $ nameSrcSpan name
Just m -> Right $ ppr m
Just m -> Right $ ppr m
compls = if T.null prefixModule
then localCompls ++ unqualCompls

48
ghcide/src/Development/IDE/Plugin/Completions/Types.hs
View File

@ -1,19 +1,19 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
module Development.IDE.Plugin.Completions.Types (
module Development.IDE.Plugin.Completions.Types
) where
import Control.DeepSeq
import qualified Data.Map as Map
import qualified Data.Text as T
import SrcLoc
import qualified Data.Map as Map
import qualified Data.Text as T
import SrcLoc
import Development.IDE.Spans.Common
import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import GHC.Generics (Generic)
import Language.LSP.Types (CompletionItemKind, Uri)
import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import Development.IDE.Spans.Common
import GHC.Generics (Generic)
import Language.LSP.Types (CompletionItemKind, Uri)
-- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs
@ -24,25 +24,25 @@ extendImportCommandId :: Text
extendImportCommandId = "extendImport"
data ExtendImport = ExtendImport
{ doc :: !Uri,
newThing :: !T.Text,
{ doc :: !Uri,
newThing :: !T.Text,
thingParent :: !(Maybe T.Text),
importName :: !T.Text,
importQual :: !(Maybe T.Text)
importName :: !T.Text,
importQual :: !(Maybe T.Text)
}
deriving (Eq, Show, Generic)
deriving anyclass (FromJSON, ToJSON)
data CompItem = CI
{ compKind :: CompletionItemKind
, insertText :: T.Text -- ^ Snippet for the completion
, importedFrom :: Either SrcSpan T.Text -- ^ From where this item is imported from.
, typeText :: Maybe T.Text -- ^ Available type information.
, label :: T.Text -- ^ Label to display to the user.
, isInfix :: Maybe Backtick -- ^ Did the completion happen
{ compKind :: CompletionItemKind
, insertText :: T.Text -- ^ Snippet for the completion
, importedFrom :: Either SrcSpan T.Text -- ^ From where this item is imported from.
, typeText :: Maybe T.Text -- ^ Available type information.
, label :: T.Text -- ^ Label to display to the user.
, isInfix :: Maybe Backtick -- ^ Did the completion happen
-- in the context of an infix notation.
, docs :: SpanDoc -- ^ Available documentation.
, isTypeCompl :: Bool
, docs :: SpanDoc -- ^ Available documentation.
, isTypeCompl :: Bool
, additionalTextEdits :: Maybe ExtendImport
}
deriving (Eq, Show)
@ -59,10 +59,10 @@ instance Monoid QualCompls where
-- | End result of the completions
data CachedCompletions = CC
{ allModNamesAsNS :: [T.Text] -- ^ All module names in scope.
{ allModNamesAsNS :: [T.Text] -- ^ All module names in scope.
-- Prelude is a single module
, unqualCompls :: [CompItem] -- ^ All Possible completion items
, qualCompls :: QualCompls -- ^ Completion items associated to
, unqualCompls :: [CompItem] -- ^ All Possible completion items
, qualCompls :: QualCompls -- ^ Completion items associated to
-- to a specific module name.
, importableModules :: [T.Text] -- ^ All modules that may be imported.
} deriving Show

58
ghcide/src/Development/IDE/Plugin/Test.hs
View File

@ -1,6 +1,6 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
-- | A plugin that adds custom messages for use in tests
module Development.IDE.Plugin.Test
( TestRequest(..)
@ -10,33 +10,33 @@ module Development.IDE.Plugin.Test
, blockCommandId
) where
import Control.Monad.STM
import Control.Monad.IO.Class
import Data.Aeson
import Data.Aeson.Types
import Data.CaseInsensitive (CI, original)
import Development.IDE.Core.Service
import Development.IDE.Core.Shake
import Development.IDE.GHC.Compat
import Development.IDE.Types.HscEnvEq (HscEnvEq(hscEnv))
import Development.IDE.Plugin
import Development.IDE.LSP.Server
import Development.IDE.Types.Action
import GHC.Generics (Generic)
import GhcPlugins (HscEnv(hsc_dflags))
import Language.LSP.Types
import System.Time.Extra
import Development.IDE.Core.RuleTypes
import Control.Monad
import Development.Shake (Action)
import Data.Maybe (isJust)
import Data.Bifunctor
import Data.Text (pack, Text)
import Data.String
import Development.IDE.Types.Location (fromUri)
import Control.Concurrent (threadDelay)
import Ide.Types
import qualified Language.LSP.Server as LSP
import Control.Concurrent (threadDelay)
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.STM
import Data.Aeson
import Data.Aeson.Types
import Data.Bifunctor
import Data.CaseInsensitive (CI, original)
import Data.Maybe (isJust)
import Data.String
import Data.Text (Text, pack)
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service
import Development.IDE.Core.Shake
import Development.IDE.GHC.Compat
import Development.IDE.LSP.Server
import Development.IDE.Plugin
import Development.IDE.Types.Action
import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))
import Development.IDE.Types.Location (fromUri)
import Development.Shake (Action)
import GHC.Generics (Generic)
import GhcPlugins (HscEnv (hsc_dflags))
import Ide.Types
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
import System.Time.Extra
data TestRequest
= BlockSeconds Seconds -- ^ :: Null

68
ghcide/src/Development/IDE/Plugin/TypeLenses.hs
View File

@ -6,44 +6,36 @@ module Development.IDE.Plugin.TypeLenses
)
where
import Control.Monad.IO.Class
import Data.Aeson.Types (Value (..), toJSON)
import qualified Data.HashMap.Strict as Map
import qualified Data.Text as T
import Development.IDE.Core.RuleTypes (TypeCheck (TypeCheck))
import Development.IDE.Core.Rules (IdeState, runAction)
import Development.IDE.Core.Service (getDiagnostics)
import Development.IDE.Core.Shake (getHiddenDiagnostics, use)
import Development.IDE.Types.Location
( Position (Position, _character, _line),
Range (Range, _end, _start),
toNormalizedFilePath',
uriToFilePath',
)
import Ide.PluginUtils (mkLspCommand)
import Ide.Types
( CommandFunction,
CommandId (CommandId),
PluginCommand (PluginCommand),
PluginDescriptor(..),
PluginId,
defaultPluginDescriptor,
mkPluginHandler
)
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
( ApplyWorkspaceEditParams (ApplyWorkspaceEditParams),
CodeLens (CodeLens),
CodeLensParams (CodeLensParams, _textDocument),
Diagnostic (..),
List (..),
ResponseError,
TextDocumentIdentifier (TextDocumentIdentifier),
TextEdit (TextEdit),
WorkspaceEdit (WorkspaceEdit),
SMethod(..)
)
import Text.Regex.TDFA ((=~))
import Control.Monad.IO.Class
import Data.Aeson.Types (Value (..), toJSON)
import qualified Data.HashMap.Strict as Map
import qualified Data.Text as T
import Development.IDE.Core.RuleTypes (TypeCheck (TypeCheck))
import Development.IDE.Core.Rules (IdeState, runAction)
import Development.IDE.Core.Service (getDiagnostics)
import Development.IDE.Core.Shake (getHiddenDiagnostics, use)
import Development.IDE.Types.Location (Position (Position, _character, _line),
Range (Range, _end, _start),
toNormalizedFilePath',
uriToFilePath')
import Ide.PluginUtils (mkLspCommand)
import Ide.Types (CommandFunction,
CommandId (CommandId),
PluginCommand (PluginCommand),
PluginDescriptor (..),
PluginId,
defaultPluginDescriptor,
mkPluginHandler)
import qualified Language.LSP.Server as LSP
import Language.LSP.Types (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams),
CodeLens (CodeLens),
CodeLensParams (CodeLensParams, _textDocument),
Diagnostic (..), List (..),
ResponseError, SMethod (..),
TextDocumentIdentifier (TextDocumentIdentifier),
TextEdit (TextEdit),
WorkspaceEdit (WorkspaceEdit))
import Text.Regex.TDFA ((=~))
typeLensCommandId :: T.Text
typeLensCommandId = "typesignature.add"

64
ghcide/src/Development/IDE/Spans/AtPoint.hs
View File

@ -1,8 +1,8 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE CPP #-}
#include "ghc-api-version.h"
-- | Gives information about symbols at a given point in DAML files.
@ -19,45 +19,45 @@ module Development.IDE.Spans.AtPoint (
, defRowToSymbolInfo
) where
import Development.IDE.GHC.Error
import Development.IDE.GHC.Orphans()
import Development.IDE.Types.Location
import Development.IDE.GHC.Error
import Development.IDE.GHC.Orphans ()
import Development.IDE.Types.Location
import Language.LSP.Types
-- compiler and infrastructure
import Development.IDE.GHC.Compat
import Development.IDE.Types.Options
import Development.IDE.Spans.Common
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes
import Development.IDE.GHC.Compat
import Development.IDE.Spans.Common
import Development.IDE.Types.Options
-- GHC API imports
import Name
import Outputable hiding ((<>))
import SrcLoc
import TyCoRep hiding (FunTy)
import TyCon
import FastString (unpackFS)
import IfaceType
import Name
import NameEnv
import Outputable hiding ((<>))
import SrcLoc
import TyCoRep hiding (FunTy)
import TyCon
import qualified Var
import NameEnv
import IfaceType
import FastString (unpackFS)
import Control.Applicative
import Control.Monad.Extra
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Control.Applicative
import Control.Monad.Extra
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Map.Strict as M
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Data.Array as A
import Data.Either
import Data.List.Extra (nubOrd, dropEnd1)
import Data.List (isSuffixOf)
import qualified Data.Array as A
import Data.Either
import Data.List (isSuffixOf)
import Data.List.Extra (dropEnd1, nubOrd)
import HieDb hiding (pointCommand)
import HieDb hiding (pointCommand)
-- | Gives a Uri for the module, given the .hie file location and the the module info
-- The Bool denotes if it is a boot module
@ -135,7 +135,7 @@ rowToLoc (row:.info) = flip Location range <$> mfile
start = Position (refSLine row - 1) (refSCol row -1)
end = Position (refELine row - 1) (refECol row -1)
mfile = case modInfoSrcFile info of
Just f -> Just $ toUri f
Just f -> Just $ toUri f
Nothing -> Nothing
typeRowToLoc :: Res TypeRef -> Maybe Location
@ -362,7 +362,7 @@ pointCommand :: HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand hf pos k =
catMaybes $ M.elems $ flip M.mapWithKey (getAsts hf) $ \fs ast ->
case selectSmallestContaining (sp fs) ast of
Nothing -> Nothing
Nothing -> Nothing
Just ast' -> Just $ k ast'
where
sloc fs = mkRealSrcLoc fs (line+1) (cha+1)

48
ghcide/src/Development/IDE/Spans/Common.hs
View File

@ -1,6 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
#include "ghc-api-version.h"
module Development.IDE.Spans.Common (
@ -18,25 +18,25 @@ module Development.IDE.Spans.Common (
, KindMap
) where
import Data.Maybe
import qualified Data.Text as T
import Data.List.Extra
import Control.DeepSeq
import GHC.Generics
import Control.DeepSeq
import Data.List.Extra
import Data.Maybe
import qualified Data.Text as T
import GHC.Generics
import GHC
import Outputable hiding ((<>))
import ConLike
import DataCon
import Var
import NameEnv
import DynFlags
import ConLike
import DataCon
import DynFlags
import GHC
import NameEnv
import Outputable hiding ((<>))
import Var
import Development.IDE.GHC.Orphans ()
import Development.IDE.GHC.Util
import qualified Documentation.Haddock.Parser as H
import qualified Documentation.Haddock.Types as H
import Development.IDE.GHC.Orphans ()
import Development.IDE.GHC.Util
import RdrName (rdrNameOcc)
import qualified Documentation.Haddock.Types as H
import RdrName (rdrNameOcc)
type DocMap = NameEnv SpanDoc
type KindMap = NameEnv TyThing
@ -174,19 +174,19 @@ haddockToMarkdown (H.DocProperty _)
= "" -- don't really know what to do
escapeBackticks :: String -> String
escapeBackticks "" = ""
escapeBackticks "" = ""
escapeBackticks ('`':ss) = '\\':'`':escapeBackticks ss
escapeBackticks (s :ss) = s:escapeBackticks ss
removeUnescapedBackticks :: String -> String
removeUnescapedBackticks = \case
'\\' : '`' : ss -> '\\' : '`' : removeUnescapedBackticks ss
'`' : ss -> removeUnescapedBackticks ss
"" -> ""
s : ss -> s : removeUnescapedBackticks ss
'`' : ss -> removeUnescapedBackticks ss
"" -> ""
s : ss -> s : removeUnescapedBackticks ss
splitForList :: String -> String
splitForList s
= case lines s of
[] -> ""
[] -> ""
(first:rest) -> unlines $ first : map ((" " ++) . trimStart) rest

34
ghcide/src/Development/IDE/Spans/Documentation.hs
View File

@ -2,7 +2,7 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP #-}
#include "ghc-api-version.h"
module Development.IDE.Spans.Documentation (
@ -14,32 +14,32 @@ module Development.IDE.Spans.Documentation (
) where
import Control.Monad
import Control.Monad.Extra (findM)
import Control.Monad.Extra (findM)
import Data.Either
import Data.Foldable
import Data.List.Extra
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Set as S
import qualified Data.Text as T
import Development.IDE.Core.Compile
import Development.IDE.Core.RuleTypes
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Error
import Development.IDE.Spans.Common
import Development.IDE.Core.RuleTypes
import System.Directory
import System.FilePath
import FastString
import SrcLoc (RealLocated)
import GhcMonad
import Packages
import Name
import Language.LSP.Types (getUri, filePathToUri)
import TcRnTypes
import ExtractDocs
import FastString
import GhcMonad
import HscTypes (HscEnv (hsc_dflags))
import Language.LSP.Types (filePathToUri, getUri)
import Name
import NameEnv
import HscTypes (HscEnv(hsc_dflags))
import Packages
import SrcLoc (RealLocated)
import TcRnTypes
mkDocMap
:: HscEnv
@ -77,11 +77,11 @@ getDocumentationsTryGhc :: HscEnv -> Module -> [Name] -> IO [SpanDoc]
getDocumentationsTryGhc env mod names = do
res <- catchSrcErrors (hsc_dflags env) "docs" $ getDocsBatch env mod names
case res of
Left _ -> return []
Left _ -> return []
Right res -> zipWithM unwrap res names
where
unwrap (Right (Just docs, _)) n = SpanDocString docs <$> getUris n
unwrap _ n = mkSpanDocText n
unwrap _ n = mkSpanDocText n
mkSpanDocText name =
SpanDocText [] <$> getUris name
@ -152,7 +152,7 @@ getDocumentation sources targetName = fromMaybe [] $ do
-- @FunBind@ (which covers functions and variables).
name_of_bind :: HsBind GhcPs -> Maybe (Located RdrName)
name_of_bind FunBind {fun_id} = Just fun_id
name_of_bind _ = Nothing
name_of_bind _ = Nothing
-- Get source spans from names, discard unhelpful spans, remove
-- duplicates and sort.
sortedNameSpans :: [Located RdrName] -> [RealSrcSpan]

2
ghcide/src/Development/IDE/Types/Action.hs
View File

@ -11,9 +11,9 @@ module Development.IDE.Types.Action
where
import Control.Concurrent.STM
import Data.Hashable (Hashable (..))
import Data.HashSet (HashSet)
import qualified Data.HashSet as Set
import Data.Hashable (Hashable (..))
import Data.Unique (Unique)
import Development.IDE.Types.Logger
import Development.Shake (Action)

31
ghcide/src/Development/IDE/Types/Diagnostics.hs
View File

@ -16,21 +16,20 @@ module Development.IDE.Types.Diagnostics (
showDiagnosticsColored,
) where
import Control.DeepSeq
import Data.Maybe as Maybe
import qualified Data.Text as T
import Data.Text.Prettyprint.Doc
import Language.LSP.Types as LSP (DiagnosticSource,
DiagnosticSeverity(..)
, Diagnostic(..)
, List(..)
)
import Language.LSP.Diagnostics
import Data.Text.Prettyprint.Doc.Render.Text
import Control.DeepSeq
import Data.Maybe as Maybe
import qualified Data.Text as T
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Render.Terminal (Color (..), color)
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Terminal
import Data.Text.Prettyprint.Doc.Render.Terminal (Color(..), color)
import Data.Text.Prettyprint.Doc.Render.Text
import Language.LSP.Diagnostics
import Language.LSP.Types as LSP (Diagnostic (..),
DiagnosticSeverity (..),
DiagnosticSource,
List (..))
import Development.IDE.Types.Location
import Development.IDE.Types.Location
-- | The result of an IDE operation. Warnings and errors are in the Diagnostic,
@ -114,10 +113,10 @@ prettyDiagnostic (fp, sh, LSP.Diagnostic{..}) =
, slabel_ "Severity:" $ pretty $ show sev
, slabel_ "Message: "
$ case sev of
LSP.DsError -> annotate $ color Red
LSP.DsError -> annotate $ color Red
LSP.DsWarning -> annotate $ color Yellow
LSP.DsInfo -> annotate $ color Blue
LSP.DsHint -> annotate $ color Magenta
LSP.DsInfo -> annotate $ color Blue
LSP.DsHint -> annotate $ color Magenta
$ stringParagraphs _message
]
where

42
ghcide/src/Development/IDE/Types/Exports.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
module Development.IDE.Types.Exports
(
@ -9,22 +9,22 @@ module Development.IDE.Types.Exports
createExportsMapTc
) where
import Avail (AvailInfo(..))
import Control.DeepSeq (NFData(..))
import Data.Text (pack, Text)
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Util
import Data.HashMap.Strict (HashMap)
import GHC.Generics (Generic)
import Name
import FieldLabel (flSelector)
import qualified Data.HashMap.Strict as Map
import GhcPlugins (IfaceExport, ModGuts(..))
import Data.HashSet (HashSet)
import qualified Data.HashSet as Set
import Data.Bifunctor (Bifunctor(second))
import Data.Hashable (Hashable)
import TcRnTypes(TcGblEnv(..))
import Avail (AvailInfo (..))
import Control.DeepSeq (NFData (..))
import Data.Bifunctor (Bifunctor (second))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as Map
import Data.HashSet (HashSet)
import qualified Data.HashSet as Set
import Data.Hashable (Hashable)
import Data.Text (Text, pack)
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Util
import FieldLabel (flSelector)
import GHC.Generics (Generic)
import GhcPlugins (IfaceExport, ModGuts (..))
import Name
import TcRnTypes (TcGblEnv (..))
newtype ExportsMap = ExportsMap
{getExportsMap :: HashMap IdentifierText (HashSet IdentInfo)}
@ -36,10 +36,10 @@ instance Semigroup ExportsMap where
type IdentifierText = Text
data IdentInfo = IdentInfo
{ name :: !Text
, rendered :: Text
, parent :: !(Maybe Text)
, isDatacon :: !Bool
{ name :: !Text
, rendered :: Text
, parent :: !(Maybe Text)
, isDatacon :: !Bool
, moduleNameText :: !Text
}
deriving (Generic, Show)

56
ghcide/src/Development/IDE/Types/HscEnvEq.hs
View File

@ -11,41 +11,47 @@ module Development.IDE.Types.HscEnvEq
) where
import Development.IDE.Types.Exports (ExportsMap, createExportsMap)
import Data.Unique
import Development.Shake.Classes
import Module (InstalledUnitId)
import System.Directory (canonicalizePath)
import Development.IDE.GHC.Compat
import GhcPlugins(HscEnv (hsc_dflags), PackageState (explicitPackages), InstalledPackageInfo (exposedModules), Module(..), packageConfigId, listVisibleModuleNames)
import System.FilePath
import Development.IDE.GHC.Util (lookupPackageConfig)
import Control.Monad.IO.Class
import TcRnMonad (initIfaceLoad, WhereFrom (ImportByUser))
import LoadIface (loadInterface)
import Control.Concurrent.Async (Async, async, waitCatch)
import Control.Concurrent.Extra (modifyVar, newVar)
import Control.DeepSeq (force)
import Control.Exception (evaluate, mask, throwIO)
import Control.Monad.Extra (eitherM, join, mapMaybeM)
import Control.Monad.IO.Class
import Data.Either (fromRight)
import Data.Unique
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Error (catchSrcErrors)
import Development.IDE.GHC.Util (lookupPackageConfig)
import Development.IDE.Types.Exports (ExportsMap, createExportsMap)
import Development.Shake.Classes
import GhcPlugins (HscEnv (hsc_dflags),
InstalledPackageInfo (exposedModules),
Module (..),
PackageState (explicitPackages),
listVisibleModuleNames,
packageConfigId)
import LoadIface (loadInterface)
import qualified Maybes
import OpenTelemetry.Eventlog (withSpan)
import Control.Monad.Extra (mapMaybeM, join, eitherM)
import Control.Concurrent.Extra (newVar, modifyVar)
import Control.Concurrent.Async (Async, async, waitCatch)
import Control.Exception (throwIO, mask, evaluate)
import Development.IDE.GHC.Error (catchSrcErrors)
import Control.DeepSeq (force)
import Data.Either (fromRight)
import Module (InstalledUnitId)
import OpenTelemetry.Eventlog (withSpan)
import System.Directory (canonicalizePath)
import System.FilePath
import TcRnMonad (WhereFrom (ImportByUser),
initIfaceLoad)
-- | An 'HscEnv' with equality. Two values are considered equal
-- if they are created with the same call to 'newHscEnvEq'.
data HscEnvEq = HscEnvEq
{ envUnique :: !Unique
, hscEnv :: !HscEnv
, deps :: [(InstalledUnitId, DynFlags)]
{ envUnique :: !Unique
, hscEnv :: !HscEnv
, deps :: [(InstalledUnitId, DynFlags)]
-- ^ In memory components for this HscEnv
-- This is only used at the moment for the import dirs in
-- the DynFlags
, envImportPaths :: Maybe [String]
, envImportPaths :: Maybe [String]
-- ^ If Just, import dirs originally configured in this env
-- If Nothing, the env import dirs are unaltered
, envPackageExports :: IO ExportsMap
, envPackageExports :: IO ExportsMap
, envVisibleModuleNames :: IO (Maybe [ModuleName])
-- ^ 'listVisibleModuleNames' is a pure function,
-- but it could panic due to a ghc bug: https://github.com/haskell/haskell-language-server/issues/1365

22
ghcide/src/Development/IDE/Types/KnownTargets.hs
View File

@ -1,17 +1,17 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# 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
import Control.DeepSeq
import Data.HashMap.Strict
import qualified Data.HashMap.Strict as HMap
import Data.HashSet
import qualified Data.HashSet as HSet
import Data.Hashable
import Development.IDE.GHC.Compat (ModuleName)
import Development.IDE.GHC.Orphans ()
import Development.IDE.Types.Location
import GHC.Generics
-- | A mapping of module name to known files
type KnownTargets = HashMap Target [NormalizedFilePath]

21
ghcide/src/Development/IDE/Types/Location.hs
View File

@ -25,16 +25,17 @@ module Development.IDE.Types.Location
, readSrcSpan
) where
import Control.Applicative
import Language.LSP.Types (Location(..), Range(..), Position(..))
import Control.Monad
import Data.Hashable (Hashable(hash))
import Data.String
import FastString
import qualified Language.LSP.Types as LSP
import SrcLoc as GHC
import Text.ParserCombinators.ReadP as ReadP
import Data.Maybe (fromMaybe)
import Control.Applicative
import Control.Monad
import Data.Hashable (Hashable (hash))
import Data.Maybe (fromMaybe)
import Data.String
import FastString
import Language.LSP.Types (Location (..), Position (..),
Range (..))
import qualified Language.LSP.Types as LSP
import SrcLoc as GHC
import Text.ParserCombinators.ReadP as ReadP
toNormalizedFilePath' :: FilePath -> LSP.NormalizedFilePath
-- We want to keep empty paths instead of normalising them to "."

55
ghcide/src/Development/IDE/Types/Options.hs
View File

@ -17,15 +17,16 @@ module Development.IDE.Types.Options
, OptHaddockParse(..)
,optShakeFiles) where
import Development.Shake
import Development.IDE.Types.HscEnvEq (HscEnvEq)
import GHC hiding (parseModule, typecheckModule)
import GhcPlugins as GHC hiding (fst3, (<>))
import qualified Language.LSP.Types.Capabilities as LSP
import qualified Data.Text as T
import Development.IDE.Types.Diagnostics
import Control.DeepSeq (NFData(..))
import Ide.Plugin.Config
import Control.DeepSeq (NFData (..))
import qualified Data.Text as T
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.HscEnvEq (HscEnvEq)
import Development.Shake
import GHC hiding (parseModule,
typecheckModule)
import GhcPlugins as GHC hiding (fst3, (<>))
import Ide.Plugin.Config
import qualified Language.LSP.Types.Capabilities as LSP
data IdeGhcSession = IdeGhcSession
{ loadSessionFun :: FilePath -> IO (IdeResult HscEnvEq, [FilePath])
@ -38,52 +39,52 @@ instance Show IdeGhcSession where show _ = "IdeGhcSession"
instance NFData IdeGhcSession where rnf !_ = ()
data IdeOptions = IdeOptions
{ optPreprocessor :: GHC.ParsedSource -> IdePreprocessedSource
{ optPreprocessor :: GHC.ParsedSource -> IdePreprocessedSource
-- ^ Preprocessor to run over all parsed source trees, generating a list of warnings
-- and a list of errors, along with a new parse tree.
, optGhcSession :: Action IdeGhcSession
, optGhcSession :: Action IdeGhcSession
-- ^ Setup a GHC session for a given file, e.g. @Foo.hs@.
-- For the same 'ComponentOptions' from hie-bios, the resulting function will be applied once per file.
-- It is desirable that many files get the same 'HscEnvEq', so that more IDE features work.
, optPkgLocationOpts :: IdePkgLocationOptions
, optPkgLocationOpts :: IdePkgLocationOptions
-- ^ How to locate source and @.hie@ files given a module name.
, optExtensions :: [String]
, optExtensions :: [String]
-- ^ File extensions to search for code, defaults to Haskell sources (including @.hs@)
, optShakeProfiling :: Maybe FilePath
, optShakeProfiling :: Maybe FilePath
-- ^ Set to 'Just' to create a directory of profiling reports.
, optOTMemoryProfiling :: IdeOTMemoryProfiling
, 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
, optTesting :: IdeTesting
-- ^ Whether to enable additional lsp messages used by the test suite for checking invariants
, optReportProgress :: IdeReportProgress
, optReportProgress :: IdeReportProgress
-- ^ Whether to report progress during long operations.
, optLanguageSyntax :: String
, optLanguageSyntax :: String
-- ^ the ```language to use
, optNewColonConvention :: Bool
-- ^ whether to use new colon convention
, optKeywords :: [T.Text]
, optKeywords :: [T.Text]
-- ^ keywords used for completions. These are customizable
-- since DAML has a different set of keywords than Haskell.
, optDefer :: IdeDefer
, optDefer :: IdeDefer
-- ^ Whether to defer type errors, typed holes and out of scope
-- variables. Deferral allows the IDE to continue to provide
-- features such as diagnostics and go-to-definition, in
-- situations in which they would become unavailable because of
-- the presence of type errors, holes or unbound variables.
, optCheckProject :: IO Bool
, optCheckProject :: IO Bool
-- ^ Whether to typecheck the entire project on load
, optCheckParents :: IO CheckParents
, optCheckParents :: IO CheckParents
-- ^ When to typecheck reverse dependencies of a file
, optHaddockParse :: OptHaddockParse
, optHaddockParse :: OptHaddockParse
-- ^ Whether to return result of parsing module with Opt_Haddock.
-- Otherwise, return the result of parsing without Opt_Haddock, so
-- that the parsed module contains the result of Opt_KeepRawTokenStream,
-- which might be necessary for hlint.
, optCustomDynFlags :: DynFlags -> DynFlags
, optCustomDynFlags :: DynFlags -> DynFlags
-- ^ Will be called right after setting up a new cradle,
-- allowing to customize the Ghc options used
, optShakeOptions :: ShakeOptions
, optShakeOptions :: ShakeOptions
}
optShakeFiles :: IdeOptions -> Maybe FilePath
@ -99,9 +100,9 @@ data OptHaddockParse = HaddockParse | NoHaddockParse
data IdePreprocessedSource = IdePreprocessedSource
{ preprocWarnings :: [(GHC.SrcSpan, String)]
-- ^ Warnings emitted by the preprocessor.
, preprocErrors :: [(GHC.SrcSpan, String)]
, preprocErrors :: [(GHC.SrcSpan, String)]
-- ^ Errors emitted by the preprocessor.
, preprocSource :: GHC.ParsedSource
, preprocSource :: GHC.ParsedSource
-- ^ New parse tree emitted by the preprocessor.
}

41
ghcide/src/Development/IDE/Types/Shake.hs
View File

@ -1,6 +1,6 @@
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeFamilies #-}
module Development.IDE.Types.Shake
( Q (..),
A (..),
@ -15,21 +15,22 @@ module Development.IDE.Types.Shake
toShakeValue,encodeShakeValue,decodeShakeValue)
where
import Control.DeepSeq
import Control.Exception
import qualified Data.ByteString.Char8 as BS
import Data.Dynamic
import Data.Hashable
import Data.HashMap.Strict
import Data.Vector (Vector)
import Data.Typeable
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import Development.Shake (RuleResult, ShakeException (shakeExceptionInner))
import Development.Shake.Classes
import GHC.Generics
import Language.LSP.Types
import Development.IDE.Core.PositionMapping
import Control.DeepSeq
import Control.Exception
import qualified Data.ByteString.Char8 as BS
import Data.Dynamic
import Data.HashMap.Strict
import Data.Hashable
import Data.Typeable
import Data.Vector (Vector)
import Development.IDE.Core.PositionMapping
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import Development.Shake (RuleResult,
ShakeException (shakeExceptionInner))
import Development.Shake.Classes
import GHC.Generics
import Language.LSP.Types
data Value v
= Succeeded TextDocumentVersion v
@ -43,8 +44,8 @@ instance NFData v => NFData (Value v)
-- up2date results not for stale values.
currentValue :: Value v -> Maybe v
currentValue (Succeeded _ v) = Just v
currentValue (Stale _ _ _) = Nothing
currentValue Failed{} = Nothing
currentValue (Stale _ _ _) = Nothing
currentValue Failed{} = Nothing
data ValueWithDiagnostics
= ValueWithDiagnostics !(Value Dynamic) !(Vector FileDiagnostic)
@ -122,7 +123,7 @@ encodeShakeValue :: ShakeValue -> BS.ByteString
encodeShakeValue = \case
ShakeNoCutoff -> BS.empty
ShakeResult r -> BS.cons 'r' r
ShakeStale r -> BS.cons 's' r
ShakeStale r -> BS.cons 's' r
decodeShakeValue :: BS.ByteString -> ShakeValue
decodeShakeValue bs = case BS.uncons bs of

172
ghcide/test/exe/Main.hs
View File

@ -2,86 +2,96 @@
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-deprecations -Wno-unticked-promoted-constructors #-}
#include "ghc-api-version.h"
module Main (main) where
import Control.Applicative.Combinators
import Control.Exception (bracket_, catch)
import qualified Control.Lens as Lens
import Control.Monad
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Aeson (toJSON,fromJSON)
import qualified Data.Aeson as A
import qualified Data.Binary as Binary
import Data.Default
import Data.Foldable
import Data.List.Extra
import Data.Maybe
import Data.Rope.UTF16 (Rope)
import qualified Data.Rope.UTF16 as Rope
import qualified Data.Set as Set
import Development.IDE.Core.PositionMapping (fromCurrent, toCurrent, PositionResult(..), positionResultToMaybe)
import Development.IDE.Core.Shake (Q(..))
import Development.IDE.GHC.Util
import qualified Data.Text as T
import Development.IDE.Plugin.Completions.Types (extendImportCommandId)
import Development.IDE.Plugin.TypeLenses (typeLensCommandId)
import Development.IDE.Spans.Common
import Development.IDE.Test
( canonicalizeUri,
diagnostic,
expectCurrentDiagnostics,
expectDiagnostics,
expectDiagnosticsWithTags,
expectNoMoreDiagnostics,
flushMessages,
standardizeQuotes,
waitForAction,
Cursor, expectMessages )
import Development.IDE.Test.Runfiles
import qualified Development.IDE.Types.Diagnostics as Diagnostics
import Development.IDE.Types.Location
import Development.Shake (getDirectoryFilesIO)
import Ide.Plugin.Config
import qualified Experiments as Bench
import Language.LSP.Test
import Language.LSP.Types hiding (mkRange)
import Language.LSP.Types.Capabilities
import qualified Language.LSP.Types.Lens as Lsp (diagnostics, params, message)
import Language.LSP.VFS (applyChange)
import Network.URI
import System.Environment.Blank (unsetEnv, getEnv, setEnv)
import System.FilePath
import System.IO.Extra hiding (withTempDir)
import Control.Applicative.Combinators
import Control.Exception (bracket_, catch)
import qualified Control.Lens as Lens
import Control.Monad
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Aeson (fromJSON, toJSON)
import qualified Data.Aeson as A
import qualified Data.Binary as Binary
import Data.Default
import Data.Foldable
import Data.List.Extra
import Data.Maybe
import Data.Rope.UTF16 (Rope)
import qualified Data.Rope.UTF16 as Rope
import qualified Data.Set as Set
import qualified Data.Text as T
import Development.IDE.Core.PositionMapping (PositionResult (..),
fromCurrent,
positionResultToMaybe,
toCurrent)
import Development.IDE.Core.Shake (Q (..))
import Development.IDE.GHC.Util
import Development.IDE.Plugin.Completions.Types (extendImportCommandId)
import Development.IDE.Plugin.TypeLenses (typeLensCommandId)
import Development.IDE.Spans.Common
import Development.IDE.Test (Cursor,
canonicalizeUri,
diagnostic,
expectCurrentDiagnostics,
expectDiagnostics,
expectDiagnosticsWithTags,
expectMessages,
expectNoMoreDiagnostics,
flushMessages,
standardizeQuotes,
waitForAction)
import Development.IDE.Test.Runfiles
import qualified Development.IDE.Types.Diagnostics as Diagnostics
import Development.IDE.Types.Location
import Development.Shake (getDirectoryFilesIO)
import qualified Experiments as Bench
import Ide.Plugin.Config
import Language.LSP.Test
import Language.LSP.Types hiding (mkRange)
import Language.LSP.Types.Capabilities
import qualified Language.LSP.Types.Lens as Lsp (diagnostics,
message,
params)
import Language.LSP.VFS (applyChange)
import Network.URI
import System.Directory
import System.Environment.Blank (getEnv, setEnv,
unsetEnv)
import System.Exit (ExitCode (ExitSuccess))
import System.FilePath
import System.IO.Extra hiding (withTempDir)
import qualified System.IO.Extra
import System.Directory
import System.Exit (ExitCode(ExitSuccess))
import System.Process.Extra (readCreateProcessWithExitCode, CreateProcess(cwd), proc)
import System.Info.Extra (isWindows)
import Test.QuickCheck
import System.Info.Extra (isWindows)
import System.Process.Extra (CreateProcess (cwd),
proc,
readCreateProcessWithExitCode)
import Test.QuickCheck
-- import Test.QuickCheck.Instances ()
import Test.Tasty
import Test.Tasty.ExpectedFailure
import Test.Tasty.Ingredients.Rerun
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import System.Time.Extra
import Development.IDE.Plugin.CodeAction (matchRegExMultipleImports)
import Development.IDE.Plugin.Test (TestRequest (BlockSeconds, GetInterfaceFilesDir), WaitForIdeRuleResult (..), blockCommandId)
import Control.Monad.Extra (whenJust)
import qualified Language.LSP.Types.Lens as L
import Control.Lens ((^.))
import Data.Tuple.Extra
import Control.Lens ((^.))
import Control.Monad.Extra (whenJust)
import Data.Tuple.Extra
import Development.IDE.Plugin.CodeAction (matchRegExMultipleImports)
import Development.IDE.Plugin.Test (TestRequest (BlockSeconds, GetInterfaceFilesDir),
WaitForIdeRuleResult (..),
blockCommandId)
import qualified Language.LSP.Types.Lens as L
import System.Time.Extra
import Test.Tasty
import Test.Tasty.ExpectedFailure
import Test.Tasty.HUnit
import Test.Tasty.Ingredients.Rerun
import Test.Tasty.QuickCheck
waitForProgressBegin :: Session ()
waitForProgressBegin = skipManyTill anyMessage $ satisfyMaybe $ \case
@ -2473,7 +2483,7 @@ addImplicitParamsConstraintTests =
]
]
where
mkContext "" = ""
mkContext "" = ""
mkContext contents = "(" <> contents <> ") => "
exampleCode bodyBase contextBase contextCaller =
@ -2858,7 +2868,7 @@ exportTemplate mRange initialContent expectedAction expectedContents = do
doc <- createDoc "A.hs" "haskell" initialContent
_ <- waitForDiagnostics
actions <- case mRange of
Nothing -> getAllCodeActions doc
Nothing -> getAllCodeActions doc
Just range -> getCodeActions doc range
case expectedContents of
Just content -> do
@ -3593,7 +3603,7 @@ completionCommandTest name src pos wanted expected = testSession name $ do
compls <- skipManyTill anyMessage (getCompletions docId pos)
let wantedC = find ( \case
CompletionItem {_insertText = Just x} -> wanted `T.isPrefixOf` x
_ -> False
_ -> False
) compls
case wantedC of
Nothing ->
@ -3622,7 +3632,7 @@ completionNoCommandTest name src pos wanted = testSession name $ do
compls <- getCompletions docId pos
let wantedC = find ( \case
CompletionItem {_insertText = Just x} -> wanted `T.isPrefixOf` x
_ -> False
_ -> False
) compls
case wantedC of
Nothing ->
@ -4402,7 +4412,7 @@ dependentFileTest = testGroup "addDependentFile"
cradleLoadedMessage :: Session FromServerMessage
cradleLoadedMessage = satisfy $ \case
FromServerMess (SCustomMethod m) (NotMess _) -> m == cradleLoadedMethod
_ -> False
_ -> False
cradleLoadedMethod :: T.Text
cradleLoadedMethod = "ghcide/cradle/loaded"
@ -4891,7 +4901,7 @@ getReferences' (file, l, c) includeDeclaration = do
doc <- openDoc file "haskell"
getReferences doc (Position l c) $ toBool includeDeclaration
where toBool YesIncludeDeclaration = True
toBool NoExcludeDeclaration = False
toBool NoExcludeDeclaration = False
referenceTestSession :: String -> FilePath -> [FilePath] -> (FilePath -> Session ()) -> TestTree
referenceTestSession name thisDoc docs' f = testSessionWithExtraFiles "references" name $ \dir -> do
@ -5034,7 +5044,7 @@ runInDir' dir startExeIn startSessionIn extraOptions s = do
checkEnv :: String -> IO (Maybe Bool)
checkEnv s = fmap convertVal <$> getEnv s
convertVal "0" = False
convertVal _ = True
convertVal _ = True
openTestDataDoc :: FilePath -> Session TextDocumentIdentifier
openTestDataDoc path = do
@ -5064,7 +5074,7 @@ findCodeActions' op errMsg doc range expectedTitles = do
++ show expectedTitles
liftIO $ case matches of
Nothing -> assertFailure msg
Just _ -> pure ()
Just _ -> pure ()
return (fromJust matches)
findCodeAction :: TextDocumentIdentifier -> Range -> T.Text -> Session CodeAction
@ -5295,4 +5305,4 @@ withTempDir f = System.IO.Extra.withTempDir $ \dir -> do
assertJust :: MonadIO m => String -> Maybe a -> m a
assertJust s = \case
Nothing -> liftIO $ assertFailure s
Just x -> pure x
Just x -> pure x

2
ghcide/test/manual/lhs/Main.hs
View File

@ -6,7 +6,7 @@ module Main
main
) where
import Test (main)
import Test (main)

2
ghcide/test/preprocessor/Main.hs
View File

@ -1,7 +1,7 @@
module Main(main) where
import System.Environment
import System.Environment
main :: IO ()
main = do

47
ghcide/test/src/Development/IDE/Test.hs
View File

@ -1,9 +1,9 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE PolyKinds #-}
module Development.IDE.Test
( Cursor
@ -22,23 +22,24 @@ module Development.IDE.Test
, waitForAction
) where
import qualified Data.Aeson as A
import Control.Applicative.Combinators
import Control.Lens hiding (List)
import Control.Monad
import Control.Monad.IO.Class
import Data.Bifunctor (second)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Language.LSP.Test hiding (message)
import qualified Language.LSP.Test as LspTest
import Language.LSP.Types
import Language.LSP.Types.Lens as Lsp
import System.Time.Extra
import Test.Tasty.HUnit
import System.Directory (canonicalizePath)
import Data.Maybe (fromJust)
import Development.IDE.Plugin.Test (WaitForIdeRuleResult, TestRequest(..))
import Control.Applicative.Combinators
import Control.Lens hiding (List)
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.Aeson as A
import Data.Bifunctor (second)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust)
import qualified Data.Text as T
import Development.IDE.Plugin.Test (TestRequest (..),
WaitForIdeRuleResult)
import Language.LSP.Test hiding (message)
import qualified Language.LSP.Test as LspTest
import Language.LSP.Types
import Language.LSP.Types.Lens as Lsp
import System.Directory (canonicalizePath)
import System.Time.Extra
import Test.Tasty.HUnit
-- | (0-based line number, 0-based column number)
type Cursor = (Int, Int)
@ -62,8 +63,8 @@ requireDiagnostic actuals expected@(severity, cursor, expectedMsg, expectedTag)
&& hasTag expectedTag (d ^. tags)
hasTag :: Maybe DiagnosticTag -> Maybe (List DiagnosticTag) -> Bool
hasTag Nothing _ = True
hasTag (Just _) Nothing = False
hasTag Nothing _ = True
hasTag (Just _) Nothing = False
hasTag (Just actualTag) (Just (List tags)) = actualTag `elem` tags
-- |wait for @timeout@ seconds and report an assertion failure
@ -186,7 +187,7 @@ standardizeQuotes msg = let
repl '‘' = '\''
repl '’' = '\''
repl '`' = '\''
repl c = c
repl c = c
in T.map repl msg
waitForAction :: String -> TextDocumentIdentifier -> Session (Either ResponseError WaitForIdeRuleResult)
@ -197,5 +198,5 @@ waitForAction key TextDocumentIdentifier{_uri} = do
return $ do
e <- _result
case A.fromJSON e of
A.Error e -> Left $ ResponseError InternalError (T.pack e) Nothing
A.Error e -> Left $ ResponseError InternalError (T.pack e) Nothing
A.Success a -> pure a

24
hls-plugin-api/src/Ide/Plugin/Config.hs
View File

@ -1,10 +1,10 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Ide.Plugin.Config
( getConfigFromNotification
, Config(..)
@ -14,13 +14,13 @@ module Ide.Plugin.Config
) where
import Control.Applicative
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import Data.Aeson hiding ( Error )
import Data.Aeson hiding (Error)
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import Data.Default
import qualified Data.Text as T
import qualified Data.Map as Map
import GHC.Generics (Generic)
import qualified Data.Map as Map
import qualified Data.Text as T
import GHC.Generics (Generic)
-- ---------------------------------------------------------------------

90
hls-plugin-api/src/Ide/Types.hs
View File

@ -1,54 +1,54 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Ide.Types
where
#ifdef mingw32_HOST_OS
import qualified System.Win32.Process as P (getCurrentProcessId)
import qualified System.Win32.Process as P (getCurrentProcessId)
#else
import qualified System.Posix.Process as P (getProcessID)
import System.Posix.Signals
import qualified System.Posix.Process as P (getProcessID)
#endif
import Data.Aeson hiding (defaultOptions)
import GHC.Generics
import qualified Data.Map as Map
import Data.String
import qualified Data.Text as T
import Development.Shake hiding (command)
import Ide.Plugin.Config
import Language.LSP.Types
import Language.LSP.VFS
import Language.LSP.Types.Lens as J hiding (id)
import Language.LSP.Types.Capabilities
import Language.LSP.Server (LspM, getVirtualFile)
import Text.Regex.TDFA.Text()
import Data.Dependent.Map (DMap)
import qualified Data.Dependent.Map as DMap
import Data.List.NonEmpty (NonEmpty(..), toList)
import Data.GADT.Compare
import Data.Maybe
import Data.Semigroup
import Control.Lens ((^.))
import qualified Data.DList as DList
import Control.Lens ((^.))
import Control.Monad
import Data.Aeson hiding (defaultOptions)
import qualified Data.DList as DList
import qualified Data.Default
import System.IO.Unsafe
import Control.Monad
import OpenTelemetry.Eventlog
import Data.Text.Encoding (encodeUtf8)
import Data.Dependent.Map (DMap)
import qualified Data.Dependent.Map as DMap
import Data.GADT.Compare
import Data.List.NonEmpty (NonEmpty (..), toList)
import qualified Data.Map as Map
import Data.Maybe
import Data.Semigroup
import Data.String
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Development.Shake hiding (command)
import GHC.Generics
import Ide.Plugin.Config
import Language.LSP.Server (LspM, getVirtualFile)
import Language.LSP.Types
import Language.LSP.Types.Capabilities
import Language.LSP.Types.Lens as J hiding (id)
import Language.LSP.VFS
import OpenTelemetry.Eventlog
import System.IO.Unsafe
import Text.Regex.TDFA.Text ()
-- ---------------------------------------------------------------------
@ -58,10 +58,10 @@ newtype IdePlugins ideState = IdePlugins
-- ---------------------------------------------------------------------
data PluginDescriptor ideState =
PluginDescriptor { pluginId :: !PluginId
, pluginRules :: !(Rules ())
, pluginCommands :: ![PluginCommand ideState]
, pluginHandlers :: PluginHandlers ideState
PluginDescriptor { pluginId :: !PluginId
, pluginRules :: !(Rules ())
, pluginCommands :: ![PluginCommand ideState]
, pluginHandlers :: PluginHandlers ideState
}
-- | Methods that can be handled by plugins.

2
install.hs
View File

@ -16,6 +16,6 @@ build-depends:
-- TODO: set `shake.project` in cabal-config above, when supported
-- (see https://github.com/haskell/cabal/issues/6353)
import HlsInstall (defaultMain)
import HlsInstall (defaultMain)
main = defaultMain

30
install/src/Cabal.hs
View File

@ -1,17 +1,17 @@
{-# LANGUAGE CPP #-}
module Cabal where
import Control.Monad
import Development.Shake
import Development.Shake.FilePath
import Control.Monad
import System.Directory ( copyFile )
import System.Info ( os )
import System.Directory (copyFile)
import System.Info (os)
import Version
import Print
import Env
import Print
import Version
#if RUN_FROM_STACK
import Control.Exception ( throwIO )
import Control.Exception (throwIO)
#else
import Cabal.Config
import Data.Functor.Identity
@ -131,16 +131,16 @@ requiredCabalVersionForWindows = [3, 0, 0, 0]
getVerbosityArg :: Verbosity -> String
getVerbosityArg v = "-v" ++ cabalVerbosity
where cabalVerbosity = case v of
Silent -> "0"
Silent -> "0"
#if MIN_VERSION_shake(0,18,4)
Error -> "0"
Warn -> "1"
Info -> "1"
Verbose -> "2"
Error -> "0"
Warn -> "1"
Info -> "1"
Verbose -> "2"
#else
Quiet -> "0"
Normal -> "1"
Loud -> "2"
Chatty -> "2"
Quiet -> "0"
Normal -> "1"
Loud -> "2"
Chatty -> "2"
#endif
Diagnostic -> "3"

39
install/src/Env.hs
View File

@ -1,34 +1,23 @@
module Env where
import Development.Shake
import Control.Monad.IO.Class
import Control.Monad
import Control.Monad.Extra (mapMaybeM)
import Control.Monad.IO.Class
import Data.Function (on, (&))
import Data.List (isInfixOf, sort, sortBy)
import Data.List.Extra (nubOrdBy, trim)
import Data.Maybe (isJust, mapMaybe)
import Data.Ord (comparing)
import Development.Shake
import Development.Shake.FilePath
import System.Info ( os )
import Data.Maybe ( isJust
, mapMaybe
)
import System.Directory ( findExecutable
, findExecutables
, listDirectory
)
import Data.Function ( (&)
, on
)
import Data.List ( sort
, sortBy
, isInfixOf
)
import Data.List.Extra ( nubOrdBy
, trim
)
import Data.Ord ( comparing )
import Control.Monad.Extra ( mapMaybeM )
import System.Directory (findExecutable, findExecutables,
listDirectory)
import System.Info (os)
import qualified Data.Text as T
import qualified Data.Text as T
import Version
import Print
import Version
type GhcPath = String
@ -86,7 +75,7 @@ getGhcPathOf :: MonadIO m => VersionNumber -> m (Maybe GhcPath)
getGhcPathOf ghcVersion =
liftIO $ findExecutable ("ghc-" ++ ghcVersion <.> exe) >>= \case
Nothing -> lookup ghcVersion <$> getGhcPaths
path -> return path
path -> return path
-- | Get a list of GHCs that are available in $PATH
getGhcPaths :: MonadIO m => m [(VersionNumber, GhcPath)]

4
install/src/Help.hs
View File

@ -1,13 +1,13 @@
-- |Module for Help messages and traget descriptions
module Help where
import Data.List (intercalate)
import Development.Shake
import Data.List ( intercalate )
import BuildSystem
import Env
import Print
import Version
import BuildSystem
stackCommand :: TargetDescription -> String
stackCommand target = "stack install.hs " ++ fst target ++ " [options]"

8
install/src/HlsInstall.hs
View File

@ -1,15 +1,15 @@
module HlsInstall where
import Development.Shake
import Control.Monad
import System.Environment ( unsetEnv )
import Development.Shake
import System.Environment (unsetEnv)
import BuildSystem
import Stack
import Cabal
import Version
import Env
import Help
import Stack
import Version
defaultMain :: IO ()
defaultMain = do

8
install/src/Print.hs
View File

@ -1,10 +1,10 @@
module Print where
import Development.Shake
import Control.Monad.IO.Class
import Data.List ( dropWhileEnd )
import Data.List.Extra ( trim )
import Data.Char ( isSpace )
import Data.Char (isSpace)
import Data.List (dropWhileEnd)
import Data.List.Extra (trim)
import Development.Shake
-- | lift putStrLn to MonadIO
printLine :: MonadIO m => String -> m ()

28
install/src/Stack.hs
View File

@ -1,15 +1,15 @@
{-# LANGUAGE CPP #-}
module Stack where
import Data.List.Extra ( trim )
import Control.Monad
import Data.List.Extra (trim)
import Development.Shake
import Development.Shake.FilePath
import Control.Monad
import System.Directory ( copyFile )
import System.Directory (copyFile)
-- import System.FilePath ( (</>) )
import System.Info ( os )
import Version
import Print
import System.Info (os)
import Version
stackInstallHlsWithErrMsg :: Maybe VersionNumber -> [String] -> Action ()
stackInstallHlsWithErrMsg mbVersionNumber args =
@ -123,17 +123,17 @@ stackBuildFailMsg =
getVerbosityArg :: Verbosity -> String
getVerbosityArg v = "--verbosity=" ++ stackVerbosity
where stackVerbosity = case v of
Silent -> "silent"
Silent -> "silent"
#if MIN_VERSION_shake(0,18,4)
Error -> "error"
Warn -> "warn"
Info -> "info"
Verbose -> "info"
Error -> "error"
Warn -> "warn"
Info -> "info"
Verbose -> "info"
#else
Quiet -> "error"
Normal -> "warn"
Loud -> "info"
Chatty -> "info"
Quiet -> "error"
Normal -> "warn"
Loud -> "info"
Chatty -> "info"
#endif
Diagnostic -> "debug"

9
install/src/Version.hs
View File

@ -1,11 +1,8 @@
module Version where
import Data.Version ( Version
, parseVersion
, makeVersion
, showVersion
)
import Text.ParserCombinators.ReadP ( readP_to_S )
import Data.Version (Version, makeVersion,
parseVersion, showVersion)
import Text.ParserCombinators.ReadP (readP_to_S)
type VersionNumber = String

2
nix/default.nix
View File

@ -54,7 +54,7 @@ in (import sources.nixpkgs
# default_stages = ["manual" "push"];
hooks = {
stylish-haskell.enable = true;
stylish-haskell.excludes = [ "test/testdata/.*" "hie-compat/.*" ];
stylish-haskell.excludes = [ "^Setup.hs$" "test/testdata/.*$" "test/data/.*$" "^hie-compat/.*$" ];
};
};
}

36
plugins/default/src/Ide/Plugin/Brittany.hs
View File

@ -1,28 +1,28 @@
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
module Ide.Plugin.Brittany where
import Control.Exception (bracket_)
import Control.Exception (bracket_)
import Control.Lens
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
import Data.Coerce
import Data.Maybe (mapMaybe, maybeToList)
import Data.Maybe (mapMaybe, maybeToList)
import Data.Semigroup
import Data.Text (Text)
import qualified Data.Text as T
import Development.IDE hiding (pluginHandlers)
import Development.IDE.GHC.Compat (topDir, ModSummary(ms_hspp_opts))
import qualified DynFlags as D
import qualified EnumSet as S
import Data.Text (Text)
import qualified Data.Text as T
import Development.IDE hiding (pluginHandlers)
import Development.IDE.GHC.Compat (ModSummary (ms_hspp_opts), topDir)
import qualified DynFlags as D
import qualified EnumSet as S
import GHC.LanguageExtensions.Type
import Language.Haskell.Brittany
import Language.LSP.Types as J
import qualified Language.LSP.Types.Lens as J
import Ide.PluginUtils
import Ide.Types
import Language.Haskell.Brittany
import Language.LSP.Types as J
import qualified Language.LSP.Types.Lens as J
import System.Environment (setEnv, unsetEnv)
import System.FilePath
import System.Environment (setEnv, unsetEnv)
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId = (defaultPluginDescriptor plId)
@ -108,11 +108,11 @@ showErr (ErrorUnknownNode s _) = s
showErr ErrorOutputCheck = "Brittany error - invalid output"
showExtension :: Extension -> Maybe String
showExtension Cpp = Just "-XCPP"
showExtension Cpp = Just "-XCPP"
-- Brittany chokes on parsing extensions that produce warnings
showExtension DatatypeContexts = Nothing
showExtension RecordPuns = Just "-XNamedFieldPuns"
showExtension other = Just $ "-X" ++ show other
showExtension RecordPuns = Just "-XNamedFieldPuns"
showExtension other = Just $ "-X" ++ show other
getExtensions :: D.DynFlags -> [String]
getExtensions = mapMaybe showExtension . S.toList . D.extensionFlags

61
plugins/default/src/Ide/Plugin/Example.hs
View File

@ -1,39 +1,40 @@
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Ide.Plugin.Example
(
descriptor
) where
import Control.DeepSeq ( NFData )
import Control.Monad.Trans.Maybe
import Data.Aeson
import Data.Binary
import Data.Functor
import qualified Data.HashMap.Strict as Map
import Data.Hashable
import qualified Data.Text as T
import Data.Typeable
import Development.IDE as D
import Development.IDE.GHC.Compat (ParsedModule(ParsedModule))
import Development.IDE.Core.Rules (useE)
import Development.IDE.Core.Shake (getDiagnostics, getHiddenDiagnostics)
import GHC.Generics
import Ide.PluginUtils
import Ide.Types
import Language.LSP.Types
import Language.LSP.Server
import Text.Regex.TDFA.Text()
import Control.Monad.IO.Class
import Control.DeepSeq (NFData)
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe
import Data.Aeson
import Data.Binary
import Data.Functor
import qualified Data.HashMap.Strict as Map
import Data.Hashable
import qualified Data.Text as T
import Data.Typeable
import Development.IDE as D
import Development.IDE.Core.Rules (useE)
import Development.IDE.Core.Shake (getDiagnostics,
getHiddenDiagnostics)
import Development.IDE.GHC.Compat (ParsedModule (ParsedModule))
import GHC.Generics
import Ide.PluginUtils
import Ide.Types
import Language.LSP.Server
import Language.LSP.Types
import Text.Regex.TDFA.Text ()
-- ---------------------------------------------------------------------
@ -138,7 +139,7 @@ codeLens ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri}
-- ---------------------------------------------------------------------
-- | Parameters for the addTodo PluginCommand.
data AddTodoParams = AddTodoParams
{ file :: Uri -- ^ Uri of the file to add the pragma to
{ file :: Uri -- ^ Uri of the file to add the pragma to
, todoText :: T.Text
}
deriving (Show, Eq, Generic, ToJSON, FromJSON)

14
plugins/default/src/Ide/Plugin/Floskell.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ide.Plugin.Floskell
@ -8,16 +8,16 @@ module Ide.Plugin.Floskell
)
where
import qualified Data.ByteString.Lazy as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Development.IDE as D hiding (pluginHandlers)
import Control.Monad.IO.Class
import qualified Data.ByteString.Lazy as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Development.IDE as D hiding (pluginHandlers)
import Floskell
import Ide.PluginUtils
import Ide.Types
import Language.LSP.Types
import Text.Regex.TDFA.Text()
import Control.Monad.IO.Class
import Text.Regex.TDFA.Text ()
-- ---------------------------------------------------------------------

46
plugins/default/src/Ide/Plugin/Fourmolu.hs
View File

@ -1,34 +1,34 @@
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeApplications #-}
module Ide.Plugin.Fourmolu (
descriptor,
provider,
) where
import Control.Exception
import Data.Either.Extra
import System.FilePath
import Control.Exception
import Data.Either.Extra
import System.FilePath
import Control.Lens ((^.))
import qualified Data.Text as T
import Development.IDE as D hiding (pluginHandlers)
import qualified DynFlags as D
import qualified EnumSet as S
import GHC (DynFlags, moduleNameString)
import GHC.LanguageExtensions.Type (Extension (Cpp))
import GhcPlugins (HscEnv (hsc_dflags))
import Ide.PluginUtils (makeDiffTextEdit)
import Control.Lens ((^.))
import qualified Data.Text as T
import Development.IDE as D hiding (pluginHandlers)
import qualified DynFlags as D
import qualified EnumSet as S
import GHC (DynFlags, moduleNameString)
import GHC.LanguageExtensions.Type (Extension (Cpp))
import GhcPlugins (HscEnv (hsc_dflags))
import Ide.PluginUtils (makeDiffTextEdit)
import Ide.Types
import Language.LSP.Server
import Language.LSP.Types
import Language.LSP.Types.Lens
import "fourmolu" Ormolu
import Control.Monad.IO.Class
import Control.Monad.IO.Class
import Ide.Types
import Language.LSP.Server
import Language.LSP.Types
import Language.LSP.Types.Lens
import "fourmolu" Ormolu
-- ---------------------------------------------------------------------
@ -99,5 +99,5 @@ convertDynFlags df =
ex = map showExtension $ S.toList $ D.extensionFlags df
showExtension = \case
Cpp -> "-XCPP"
x -> "-X" ++ show x
x -> "-X" ++ show x
in return $ map DynOption $ pp <> pm <> ex

91
plugins/default/src/Ide/Plugin/ModuleName.hs
View File

@ -1,7 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall -Wwarn -fno-warn-type-defaults -fno-warn-unused-binds -fno-warn-unused-imports -Wno-unticked-promoted-constructors #-}
{- | Keep the module name in sync with its file path.
@ -14,60 +14,39 @@ module Ide.Plugin.ModuleName (
descriptor,
) where
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad
import Data.Aeson (
ToJSON (toJSON),
Value (Null),
)
import Data.Char (isLower)
import qualified Data.HashMap.Strict as Map
import Data.List (find, intercalate, isPrefixOf)
import Data.Maybe (maybeToList)
import Data.String (IsString)
import Data.Text (Text, pack)
import qualified Data.Text as T
import Control.Monad
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Aeson (ToJSON (toJSON), Value (Null))
import Data.Char (isLower)
import qualified Data.HashMap.Strict as Map
import Data.List (find, intercalate, isPrefixOf)
import Data.Maybe (maybeToList)
import Data.String (IsString)
import Data.Text (Text, pack)
import qualified Data.Text as T
-- import Debug.Trace (trace)
import Development.IDE (
GetParsedModule (
GetParsedModule
),
GhcSession (GhcSession),
HscEnvEq,
IdeState,
List (..),
NormalizedFilePath,
Position (Position),
Range (Range),
evalGhcEnv,
hscEnvWithImportPaths,
realSrcSpanToRange,
runAction,
toNormalizedUri,
uriToFilePath',
use,
use_,
)
import GHC (
DynFlags (importPaths),
GenLocated (L),
HsModule (hsmodName),
ParsedModule (pm_parsed_source),
SrcSpan (RealSrcSpan),
getSessionDynFlags,
unLoc,
)
import Ide.PluginUtils (mkLspCmdId, getProcessID)
import Ide.Types
import Language.LSP.Server
import Language.LSP.Types
import Language.LSP.VFS (virtualFileText)
import System.Directory (canonicalizePath)
import System.FilePath (
dropExtension,
splitDirectories,
takeFileName,
)
import Development.IDE (GetParsedModule (GetParsedModule),
GhcSession (GhcSession), HscEnvEq,
IdeState, List (..),
NormalizedFilePath,
Position (Position), Range (Range),
evalGhcEnv, hscEnvWithImportPaths,
realSrcSpanToRange, runAction,
toNormalizedUri, uriToFilePath', use,
use_)
import GHC (DynFlags (importPaths), GenLocated (L),
HsModule (hsmodName),
ParsedModule (pm_parsed_source),
SrcSpan (RealSrcSpan),
getSessionDynFlags, unLoc)
import Ide.PluginUtils (getProcessID, mkLspCmdId)
import Ide.Types
import Language.LSP.Server
import Language.LSP.Types
import Language.LSP.VFS (virtualFileText)
import System.Directory (canonicalizePath)
import System.FilePath (dropExtension, splitDirectories,
takeFileName)
-- |Plugin descriptor
descriptor :: PluginId -> PluginDescriptor IdeState

18
plugins/default/src/Ide/Plugin/Ormolu.hs
View File

@ -11,21 +11,21 @@ module Ide.Plugin.Ormolu
where
import Control.Exception
import qualified Data.Text as T
import Development.IDE hiding (pluginHandlers)
import qualified DynFlags as D
import qualified EnumSet as S
import Control.Monad.IO.Class
import qualified Data.Text as T
import Development.IDE hiding (pluginHandlers)
import qualified DynFlags as D
import qualified EnumSet as S
import GHC
import GHC.LanguageExtensions.Type
import GhcPlugins (HscEnv (hsc_dflags))
import GhcPlugins (HscEnv (hsc_dflags))
import Ide.PluginUtils
import Ide.Types
import Language.LSP.Server
import Language.LSP.Types
import "ormolu" Ormolu
import System.FilePath (takeFileName)
import Text.Regex.TDFA.Text ()
import Control.Monad.IO.Class
import "ormolu" Ormolu
import System.FilePath (takeFileName)
import Text.Regex.TDFA.Text ()
-- ---------------------------------------------------------------------

2
plugins/default/src/Ide/Plugin/StylishHaskell.hs
View File

@ -18,7 +18,7 @@ import GHC.LanguageExtensions.Type
import Ide.PluginUtils
import Ide.Types
import Language.Haskell.Stylish
import Language.LSP.Types as J
import Language.LSP.Types as J
import System.Directory
import System.FilePath

30
plugins/hls-class-plugin/src/Ide/Plugin/Class.hs
View File

@ -12,30 +12,32 @@ import BooleanFormula
import Class
import ConLike
import Control.Applicative
import Control.Lens hiding (List, use)
import Control.Lens hiding (List, use)
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import Data.Aeson
import Data.Char
import Data.List
import qualified Data.Map.Strict as Map
import qualified Data.Map.Strict as Map
import Data.Maybe
import qualified Data.Text as T
import Development.IDE hiding (pluginHandlers)
import Development.IDE.Core.PositionMapping (fromCurrentRange, toCurrentRange)
import Development.IDE.GHC.Compat hiding (getLoc)
import qualified Data.Text as T
import Development.IDE hiding (pluginHandlers)
import Development.IDE.Core.PositionMapping (fromCurrentRange,
toCurrentRange)
import Development.IDE.GHC.Compat hiding (getLoc)
import Development.IDE.Spans.AtPoint
import qualified GHC.Generics as Generics
import GhcPlugins hiding (Var, getLoc, (<>))
import qualified GHC.Generics as Generics
import GhcPlugins hiding (Var, getLoc,
(<>))
import Ide.PluginUtils
import Ide.Types
import Language.Haskell.GHC.ExactPrint
import Language.Haskell.GHC.ExactPrint.Parsers (parseDecl)
import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs, Parens)
import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs, Parens)
import Language.LSP.Server
import Language.LSP.Types
import qualified Language.LSP.Types.Lens as J
import qualified Language.LSP.Types.Lens as J
import SrcLoc
import TcEnv
import TcRnMonad
@ -87,7 +89,7 @@ addMethodPlaceholders state AddMinimalMethodsParams{..} = do
makeMethodDecl df mName =
case parseDecl df (T.unpack mName) . T.unpack $ toMethodName mName <> " = _" of
Right (ann, d) -> Just (setPrecedingLines d 1 indent ann, d)
Left _ -> Nothing
Left _ -> Nothing
addMethodDecls :: ParsedSource -> [LHsDecl GhcPs] -> Transform (Located (HsModule GhcPs))
addMethodDecls ps mDecls = do
@ -203,7 +205,7 @@ isClassMethodWarning = T.isPrefixOf "• No explicit implementation for"
minDefToMethodGroups :: BooleanFormula Name -> [[T.Text]]
minDefToMethodGroups = go
where
go (Var mn) = [[T.pack . occNameString . occName $ mn]]
go (Or ms) = concatMap (go . unLoc) ms
go (And ms) = foldr (liftA2 (<>)) [[]] (fmap (go . unLoc) ms)
go (Var mn) = [[T.pack . occNameString . occName $ mn]]
go (Or ms) = concatMap (go . unLoc) ms
go (And ms) = foldr (liftA2 (<>)) [[]] (fmap (go . unLoc) ms)
go (Parens m) = go (unLoc m)

42
plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs
View File

@ -4,27 +4,23 @@
-- | Expression execution
module Ide.Plugin.Eval.Code (Statement, testRanges, resultRange, evalExtensions, evalSetup, evalExpr, propSetup, testCheck, asStatements) where
import Data.Algorithm.Diff (Diff, PolyDiff (..), getDiff)
import qualified Data.List.NonEmpty as NE
import Data.String (IsString)
import qualified Data.Text as T
import Development.IDE.Types.Location (Position (..), Range (..))
import GHC (compileExpr)
import GHC.LanguageExtensions.Type (Extension (..))
import GhcMonad (Ghc, GhcMonad, liftIO)
import Ide.Plugin.Eval.Types (
Language (Plain),
Loc,
Section (sectionLanguage),
Test (..),
Txt,
locate,
locate0, Located(..)
)
import InteractiveEval (runDecls)
import Unsafe.Coerce (unsafeCoerce)
import Control.Lens ((^.))
import Language.LSP.Types.Lens (start, line)
import Control.Lens ((^.))
import Data.Algorithm.Diff (Diff, PolyDiff (..), getDiff)
import qualified Data.List.NonEmpty as NE
import Data.String (IsString)
import qualified Data.Text as T
import Development.IDE.Types.Location (Position (..), Range (..))
import GHC (compileExpr)
import GHC.LanguageExtensions.Type (Extension (..))
import GhcMonad (Ghc, GhcMonad, liftIO)
import Ide.Plugin.Eval.Types (Language (Plain), Loc,
Located (..),
Section (sectionLanguage),
Test (..), Txt, locate,
locate0)
import InteractiveEval (runDecls)
import Language.LSP.Types.Lens (line, start)
import Unsafe.Coerce (unsafeCoerce)
-- | Return the ranges of the expression and result parts of the given test
testRanges :: Test -> (Range, Range)
@ -57,7 +53,7 @@ showDiffs :: (Semigroup a, IsString a) => [Diff a] -> [a]
showDiffs = map showDiff
showDiff :: (Semigroup a, IsString a) => Diff a -> a
showDiff (First w) = "WAS " <> w
showDiff (First w) = "WAS " <> w
showDiff (Second w) = "NOW " <> w
showDiff (Both w _) = w
@ -67,7 +63,7 @@ testCheck (section, test) out
| otherwise = showDiffs $ getDiff (map T.pack $ testOutput test) out
testLenghts :: Test -> (Int, Int)
testLenghts (Example e r _) = (NE.length e, length r)
testLenghts (Example e r _) = (NE.length e, length r)
testLenghts (Property _ r _) = (1, length r)
-- |A one-line Haskell statement

46
plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs
View File

@ -1,6 +1,6 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -Wno-orphans #-}
-- |GHC API utilities
@ -14,29 +14,25 @@ module Ide.Plugin.Eval.GHC (
showDynFlags,
) where
import Data.List (isPrefixOf)
import Data.Maybe (mapMaybe)
import Development.IDE.GHC.Compat
import Data.List (isPrefixOf)
import Data.Maybe (mapMaybe)
import Data.String (fromString)
import Development.IDE.GHC.Compat
import qualified EnumSet
import GHC.LanguageExtensions.Type (Extension (..))
import GhcMonad (modifySession)
import GhcPlugins (DefUnitId (..), InstalledUnitId (..), fsLit, hsc_IC, pprHsString)
import HscTypes (InteractiveContext (ic_dflags))
import Ide.Plugin.Eval.Util (asS, gStrictTry)
import GHC.LanguageExtensions.Type (Extension (..))
import GhcMonad (modifySession)
import GhcPlugins (DefUnitId (..),
InstalledUnitId (..), fsLit,
hsc_IC, pprHsString)
import HscTypes (InteractiveContext (ic_dflags))
import Ide.Plugin.Eval.Util (asS, gStrictTry)
import qualified Lexer
import Module (UnitId (DefiniteUnitId))
import Outputable (
Outputable (ppr),
SDoc,
showSDocUnsafe,
text,
vcat,
(<+>),
)
import Module (UnitId (DefiniteUnitId))
import Outputable (Outputable (ppr), SDoc,
showSDocUnsafe, text, vcat, (<+>))
import qualified Parser
import SrcLoc (mkRealSrcLoc)
import StringBuffer (stringToStringBuffer)
import Data.String (fromString)
import SrcLoc (mkRealSrcLoc)
import StringBuffer (stringToStringBuffer)
{- $setup
>>> import GHC
@ -63,7 +59,7 @@ False
-}
isExpr :: DynFlags -> String -> Bool
isExpr df stmt = case parseThing Parser.parseExpression df stmt of
Lexer.POk _ _ -> True
Lexer.POk _ _ -> True
Lexer.PFailed{} -> False
parseThing :: Lexer.P thing -> DynFlags -> String -> Lexer.ParseResult thing
@ -107,9 +103,9 @@ pkgNames_ :: [PackageFlag] -> [String]
pkgNames_ =
mapMaybe
( \case
ExposePackage _ (PackageArg n) _ -> Just n
ExposePackage _ (PackageArg n) _ -> Just n
ExposePackage _ (UnitIdArg (DefiniteUnitId n)) _ -> Just $ asS n
_ -> Nothing
_ -> Nothing
)
{- | Expose a list of packages.

108
plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs
View File

@ -1,54 +1,50 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
module Ide.Plugin.Eval.Parse.Comments where
import qualified Control.Applicative.Combinators.NonEmpty as NE
import Control.Arrow (first, (&&&), (>>>))
import Control.Lens (lensField, lensRules, view, (.~), (^.))
import Control.Lens.Extras (is)
import Control.Lens.TH (makeLensesWith, makePrisms, mappingNamer)
import Control.Monad (guard, void, when)
import Control.Monad.Combinators ()
import Control.Monad.Reader (ask)
import Control.Monad.Trans.Reader (Reader, runReader)
import qualified Data.Char as C
import qualified Data.DList as DL
import qualified Data.Foldable as F
import Data.Function ((&))
import Data.Functor.Identity
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NE
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Void (Void)
import Development.IDE (Position, Range (Range))
import Development.IDE.Types.Location (Position (..))
import GHC.Generics
import Ide.Plugin.Eval.Types
import Language.LSP.Types.Lens
( character,
end,
line,
start,
)
import Text.Megaparsec
import qualified Text.Megaparsec as P
import Text.Megaparsec.Char
( alphaNumChar,
char,
eol,
hspace,
letterChar,
)
import Data.Functor ((<&>))
import qualified Data.Text as T
import Control.Arrow (first, (&&&), (>>>))
import Control.Lens (lensField, lensRules,
view, (.~), (^.))
import Control.Lens.Extras (is)
import Control.Lens.TH (makeLensesWith,
makePrisms,
mappingNamer)
import Control.Monad (guard, void, when)
import Control.Monad.Combinators ()
import Control.Monad.Reader (ask)
import Control.Monad.Trans.Reader (Reader, runReader)
import qualified Data.Char as C
import qualified Data.DList as DL
import qualified Data.Foldable as F
import Data.Function ((&))
import Data.Functor ((<&>))
import Data.Functor.Identity
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NE
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Data.Void (Void)
import Development.IDE (Position,
Range (Range))
import Development.IDE.Types.Location (Position (..))
import GHC.Generics
import Ide.Plugin.Eval.Types
import Language.LSP.Types.Lens (character, end, line,
start)
import Text.Megaparsec
import qualified Text.Megaparsec as P
import Text.Megaparsec.Char (alphaNumChar, char,
eol, hspace,
letterChar)
{-
We build parsers combining the following three kinds of them:
@ -73,7 +69,7 @@ type LineParser a = forall m. Monad m => ParsecT Void String m a
type LineGroupParser = Parsec Void [(Range, RawLineComment)]
data BlockEnv = BlockEnv
{ isLhs :: Bool
{ isLhs :: Bool
, blockRange :: Range
}
deriving (Read, Show, Eq, Ord)
@ -96,13 +92,13 @@ newtype ExampleLine = ExampleLine {getExampleLine :: String}
data TestComment
= AProp
{ testCommentRange :: Range
, lineProp :: PropLine
, propResults :: [String]
, lineProp :: PropLine
, propResults :: [String]
}
| AnExample
{ testCommentRange :: Range
, lineExamples :: NonEmpty ExampleLine
, exampleResults :: [String]
, lineExamples :: NonEmpty ExampleLine
, exampleResults :: [String]
}
deriving (Show)
@ -229,11 +225,11 @@ testsToSection style flav tests =
sectionLanguage = case flav of
HaddockNext -> Haddock
HaddockPrev -> Haddock
_ -> Plain
_ -> Plain
sectionTests = map fromTestComment tests
sectionFormat =
case style of
Line -> SingleLine
Line -> SingleLine
Block ran -> MultiLine ran
in Section {..}
@ -364,7 +360,7 @@ lineGroupP = do
(_, flav) <- lookAhead $ parseLine (commentFlavourP <* takeRest)
case flav of
Named "setup" -> (Nothing,) <$> lineCommentSectionsP
flav -> (,mempty) . Just . (flav,) <$> lineCommentSectionsP
flav -> (,mempty) . Just . (flav,) <$> lineCommentSectionsP
-- >>> parse (lineGroupP <*eof) "" $ (dummyPosition, ) . RawLineComment <$> ["-- a", "-- b"]
-- Variable not in scope: dummyPosition :: Position
@ -475,7 +471,7 @@ nonEmptyNormalLineP isLHS style = try $ do
guard $
case style of
Block{} -> T.strip (T.pack ln) `notElem` ["{-", "-}", ""]
_ -> not $ all C.isSpace ln
_ -> not $ all C.isSpace ln
pure (ln, pos)
{- | Normal line is a line neither a example nor prop.
@ -496,7 +492,7 @@ normalLineP isLHS style = do
consume :: CommentStyle -> LineParser (String, Position)
consume style =
case style of
Line -> (,) <$> takeRest <*> getPosition
Line -> (,) <$> takeRest <*> getPosition
Block {} -> manyTill_ anySingle (getPosition <* eob)
getPosition :: (Ord v, TraversableStream s) => ParsecT v s m Position

8
plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Option.hs
View File

@ -6,10 +6,10 @@ module Ide.Plugin.Eval.Parse.Option (
parseSetFlags,
) where
import Text.Megaparsec.Char
import Text.Megaparsec
import Data.Void (Void)
import Control.Arrow (left)
import Control.Arrow (left)
import Data.Void (Void)
import Text.Megaparsec
import Text.Megaparsec.Char
{- |
>>> langOptions ":set -XBinaryLiterals -XOverloadedStrings "

46
plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs
View File

@ -1,9 +1,9 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wwarn #-}
module Ide.Plugin.Eval.Types
@ -29,16 +29,16 @@ module Ide.Plugin.Eval.Types
)
where
import Control.DeepSeq (NFData (rnf), deepseq)
import Data.Aeson (FromJSON, ToJSON)
import Data.List (partition)
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import Data.String (IsString (..))
import Development.IDE (Range)
import GHC.Generics (Generic)
import qualified Text.Megaparsec as P
import Language.LSP.Types (TextDocumentIdentifier)
import Control.DeepSeq (NFData (rnf), deepseq)
import Data.Aeson (FromJSON, ToJSON)
import Data.List (partition)
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import Data.String (IsString (..))
import Development.IDE (Range)
import GHC.Generics (Generic)
import Language.LSP.Types (TextDocumentIdentifier)
import qualified Text.Megaparsec as P
-- | A thing with a location attached.
data Located l a = Located {location :: l, located :: a}
@ -65,15 +65,15 @@ type Txt = String
data Sections = Sections
{ nonSetupSections :: [Section]
, setupSections :: [Section]
, setupSections :: [Section]
}
deriving (Show, Eq, Generic)
data Section = Section
{ sectionName :: Txt
, sectionTests :: [Test]
{ sectionName :: Txt
, sectionTests :: [Test]
, sectionLanguage :: Language
, sectionFormat :: Format
, sectionFormat :: Format
}
deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)
@ -93,7 +93,7 @@ data Test
deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)
data Comments = Comments
{ lineComments :: Map Range RawLineComment
{ lineComments :: Map Range RawLineComment
, blockComments :: Map Range RawBlockComment
}
deriving (Show, Eq, Ord, Generic)
@ -128,7 +128,7 @@ instance Monoid Comments where
isProperty :: Test -> Bool
isProperty Property {} = True
isProperty _ = False
isProperty _ = False
data Format
= SingleLine
@ -156,7 +156,7 @@ type EvalId = Int
-- | Specify the test section to execute
data EvalParams = EvalParams
{ sections :: [Section]
, module_ :: !TextDocumentIdentifier
, evalId :: !EvalId -- ^ unique group id; for test uses
, module_ :: !TextDocumentIdentifier
, evalId :: !EvalId -- ^ unique group id; for test uses
}
deriving (Eq, Show, Generic, FromJSON, ToJSON)

59
plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs
View File

@ -1,5 +1,5 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- |Debug utilities
@ -15,40 +15,29 @@ module Ide.Plugin.Eval.Util (
logWith,
) where
import Control.Monad.Extra (maybeM)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (
ExceptT (..),
runExceptT,
throwE,
)
import Data.Aeson (Value (Null))
import Data.Bifunctor (first)
import Data.String (IsString (fromString))
import qualified Data.Text as T
import Development.IDE (
IdeState,
Priority (..),
ideLogger,
logPriority,
)
import Exception (ExceptionMonad, SomeException (..), evaluate, gcatch)
import GHC.Exts (toList)
import GHC.Stack (HasCallStack, callStack, srcLocFile, srcLocStartCol, srcLocStartLine)
import Language.LSP.Server
import Language.LSP.Types
import Outputable (
Outputable (ppr),
ppr,
showSDocUnsafe,
)
import System.FilePath (takeExtension)
import System.Time.Extra (
duration,
showDuration,
)
import UnliftIO.Exception (catchAny)
import Control.Monad.Extra (maybeM)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE)
import Data.Aeson (Value (Null))
import Data.Bifunctor (first)
import Data.String (IsString (fromString))
import qualified Data.Text as T
import Development.IDE (IdeState, Priority (..), ideLogger,
logPriority)
import Exception (ExceptionMonad, SomeException (..),
evaluate, gcatch)
import GHC.Exts (toList)
import GHC.Stack (HasCallStack, callStack,
srcLocFile, srcLocStartCol,
srcLocStartLine)
import Language.LSP.Server
import Language.LSP.Types
import Outputable (Outputable (ppr), ppr,
showSDocUnsafe)
import System.FilePath (takeExtension)
import System.Time.Extra (duration, showDuration)
import UnliftIO.Exception (catchAny)
asS :: Outputable a => a -> String
asS = showSDocUnsafe . ppr

63
plugins/hls-eval-plugin/test/Eval.hs
View File

@ -1,45 +1,36 @@
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Eval (
tests,
) where
import Control.Applicative.Combinators (
skipManyTill
)
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO (liftIO))
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Language.LSP.Test
import Language.LSP.Types
import Language.LSP.Types.Lens (command, title, range)
import Control.Lens (view, _Just, preview)
import System.Directory (doesFileExist)
import System.FilePath (
(<.>),
(</>),
)
import Test.Hls.Util (hlsCommand, GhcVersion (GHC84, GHC86), knownBrokenForGhcVersions, knownBrokenInEnv, EnvSpec (HostOS, GhcVer), OS (Windows))
import Test.Tasty (
TestTree,
testGroup,
)
import Test.Tasty.ExpectedFailure (
expectFailBecause,
)
import Test.Tasty.HUnit (
testCase,
(@?=),
)
import Data.List.Extra (nubOrdOn)
import Ide.Plugin.Eval.Types (EvalParams(..))
import Data.Aeson (fromJSON)
import Data.Aeson.Types (Result(Success))
import Control.Applicative.Combinators (skipManyTill)
import Control.Lens (_Just, preview, view)
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Aeson (fromJSON)
import Data.Aeson.Types (Result (Success))
import Data.List.Extra (nubOrdOn)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Ide.Plugin.Eval.Types (EvalParams (..))
import Language.LSP.Test
import Language.LSP.Types
import Language.LSP.Types.Lens (command, range, title)
import System.Directory (doesFileExist)
import System.FilePath ((<.>), (</>))
import Test.Hls.Util (EnvSpec (GhcVer, HostOS),
GhcVersion (GHC84, GHC86),
OS (Windows), hlsCommand,
knownBrokenForGhcVersions,
knownBrokenInEnv)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.ExpectedFailure (expectFailBecause)
import Test.Tasty.HUnit (testCase, (@?=))
tests :: TestTree
tests =

69
plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs
View File

@ -1,43 +1,42 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
#include "ghc-api-version.h"
module Ide.Plugin.ExplicitImports (descriptor) where
import Control.DeepSeq
import Control.Monad.IO.Class
import Data.Aeson (ToJSON (toJSON), Value (Null))
import Data.Aeson.Types (FromJSON)
import qualified Data.HashMap.Strict as HashMap
import Data.IORef (readIORef)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromMaybe)
import qualified Data.Text as T
import Development.IDE
import Development.IDE.Core.PositionMapping
import Development.IDE.GHC.Compat
import Development.Shake.Classes
import GHC.Generics (Generic)
import Ide.PluginUtils ( mkLspCommand )
import Ide.Types
import Language.LSP.Types
import Language.LSP.Server
import PrelNames (pRELUDE)
import RnNames
( findImportUsage,
getMinimalImports,
)
import TcRnMonad (initTcWithGbl)
import TcRnTypes (TcGblEnv (tcg_used_gres))
import Control.DeepSeq
import Control.Monad.IO.Class
import Data.Aeson (ToJSON (toJSON),
Value (Null))
import Data.Aeson.Types (FromJSON)
import qualified Data.HashMap.Strict as HashMap
import Data.IORef (readIORef)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromMaybe)
import qualified Data.Text as T
import Development.IDE
import Development.IDE.Core.PositionMapping
import Development.IDE.GHC.Compat
import Development.Shake.Classes
import GHC.Generics (Generic)
import Ide.PluginUtils (mkLspCommand)
import Ide.Types
import Language.LSP.Server
import Language.LSP.Types
import PrelNames (pRELUDE)
import RnNames (findImportUsage,
getMinimalImports)
import TcRnMonad (initTcWithGbl)
import TcRnTypes (TcGblEnv (tcg_used_gres))
importCommandId :: CommandId
importCommandId = "ImportLensCommand"
@ -46,7 +45,7 @@ importCommandId = "ImportLensCommand"
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId =
(defaultPluginDescriptor plId)
{
{
-- This plugin provides a command handler
pluginCommands = [importLensCommand],
-- This plugin defines a new rule

49
plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs
View File

@ -1,25 +1,26 @@
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Ide.Plugin.HaddockComments (descriptor) where
import Control.Monad (join)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map as Map
import qualified Data.Text as T
import Development.IDE hiding (pluginHandlers)
import Development.IDE.GHC.Compat
import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (..), annsA, astA)
import Ide.Types
import Language.Haskell.GHC.ExactPrint
import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs)
import Language.Haskell.GHC.ExactPrint.Utils
import Language.LSP.Types
import Control.Monad.IO.Class
import Control.Monad (join)
import Control.Monad.IO.Class
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map as Map
import qualified Data.Text as T
import Development.IDE hiding (pluginHandlers)
import Development.IDE.GHC.Compat
import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (..),
annsA, astA)
import Ide.Types
import Language.Haskell.GHC.ExactPrint
import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs)
import Language.Haskell.GHC.ExactPrint.Utils
import Language.LSP.Types
-----------------------------------------------------------------------------
descriptor :: PluginId -> PluginDescriptor IdeState
@ -50,11 +51,11 @@ genList =
-- | Defines how to generate haddock comments by tweaking annotations of AST
data GenComments = forall a.
GenComments
{ title :: T.Text,
fromDecl :: HsDecl GhcPs -> Maybe a,
collectKeys :: a -> [AnnKey],
isFresh :: Annotation -> Bool,
updateAnn :: Annotation -> Annotation,
{ title :: T.Text,
fromDecl :: HsDecl GhcPs -> Maybe a,
collectKeys :: a -> [AnnKey],
isFresh :: Annotation -> Bool,
updateAnn :: Annotation -> Annotation,
updateDeclAnn :: Annotation -> Annotation
}
@ -81,7 +82,7 @@ genForSig = GenComments {..}
title = "Generate signature comments"
fromDecl (SigD _ (TypeSig _ _ (HsWC _ (HsIB _ x)))) = Just x
fromDecl _ = Nothing
fromDecl _ = Nothing
updateAnn x = x {annEntryDelta = DP (0, 1), annsDP = dp}
updateDeclAnn = cleanPriorComments

136
plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
View File

@ -1,13 +1,13 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ide.Plugin.Hlint
@ -15,62 +15,76 @@ module Ide.Plugin.Hlint
descriptor
--, provider
) where
import Refact.Apply
import Control.Arrow ((&&&))
import Control.DeepSeq
import Control.Exception
import Control.Lens ((^.))
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import Data.Aeson.Types (ToJSON(..), FromJSON(..), Value(..))
import Data.Binary
import Data.Default
import Data.Hashable
import qualified Data.HashMap.Strict as Map
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Typeable
import Development.IDE
import Development.IDE.Core.Rules (getParsedModuleWithComments, defineNoFile)
import Development.IDE.Core.Shake (getDiagnostics)
import Control.Arrow ((&&&))
import Control.DeepSeq
import Control.Exception
import Control.Lens ((^.))
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import Data.Aeson.Types (FromJSON (..),
ToJSON (..),
Value (..))
import Data.Binary
import Data.Default
import qualified Data.HashMap.Strict as Map
import Data.Hashable
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Typeable
import Development.IDE
import Development.IDE.Core.Rules (defineNoFile,
getParsedModuleWithComments)
import Development.IDE.Core.Shake (getDiagnostics)
import Refact.Apply
#ifdef HLINT_ON_GHC_LIB
import Data.List (nub)
import "ghc-lib" GHC hiding (DynFlags(..), ms_hspp_opts)
import "ghc-lib-parser" GHC.LanguageExtensions (Extension)
import "ghc" DynFlags as RealGHC.DynFlags (topDir)
import "ghc" GHC as RealGHC (DynFlags(..))
import "ghc" HscTypes as RealGHC.HscTypes (hsc_dflags, ms_hspp_opts)
import qualified "ghc" EnumSet as EnumSet
import Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx (readExtension)
import System.Environment(setEnv, unsetEnv)
import System.FilePath (takeFileName)
import System.IO (hPutStr, noNewlineTranslation, hSetNewlineMode, utf8, hSetEncoding, IOMode(WriteMode), withFile, hClose)
import System.IO.Temp
import Data.List (nub)
import "ghc" DynFlags as RealGHC.DynFlags (topDir)
import qualified "ghc" EnumSet as EnumSet
import "ghc" GHC as RealGHC (DynFlags (..))
import "ghc-lib" GHC hiding
(DynFlags (..),
ms_hspp_opts)
import "ghc-lib-parser" GHC.LanguageExtensions (Extension)
import "ghc" HscTypes as RealGHC.HscTypes (hsc_dflags,
ms_hspp_opts)
import Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx (readExtension)
import System.Environment (setEnv,
unsetEnv)
import System.FilePath (takeFileName)
import System.IO (IOMode (WriteMode),
hClose,
hPutStr,
hSetEncoding,
hSetNewlineMode,
noNewlineTranslation,
utf8,
withFile)
import System.IO.Temp
#else
import Development.IDE.GHC.Compat hiding (DynFlags(..))
import Language.Haskell.GHC.ExactPrint.Parsers (postParseTransform)
import Language.Haskell.GHC.ExactPrint.Delta (deltaOptions)
import Language.Haskell.GHC.ExactPrint.Types (Rigidity(..))
import Development.IDE.GHC.Compat hiding
(DynFlags (..))
import Language.Haskell.GHC.ExactPrint.Delta (deltaOptions)
import Language.Haskell.GHC.ExactPrint.Parsers (postParseTransform)
import Language.Haskell.GHC.ExactPrint.Types (Rigidity (..))
#endif
import Ide.Logger
import Ide.Types
import Ide.Plugin.Config
import Ide.PluginUtils
import Language.Haskell.HLint as Hlint
import Language.LSP.Server
( withIndefiniteProgress,
sendRequest,
ProgressCancellable(Cancellable) )
import Language.LSP.Types
import qualified Language.LSP.Types as LSP
import qualified Language.LSP.Types.Lens as LSP
import Ide.Logger
import Ide.Plugin.Config
import Ide.PluginUtils
import Ide.Types
import Language.Haskell.HLint as Hlint
import Language.LSP.Server (ProgressCancellable (Cancellable),
sendRequest,
withIndefiniteProgress)
import Language.LSP.Types
import qualified Language.LSP.Types as LSP
import qualified Language.LSP.Types.Lens as LSP
import Text.Regex.TDFA.Text()
import GHC.Generics (Generic)
import GHC.Generics (Generic)
import Text.Regex.TDFA.Text ()
-- ---------------------------------------------------------------------
@ -249,7 +263,7 @@ getHlintSettingsRule usage =
defineNoFile $ \GetHlintSettings ->
liftIO $ case usage of
HlintEnabled cmdArgs -> argsSettings cmdArgs
HlintDisabled -> fail "hlint configuration unspecified"
HlintDisabled -> fail "hlint configuration unspecified"
-- ---------------------------------------------------------------------
@ -329,7 +343,7 @@ data ApplyOneParams = AOP
type HintTitle = T.Text
data OneHint = OneHint
{ oneHintPos :: Position
{ oneHintPos :: Position
, oneHintTitle :: HintTitle
} deriving (Eq, Show)

148
plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs
View File

@ -16,76 +16,92 @@
module Ide.Plugin.Retrie (descriptor) where
import Control.Concurrent.Extra (readVar)
import Control.Exception.Safe (Exception (..), SomeException,
catch, throwIO, try)
import Control.Monad (forM, unless)
import Control.Monad.Extra (maybeM)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Class (MonadTrans (lift))
import Control.Monad.Trans.Except (ExceptT (..), runExceptT,
throwE)
import Data.Aeson (genericParseJSON, FromJSON(..), ToJSON (..), Value (Null))
import Data.Bifunctor (Bifunctor (first), second)
import Control.Concurrent.Extra (readVar)
import Control.Exception.Safe (Exception (..),
SomeException, catch,
throwIO, try)
import Control.Monad (forM, unless)
import Control.Monad.Extra (maybeM)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Class (MonadTrans (lift))
import Control.Monad.Trans.Except (ExceptT (..), runExceptT,
throwE)
import Control.Monad.Trans.Maybe
import Data.Aeson (FromJSON (..),
ToJSON (..),
Value (Null),
genericParseJSON)
import qualified Data.Aeson as Aeson
import Data.Bifunctor (Bifunctor (first),
second)
import Data.Coerce
import Data.Either (partitionEithers)
import Data.Hashable (unhashed)
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as Set
import Data.IORef.Extra (atomicModifyIORef'_, newIORef,
readIORef)
import Data.List.Extra (find, nubOrdOn)
import Data.String (IsString (fromString))
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Typeable (Typeable)
import Development.IDE hiding (pluginHandlers)
import Development.IDE.Core.Shake (toKnownFiles, ShakeExtras(knownTargetsVar))
import Development.IDE.GHC.Compat (GenLocated (L), GhcRn,
HsBindLR (FunBind),
HsGroup (..),
HsValBindsLR (..), HscEnv, IdP,
LRuleDecls,
ModSummary (ModSummary, ms_hspp_buf, ms_mod),
NHsValBindsLR (..),
ParsedModule (..),
RuleDecl (HsRule),
RuleDecls (HsRules),
SrcSpan (..),
TyClDecl (SynDecl),
TyClGroup (..), fun_id,
mi_fixities, moduleNameString,
parseModule, rds_rules,
srcSpanFile)
import GHC.Generics (Generic)
import GhcPlugins (Outputable,
SourceText (NoSourceText),
hm_iface, isQual, isQual_maybe,
nameModule_maybe, nameRdrName,
occNameFS, occNameString,
rdrNameOcc, unpackFS)
import Data.Either (partitionEithers)
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as Set
import Data.Hashable (unhashed)
import Data.IORef.Extra (atomicModifyIORef'_,
newIORef, readIORef)
import Data.List.Extra (find, nubOrdOn)
import Data.String (IsString (fromString))
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Typeable (Typeable)
import Development.IDE hiding (pluginHandlers)
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.Shake (ShakeExtras (knownTargetsVar),
toKnownFiles)
import Development.IDE.GHC.Compat (GenLocated (L), GhcRn,
HsBindLR (FunBind),
HsGroup (..),
HsValBindsLR (..),
HscEnv, IdP, LRuleDecls,
ModSummary (ModSummary, ms_hspp_buf, ms_mod),
NHsValBindsLR (..),
ParsedModule (..),
RuleDecl (HsRule),
RuleDecls (HsRules),
SrcSpan (..),
TyClDecl (SynDecl),
TyClGroup (..), fun_id,
mi_fixities,
moduleNameString,
parseModule, rds_rules,
srcSpanFile)
import GHC.Generics (Generic)
import GhcPlugins (Outputable,
SourceText (NoSourceText),
hm_iface, isQual,
isQual_maybe,
nameModule_maybe,
nameRdrName, occNameFS,
occNameString,
rdrNameOcc, unpackFS)
import Ide.PluginUtils
import Ide.Types
import Language.LSP.Server (ProgressCancellable (Cancellable), withIndefiniteProgress, LspM, sendRequest, sendNotification)
import Language.LSP.Types as J
import Retrie.CPP (CPP (NoCPP), parseCPP)
import Retrie.ExactPrint (fix, relativiseApiAnns,
transformA, unsafeMkA)
import Retrie.Fixity (mkFixityEnv)
import qualified Retrie.GHC as GHC
import Retrie.Monad (addImports, apply,
getGroundTerms, runRetrie)
import Retrie.Options (defaultOptions, getTargetFiles)
import qualified Retrie.Options as Retrie
import Retrie.Replace (Change (..), Replacement (..))
import Language.LSP.Server (LspM,
ProgressCancellable (Cancellable),
sendNotification,
sendRequest,
withIndefiniteProgress)
import Language.LSP.Types as J
import Retrie.CPP (CPP (NoCPP), parseCPP)
import Retrie.ExactPrint (fix, relativiseApiAnns,
transformA, unsafeMkA)
import Retrie.Fixity (mkFixityEnv)
import qualified Retrie.GHC as GHC
import Retrie.Monad (addImports, apply,
getGroundTerms,
runRetrie)
import Retrie.Options (defaultOptions,
getTargetFiles)
import qualified Retrie.Options as Retrie
import Retrie.Replace (Change (..),
Replacement (..))
import Retrie.Rewrites
import Retrie.SYB (listify)
import Retrie.Util (Verbosity (Loud))
import StringBuffer (stringToStringBuffer)
import System.Directory (makeAbsolute)
import Control.Monad.Trans.Maybe
import Development.IDE.Core.PositionMapping
import qualified Data.Aeson as Aeson
import Retrie.SYB (listify)
import Retrie.Util (Verbosity (Loud))
import StringBuffer (stringToStringBuffer)
import System.Directory (makeAbsolute)
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId =

122
plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs
View File

@ -1,60 +1,62 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Ide.Plugin.Splice
( descriptor,
)
where
import Control.Applicative (Alternative ((<|>)))
import Control.Arrow
import qualified Control.Foldl as L
import Control.Lens (ix, view, (%~), (<&>), (^.))
import Control.Monad
import Control.Monad.Extra (eitherM)
import qualified Control.Monad.Fail as Fail
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Data.Aeson
import Data.Function
import Data.Generics
import qualified Data.Kind as Kinds
import Data.List (sortOn)
import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
import qualified Data.Text as T
import Development.IDE
import Development.IDE.GHC.Compat hiding (getLoc)
import Exception
import GHC.Exts
import GhcMonad
import GhcPlugins hiding (Var, getLoc, (<>))
import Ide.Plugin.Splice.Types
import Development.IDE.GHC.ExactPrint
import Ide.Types
import Language.Haskell.GHC.ExactPrint (setPrecedingLines, uniqueSrcSpanT)
import Language.LSP.Server
import Language.LSP.Types
import Language.LSP.Types.Capabilities
import qualified Language.LSP.Types.Lens as J
import RnSplice
import TcRnMonad
import Data.Foldable (Foldable(foldl'))
import Control.Monad.IO.Unlift
import Control.Applicative (Alternative ((<|>)))
import Control.Arrow
import qualified Control.Foldl as L
import Control.Lens (ix, view, (%~), (<&>), (^.))
import Control.Monad
import Control.Monad.Extra (eitherM)
import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Unlift
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Data.Aeson
import Data.Foldable (Foldable (foldl'))
import Data.Function
import Data.Generics
import qualified Data.Kind as Kinds
import Data.List (sortOn)
import Data.Maybe (fromMaybe, listToMaybe,
mapMaybe)
import qualified Data.Text as T
import Development.IDE
import Development.IDE.GHC.Compat hiding (getLoc)
import Development.IDE.GHC.ExactPrint
import Exception
import GHC.Exts
import GhcMonad
import GhcPlugins hiding (Var, getLoc, (<>))
import Ide.Plugin.Splice.Types
import Ide.Types
import Language.Haskell.GHC.ExactPrint (setPrecedingLines,
uniqueSrcSpanT)
import Language.LSP.Server
import Language.LSP.Types
import Language.LSP.Types.Capabilities
import qualified Language.LSP.Types.Lens as J
import RnSplice
import TcRnMonad
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId =
@ -280,25 +282,25 @@ class (Outputable (ast GhcRn), ASTElement (ast GhcPs)) => HasSplice ast where
instance HasSplice HsExpr where
matchSplice _ (HsSpliceE _ spl) = Just spl
matchSplice _ _ = Nothing
matchSplice _ _ = Nothing
expandSplice _ = fmap (first Right) . rnSpliceExpr
instance HasSplice Pat where
matchSplice _ (SplicePat _ spl) = Just spl
matchSplice _ _ = Nothing
matchSplice _ _ = Nothing
expandSplice _ = rnSplicePat
instance HasSplice HsType where
matchSplice _ (HsSpliceTy _ spl) = Just spl
matchSplice _ _ = Nothing
matchSplice _ _ = Nothing
expandSplice _ = fmap (first Right) . rnSpliceType
classifyAST :: SpliceContext -> SpliceClass
classifyAST = \case
Expr -> OneToOneAST @HsExpr proxy#
Expr -> OneToOneAST @HsExpr proxy#
HsDecl -> IsHsDecl
Pat -> OneToOneAST @Pat proxy#
Pat -> OneToOneAST @Pat proxy#
HsType -> OneToOneAST @HsType proxy#
type ReportEditor = forall m. MonadIO m => MessageType -> [T.Text] -> m ()
@ -382,7 +384,7 @@ data SearchResult r =
fromSearchResult :: SearchResult a -> Maybe a
fromSearchResult (Here r) = Just r
fromSearchResult _ = Nothing
fromSearchResult _ = Nothing
-- TODO: workaround when HieAst unavailable (e.g. when the module itself errors)
-- TODO: Declaration Splices won't appear in HieAst; perhaps we must just use Parsed/Renamed ASTs?
@ -419,7 +421,7 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $
| RealSrcSpan spn `isSubspanOf` l ->
case expr of
HsSpliceE {} -> Here (spLoc, Expr)
_ -> Continue
_ -> Continue
_ -> Stop
)
`extQ` \case
@ -431,21 +433,21 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $
| RealSrcSpan spn `isSubspanOf` l ->
case pat of
SplicePat{} -> Here (spLoc, Pat)
_ -> Continue
_ -> Continue
_ -> Stop
`extQ` \case
(L l@(RealSrcSpan spLoc) ty :: LHsType GhcPs)
| RealSrcSpan spn `isSubspanOf` l ->
case ty of
HsSpliceTy {} -> Here (spLoc, HsType)
_ -> Continue
_ -> Continue
_ -> Stop
`extQ` \case
(L l@(RealSrcSpan spLoc) decl :: LHsDecl GhcPs)
| RealSrcSpan spn `isSubspanOf` l ->
case decl of
SpliceD {} -> Here (spLoc, HsDecl)
_ -> Continue
_ -> Continue
_ -> Stop
-- | Like 'something', but performs top-down searching, cutoffs when 'Stop' received,

26
plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs
View File

@ -1,21 +1,21 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
module Ide.Plugin.Splice.Types where
import Data.Aeson (FromJSON, ToJSON)
import Development.IDE (Uri)
import GHC.Generics (Generic)
import Development.IDE.GHC.Compat (RealSrcSpan)
import qualified Data.Text as T
import Ide.Types ( CommandId )
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Text as T
import Development.IDE (Uri)
import Development.IDE.GHC.Compat (RealSrcSpan)
import GHC.Generics (Generic)
import Ide.Types (CommandId)
-- | Parameter for the addMethods PluginCommand.
data ExpandSpliceParams = ExpandSpliceParams
{ uri :: Uri
, spliceSpan :: RealSrcSpan
{ uri :: Uri
, spliceSpan :: RealSrcSpan
, spliceContext :: SpliceContext
}
deriving (Show, Eq, Generic)
@ -36,11 +36,11 @@ expandStyles =
]
toExpandCmdTitle :: ExpandStyle -> T.Text
toExpandCmdTitle Inplace = inplaceCmdName
toExpandCmdTitle Inplace = inplaceCmdName
toExpandCmdTitle Commented = commentedCmdName
toCommandId :: ExpandStyle -> CommandId
toCommandId Inplace = expandInplaceId
toCommandId Inplace = expandInplaceId
toCommandId Commented = expandCommentedId
expandInplaceId, expandCommentedId :: CommandId

16
plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Auto.hs
View File

@ -1,13 +1,13 @@
module Ide.Plugin.Tactic.Auto where
import Control.Monad.State (gets)
import Ide.Plugin.Tactic.Context
import Ide.Plugin.Tactic.Judgements
import Ide.Plugin.Tactic.KnownStrategies
import Ide.Plugin.Tactic.Machinery (tracing)
import Ide.Plugin.Tactic.Tactics
import Ide.Plugin.Tactic.Types
import Refinery.Tactic
import Control.Monad.State (gets)
import Ide.Plugin.Tactic.Context
import Ide.Plugin.Tactic.Judgements
import Ide.Plugin.Tactic.KnownStrategies
import Ide.Plugin.Tactic.Machinery (tracing)
import Ide.Plugin.Tactic.Tactics
import Ide.Plugin.Tactic.Types
import Refinery.Tactic
------------------------------------------------------------------------------

16
plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CaseSplit.hs
View File

@ -9,14 +9,14 @@ module Ide.Plugin.Tactic.CaseSplit
, splitToDecl
) where
import Data.Bool (bool)
import Data.Bool (bool)
import Data.Data
import Data.Generics
import Data.Set (Set)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.Set as S
import Development.IDE.GHC.Compat
import GHC.Exts (IsString(fromString))
import GHC.SourceGen (funBinds, match, wildP)
import GHC.Exts (IsString (fromString))
import GHC.SourceGen (funBinds, match, wildP)
import Ide.Plugin.Tactic.GHC
import Ide.Plugin.Tactic.Types
import OccName
@ -28,7 +28,7 @@ import OccName
-- match) and a body.
mkFirstAgda :: [Pat GhcPs] -> HsExpr GhcPs -> AgdaMatch
mkFirstAgda pats (Lambda pats' body) = mkFirstAgda (pats <> pats') body
mkFirstAgda pats body = AgdaMatch pats body
mkFirstAgda pats body = AgdaMatch pats body
------------------------------------------------------------------------------
@ -55,7 +55,7 @@ wildify (AgdaMatch pats body) =
wildifyT :: Data a => Set OccName -> a -> a
wildifyT (S.map occNameString -> used) = everywhere $ mkT $ \case
VarPat _ (L _ var) | S.notMember (occNameString $ occName var) used -> wildP
(x :: Pat GhcPs) -> x
(x :: Pat GhcPs) -> x
------------------------------------------------------------------------------
@ -63,7 +63,7 @@ wildifyT (S.map occNameString -> used) = everywhere $ mkT $ \case
rewriteVarPat :: Data a => RdrName -> Pat GhcPs -> a -> a
rewriteVarPat name rep = everywhere $ mkT $ \case
VarPat _ (L _ var) | eqRdrName name var -> rep
(x :: Pat GhcPs) -> x
(x :: Pat GhcPs) -> x
------------------------------------------------------------------------------

17
plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs
View File

@ -1,21 +1,20 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Ide.Plugin.Tactic.CodeGen
( module Ide.Plugin.Tactic.CodeGen
, module Ide.Plugin.Tactic.CodeGen.Utils
) where
import Control.Lens ((+~), (%~), (<>~))
import Control.Lens ((%~), (+~), (<>~))
import Control.Monad.Except
import Control.Monad.State (MonadState)
import Control.Monad.State.Class (modify)
import Data.Generics.Product (field)
import Control.Monad.State (MonadState)
import Control.Monad.State.Class (modify)
import Data.Generics.Product (field)
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Traversable
import DataCon
import Development.IDE.GHC.Compat
@ -24,13 +23,13 @@ import GHC.SourceGen.Binds
import GHC.SourceGen.Expr
import GHC.SourceGen.Overloaded
import GHC.SourceGen.Pat
import Ide.Plugin.Tactic.CodeGen.Utils
import Ide.Plugin.Tactic.GHC
import Ide.Plugin.Tactic.Judgements
import Ide.Plugin.Tactic.Machinery
import Ide.Plugin.Tactic.Naming
import Ide.Plugin.Tactic.Types
import Ide.Plugin.Tactic.CodeGen.Utils
import Type hiding (Var)
import Type hiding (Var)
useOccName :: MonadState TacticState m => Judgement -> OccName -> m ()

16
plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs
View File

@ -2,14 +2,14 @@
module Ide.Plugin.Tactic.CodeGen.Utils where
import Data.List
import DataCon
import Development.IDE.GHC.Compat
import GHC.Exts
import GHC.SourceGen (recordConE, RdrNameStr)
import GHC.SourceGen.Overloaded
import Ide.Plugin.Tactic.GHC (getRecordFields)
import Name
import Data.List
import DataCon
import Development.IDE.GHC.Compat
import GHC.Exts
import GHC.SourceGen (RdrNameStr, recordConE)
import GHC.SourceGen.Overloaded
import Ide.Plugin.Tactic.GHC (getRecordFields)
import Name
------------------------------------------------------------------------------

18
plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Context.hs
View File

@ -7,18 +7,18 @@ import Bag
import Control.Arrow
import Control.Monad.Reader
import Data.List
import Data.Maybe (mapMaybe)
import Data.Set (Set)
import qualified Data.Set as S
import Data.Maybe (mapMaybe)
import Data.Set (Set)
import qualified Data.Set as S
import Development.IDE.GHC.Compat
import Ide.Plugin.Tactic.GHC (tacticsThetaTy)
import Ide.Plugin.Tactic.Machinery (methodHypothesis)
import Ide.Plugin.Tactic.FeatureSet (FeatureSet)
import Ide.Plugin.Tactic.GHC (tacticsThetaTy)
import Ide.Plugin.Tactic.Machinery (methodHypothesis)
import Ide.Plugin.Tactic.Types
import OccName
import TcRnTypes
import TcType (substTy, tcSplitSigmaTy)
import Unify (tcUnifyTy)
import Ide.Plugin.Tactic.FeatureSet (FeatureSet)
import TcType (substTy, tcSplitSigmaTy)
import Unify (tcUnifyTy)
mkContext :: FeatureSet -> [(OccName, CType)] -> TcGblEnv -> Context
@ -84,7 +84,7 @@ getFunBindId :: HsBindLR GhcTc GhcTc -> [Id]
getFunBindId (AbsBinds _ _ _ abes _ _ _)
= abes >>= \case
ABE _ poly _ _ _ -> pure poly
_ -> []
_ -> []
getFunBindId _ = []

16
plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Debug.hs
View File

@ -14,18 +14,18 @@ module Ide.Plugin.Tactic.Debug
, traceFX
) where
import Control.DeepSeq
import Control.Exception
import Debug.Trace
import DynFlags (unsafeGlobalDynFlags)
import Outputable hiding ((<>))
import System.IO.Unsafe (unsafePerformIO)
import Control.DeepSeq
import Control.Exception
import Debug.Trace
import DynFlags (unsafeGlobalDynFlags)
import Outputable hiding ((<>))
import System.IO.Unsafe (unsafePerformIO)
#if __GLASGOW_HASKELL__ >= 808
import PlainPanic (PlainGhcException)
import PlainPanic (PlainGhcException)
type GHC_EXCEPTION = PlainGhcException
#else
import Panic (GhcException)
import Panic (GhcException)
type GHC_EXCEPTION = GhcException
#endif

Some files were not shown because too many files have changed in this diff Show More