diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 791cf70274..1b6df50b9b 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -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", diff --git a/GenChangelogs.hs b/GenChangelogs.hs index 0e4a1384dc..704f54bfe0 100755 --- a/GenChangelogs.hs +++ b/GenChangelogs.hs @@ -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" diff --git a/exe/Main.hs b/exe/Main.hs index d77c515f37..405f8bd662 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -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 diff --git a/exe/Plugins.hs b/exe/Plugins.hs index 2b465b0c17..1cbb78d65c 100644 --- a/exe/Plugins.hs +++ b/exe/Plugins.hs @@ -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 -- --------------------------------------------------------------------- diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs index 9801b54da2..975492f249 100644 --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -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 diff --git a/ghcide/bench/exe/Main.hs b/ghcide/bench/exe/Main.hs index ad6460ded2..9a7da8976d 100644 --- a/ghcide/bench/exe/Main.hs +++ b/ghcide/bench/exe/Main.hs @@ -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") diff --git a/ghcide/bench/hist/Main.hs b/ghcide/bench/hist/Main.hs index 0de9f6296a..797836f4e1 100644 --- a/ghcide/bench/hist/Main.hs +++ b/ghcide/bench/hist/Main.hs @@ -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) diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs index f0581e1d49..919804d1b6 100644 --- a/ghcide/bench/lib/Experiments.hs +++ b/ghcide/bench/lib/Experiments.hs @@ -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 diff --git a/ghcide/bench/lib/Experiments/Types.hs b/ghcide/bench/lib/Experiments/Types.hs index 8232e9d7f4..2e3ede2f9b 100644 --- a/ghcide/bench/lib/Experiments/Types.hs +++ b/ghcide/bench/lib/Experiments/Types.hs @@ -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) diff --git a/ghcide/exe/Arguments.hs b/ghcide/exe/Arguments.hs index ab3cd26a92..f78202a8f0 100644 --- a/ghcide/exe/Arguments.hs +++ b/ghcide/exe/Arguments.hs @@ -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 diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index e706c645ba..1286d05a5a 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -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 diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 1c5a07f0a4..286eec87ee 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -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 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 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.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 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 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 diff --git a/ghcide/session-loader/Development/IDE/Session/VersionCheck.hs b/ghcide/session-loader/Development/IDE/Session/VersionCheck.hs index f15e765e8e..be58f420fb 100644 --- a/ghcide/session-loader/Development/IDE/Session/VersionCheck.hs +++ b/ghcide/session-loader/Development/IDE/Session/VersionCheck.hs @@ -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")) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 9683f3b722..1e007b6ccc 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -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 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 System.FilePath +import System.IO.Extra (fixIO, newTempFileWithin) +import TcEnv (tcLookup) + +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 diff --git a/ghcide/src/Development/IDE/Core/Debouncer.hs b/ghcide/src/Development/IDE/Core/Debouncer.hs index 7eb46aa92b..41ffd766cc 100644 --- a/ghcide/src/Development/IDE/Core/Debouncer.hs +++ b/ghcide/src/Development/IDE/Core/Debouncer.hs @@ -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) diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index 54763a71ad..5e4a98a77e 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -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 diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 3ec9069331..d605a761fa 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -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" diff --git a/ghcide/src/Development/IDE/Core/IdeConfiguration.hs b/ghcide/src/Development/IDE/Core/IdeConfiguration.hs index 6a396ca81d..0aa5d34f99 100644 --- a/ghcide/src/Development/IDE/Core/IdeConfiguration.hs +++ b/ghcide/src/Development/IDE/Core/IdeConfiguration.hs @@ -14,20 +14,20 @@ where import Control.Concurrent.Extra import Control.Monad -import Data.Hashable (Hashed, hashed, unhashed) +import Data.Aeson.Types (Value) import Data.HashSet (HashSet, singleton) +import Data.Hashable (Hashed, hashed, unhashed) import Data.Text (Text, isPrefixOf) -import Data.Aeson.Types (Value) 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) diff --git a/ghcide/src/Development/IDE/Core/OfInterest.hs b/ghcide/src/Development/IDE/Core/OfInterest.hs index 5b04d720b9..b39b5b2204 100644 --- a/ghcide/src/Development/IDE/Core/OfInterest.hs +++ b/ghcide/src/Development/IDE/Core/OfInterest.hs @@ -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 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.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 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 diff --git a/ghcide/src/Development/IDE/Core/PositionMapping.hs b/ghcide/src/Development/IDE/Core/PositionMapping.hs index e4604ad24b..a9bd4aae7f 100644 --- a/ghcide/src/Development/IDE/Core/PositionMapping.hs +++ b/ghcide/src/Development/IDE/Core/PositionMapping.hs @@ -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) } diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index 0f12c6fcac..b8873347ef 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -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 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 Development.IDE.GHC.CPP +import Development.IDE.GHC.Compat +import Development.IDE.GHC.Orphans () +import GhcMonad +import StringBuffer as SB + +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) diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index df576ffb50..3ff3d0e86e 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -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 HscTypes (ModGuts, hm_iface, HomeModInfo, hm_linkable) - +import GHC.Generics (Generic) + +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 diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 75b0710535..0846593bdc 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -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 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 Fingerprint + +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 qualified GHC.LanguageExtensions as LangExt -import HscTypes hiding (TargetModule, TargetFile) -import GHC.Generics(Generic) - -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 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 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 GHC.Generics (Generic) +import qualified GHC.LanguageExtensions as LangExt +import HscTypes hiding + (TargetFile, + TargetModule) + +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 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) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 868953181b..a9c190ed1e 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -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 Data.IORef -import NameCache -import UniqSupply -import PrelInfo -import Language.LSP.Types.Capabilities -import OpenTelemetry.Eventlog -import GHC.Fingerprint - -import HieDb.Types -import Control.Exception.Extra hiding (bracket_) -import UnliftIO.Exception (bracket_) +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 GHC.Fingerprint +import Language.LSP.Types.Capabilities +import NameCache +import OpenTelemetry.Eventlog +import PrelInfo +import UniqSupply + +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 diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index 9cb407c813..d9caffec82 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -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 diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index afdab484d7..1470fae0c7 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -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 diff --git a/ghcide/src/Development/IDE/GHC/Error.hs b/ghcide/src/Development/IDE/GHC/Error.hs index 9e06ea9a5c..d8404b6123 100644 --- a/ghcide/src/Development/IDE/GHC/Error.hs +++ b/ghcide/src/Development/IDE/GHC/Error.hs @@ -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 diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index e9a5e91538..089ba17af4 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -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. diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 6b3aed831b..e737efee53 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -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 ---------------------------------------------------------------------- diff --git a/ghcide/src/Development/IDE/GHC/Warnings.hs b/ghcide/src/Development/IDE/GHC/Warnings.hs index 202ed784e8..8152dd52c6 100644 --- a/ghcide/src/Development/IDE/GHC/Warnings.hs +++ b/ghcide/src/Development/IDE/GHC/Warnings.hs @@ -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 diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index f430ee8f67..9e58cbd0f6 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -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 Development.IDE.Types.Diagnostics -import Development.IDE.Types.Location -import Development.IDE.Import.FindImports (ArtifactsLocation(..)) - -import GHC +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.Import.FindImports (ArtifactsLocation (..)) +import Development.IDE.Types.Diagnostics +import Development.IDE.Types.Location + +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 diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index b95ad2117a..1f6e8ec0fc 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -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 diff --git a/ghcide/src/Development/IDE/LSP/HoverDefinition.hs b/ghcide/src/Development/IDE/LSP/HoverDefinition.hs index a068e79dbe..4635bfd6a5 100644 --- a/ghcide/src/Development/IDE/LSP/HoverDefinition.hs +++ b/ghcide/src/Development/IDE/LSP/HoverDefinition.hs @@ -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)) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index d8f9c1a1a8..a40715bcc1 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -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.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 System.IO.Unsafe (unsafeInterleaveIO) +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.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) runLanguageServer :: forall config. (Show config) diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index 64eb24fa61..658253b4a7 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -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 Development.IDE.Core.FileStore (setSomethingModified, setFileModified, typecheckParents) -import Development.IDE.Core.FileExists (modifyFileExists, watchedGlobs) +import qualified Data.Text as Text + +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 () diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index a968dca983..cb1d0d7b62 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -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)) diff --git a/ghcide/src/Development/IDE/LSP/Server.hs b/ghcide/src/Development/IDE/LSP/Server.hs index 5c95b7be0c..f2edc004db 100644 --- a/ghcide/src/Development/IDE/LSP/Server.hs +++ b/ghcide/src/Development/IDE/LSP/Server.hs @@ -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 ()) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index b2ea0c4893..7a64527170 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -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 diff --git a/ghcide/src/Development/IDE/Plugin.hs b/ghcide/src/Development/IDE/Plugin.hs index 046f4e56e3..2c7b1fedaf 100644 --- a/ghcide/src/Development/IDE/Plugin.hs +++ b/ghcide/src/Development/IDE/Plugin.hs @@ -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) } diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 8d93479b66..8d77a41559 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -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 <> ")" diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 201b5030d3..520887cd71 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -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 = diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs index 424e05368c..24f3a867e3 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs @@ -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 diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/RuleTypes.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/RuleTypes.hs index c663e3a1a7..663757b64a 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/RuleTypes.hs @@ -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 diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 8d0afd7e13..72419eb64a 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -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 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 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 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 diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index eabc8fcbfd..3f9c26b154 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -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 diff --git a/ghcide/src/Development/IDE/Plugin/Test.hs b/ghcide/src/Development/IDE/Plugin/Test.hs index 7af6dc966a..7b89ecfb9d 100644 --- a/ghcide/src/Development/IDE/Plugin/Test.hs +++ b/ghcide/src/Development/IDE/Plugin/Test.hs @@ -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 diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 546a931d76..d9cdc4c220 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -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" diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 243959e97a..2ae56b2cca 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -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) diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs index 479c908c2a..855c27c7b2 100644 --- a/ghcide/src/Development/IDE/Spans/Common.hs +++ b/ghcide/src/Development/IDE/Spans/Common.hs @@ -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 GHC -import Outputable hiding ((<>)) -import ConLike -import DataCon -import Var -import NameEnv -import DynFlags - +import Control.DeepSeq +import Data.List.Extra +import Data.Maybe +import qualified Data.Text as T +import GHC.Generics + +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 diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index 26691c06d7..bf7acd6116 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -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 ExtractDocs import FastString -import SrcLoc (RealLocated) import GhcMonad -import Packages +import HscTypes (HscEnv (hsc_dflags)) +import Language.LSP.Types (filePathToUri, getUri) import Name -import Language.LSP.Types (getUri, filePathToUri) -import TcRnTypes -import ExtractDocs 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] diff --git a/ghcide/src/Development/IDE/Types/Action.hs b/ghcide/src/Development/IDE/Types/Action.hs index 4a3c7e6a8b..56b83fb6f9 100644 --- a/ghcide/src/Development/IDE/Types/Action.hs +++ b/ghcide/src/Development/IDE/Types/Action.hs @@ -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) diff --git a/ghcide/src/Development/IDE/Types/Diagnostics.hs b/ghcide/src/Development/IDE/Types/Diagnostics.hs index a9de39d43f..ce13bc3d3f 100644 --- a/ghcide/src/Development/IDE/Types/Diagnostics.hs +++ b/ghcide/src/Development/IDE/Types/Diagnostics.hs @@ -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 diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index 11bcfd55f0..28de5b6d58 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -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) diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index 9a907149ff..3283ec9e67 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -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 diff --git a/ghcide/src/Development/IDE/Types/KnownTargets.hs b/ghcide/src/Development/IDE/Types/KnownTargets.hs index 529edc21fc..86cc887260 100644 --- a/ghcide/src/Development/IDE/Types/KnownTargets.hs +++ b/ghcide/src/Development/IDE/Types/KnownTargets.hs @@ -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] diff --git a/ghcide/src/Development/IDE/Types/Location.hs b/ghcide/src/Development/IDE/Types/Location.hs index 182a8412f7..e196ba29e4 100644 --- a/ghcide/src/Development/IDE/Types/Location.hs +++ b/ghcide/src/Development/IDE/Types/Location.hs @@ -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 "." diff --git a/ghcide/src/Development/IDE/Types/Options.hs b/ghcide/src/Development/IDE/Types/Options.hs index 6ec8509d53..24e96a7435 100644 --- a/ghcide/src/Development/IDE/Types/Options.hs +++ b/ghcide/src/Development/IDE/Types/Options.hs @@ -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. } diff --git a/ghcide/src/Development/IDE/Types/Shake.hs b/ghcide/src/Development/IDE/Types/Shake.hs index 7cfdcaf161..86ea711d71 100644 --- a/ghcide/src/Development/IDE/Types/Shake.hs +++ b/ghcide/src/Development/IDE/Types/Shake.hs @@ -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 diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 0cfb5c7e56..19cdb344c6 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -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 diff --git a/ghcide/test/manual/lhs/Main.hs b/ghcide/test/manual/lhs/Main.hs index 518912e2d6..3559ab22b4 100644 --- a/ghcide/test/manual/lhs/Main.hs +++ b/ghcide/test/manual/lhs/Main.hs @@ -6,7 +6,7 @@ module Main main ) where -import Test (main) +import Test (main) diff --git a/ghcide/test/preprocessor/Main.hs b/ghcide/test/preprocessor/Main.hs index 560f62eeb4..d7ae0e5cab 100644 --- a/ghcide/test/preprocessor/Main.hs +++ b/ghcide/test/preprocessor/Main.hs @@ -1,7 +1,7 @@ module Main(main) where -import System.Environment +import System.Environment main :: IO () main = do diff --git a/ghcide/test/src/Development/IDE/Test.hs b/ghcide/test/src/Development/IDE/Test.hs index 22ae46da46..420fb6736c 100644 --- a/ghcide/test/src/Development/IDE/Test.hs +++ b/ghcide/test/src/Development/IDE/Test.hs @@ -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 diff --git a/hls-plugin-api/src/Ide/Plugin/Config.hs b/hls-plugin-api/src/Ide/Plugin/Config.hs index 216c8604c6..fd5b9c5329 100644 --- a/hls-plugin-api/src/Ide/Plugin/Config.hs +++ b/hls-plugin-api/src/Ide/Plugin/Config.hs @@ -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) -- --------------------------------------------------------------------- diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 5f67c5b6a4..57206a0625 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -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 Control.Lens ((^.)) +import Control.Monad +import Data.Aeson hiding (defaultOptions) +import qualified Data.DList as DList +import qualified Data.Default +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 Development.Shake hiding (command) +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.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 qualified Data.Default -import System.IO.Unsafe -import Control.Monad -import OpenTelemetry.Eventlog -import Data.Text.Encoding (encodeUtf8) +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. diff --git a/install.hs b/install.hs index b89c7d053a..eed5492f66 100755 --- a/install.hs +++ b/install.hs @@ -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 diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index 0a4733daff..3435df6550 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -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" diff --git a/install/src/Env.hs b/install/src/Env.hs index fcdfc3f78b..23eaa2bc9c 100644 --- a/install/src/Env.hs +++ b/install/src/Env.hs @@ -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 qualified Data.Text as T +import System.Directory (findExecutable, findExecutables, + listDirectory) +import System.Info (os) + +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)] diff --git a/install/src/Help.hs b/install/src/Help.hs index f831f33f1f..e8a92a6e8b 100644 --- a/install/src/Help.hs +++ b/install/src/Help.hs @@ -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]" diff --git a/install/src/HlsInstall.hs b/install/src/HlsInstall.hs index 8f63235a27..463b38d0a0 100644 --- a/install/src/HlsInstall.hs +++ b/install/src/HlsInstall.hs @@ -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 diff --git a/install/src/Print.hs b/install/src/Print.hs index eb20854585..91b67ff95b 100644 --- a/install/src/Print.hs +++ b/install/src/Print.hs @@ -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 () diff --git a/install/src/Stack.hs b/install/src/Stack.hs index e21bf8d549..1ce9d2c382 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -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" diff --git a/install/src/Version.hs b/install/src/Version.hs index 4647004145..bbdb953617 100644 --- a/install/src/Version.hs +++ b/install/src/Version.hs @@ -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 diff --git a/nix/default.nix b/nix/default.nix index a846b4d54b..804b5a7203 100644 --- a/nix/default.nix +++ b/nix/default.nix @@ -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/.*$" ]; }; }; } diff --git a/plugins/default/src/Ide/Plugin/Brittany.hs b/plugins/default/src/Ide/Plugin/Brittany.hs index 977662d994..d61397cbe1 100644 --- a/plugins/default/src/Ide/Plugin/Brittany.hs +++ b/plugins/default/src/Ide/Plugin/Brittany.hs @@ -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 diff --git a/plugins/default/src/Ide/Plugin/Example.hs b/plugins/default/src/Ide/Plugin/Example.hs index 625d7ced56..4ef1528e4a 100644 --- a/plugins/default/src/Ide/Plugin/Example.hs +++ b/plugins/default/src/Ide/Plugin/Example.hs @@ -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) diff --git a/plugins/default/src/Ide/Plugin/Floskell.hs b/plugins/default/src/Ide/Plugin/Floskell.hs index 711b373be3..3d24c47235 100644 --- a/plugins/default/src/Ide/Plugin/Floskell.hs +++ b/plugins/default/src/Ide/Plugin/Floskell.hs @@ -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 () -- --------------------------------------------------------------------- diff --git a/plugins/default/src/Ide/Plugin/Fourmolu.hs b/plugins/default/src/Ide/Plugin/Fourmolu.hs index 002fdc0848..9186e2a007 100644 --- a/plugins/default/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/default/src/Ide/Plugin/Fourmolu.hs @@ -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 diff --git a/plugins/default/src/Ide/Plugin/ModuleName.hs b/plugins/default/src/Ide/Plugin/ModuleName.hs index 73eb27d160..326c9ccd4b 100644 --- a/plugins/default/src/Ide/Plugin/ModuleName.hs +++ b/plugins/default/src/Ide/Plugin/ModuleName.hs @@ -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 diff --git a/plugins/default/src/Ide/Plugin/Ormolu.hs b/plugins/default/src/Ide/Plugin/Ormolu.hs index 1a1cee45bc..e447b84062 100644 --- a/plugins/default/src/Ide/Plugin/Ormolu.hs +++ b/plugins/default/src/Ide/Plugin/Ormolu.hs @@ -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 () -- --------------------------------------------------------------------- diff --git a/plugins/default/src/Ide/Plugin/StylishHaskell.hs b/plugins/default/src/Ide/Plugin/StylishHaskell.hs index 1b18da0681..cfa3156d0c 100644 --- a/plugins/default/src/Ide/Plugin/StylishHaskell.hs +++ b/plugins/default/src/Ide/Plugin/StylishHaskell.hs @@ -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 diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs index 97f64a0597..2ed4c2e3f9 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs @@ -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) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs index d1b78e5136..b058a6a278 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs @@ -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 diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs index c5c8dc869a..0f65bfb232 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs @@ -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. diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs index 968f2df7a5..c081d07189 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs @@ -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 diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Option.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Option.hs index f1c70c1acd..ec2b6561a8 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Option.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Option.hs @@ -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 " diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs index d50b665278..63c30e1b1e 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs @@ -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) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs index 8406975c3e..82e3fcf9c3 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs @@ -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 diff --git a/plugins/hls-eval-plugin/test/Eval.hs b/plugins/hls-eval-plugin/test/Eval.hs index 8222208b67..9e05a942e6 100644 --- a/plugins/hls-eval-plugin/test/Eval.hs +++ b/plugins/hls-eval-plugin/test/Eval.hs @@ -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 = diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index cc2b3eecc0..a3aa1821fb 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -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 diff --git a/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs b/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs index 03175520ed..6ee8d0ff88 100644 --- a/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs +++ b/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs @@ -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 diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 63290406da..d93c22b234 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -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 Text.Regex.TDFA.Text() -import GHC.Generics (Generic) +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 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) diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index f7b7403291..9038ee9a52 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -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 = diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 577975c408..c0651de875 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -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, diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs index f44ba69d5a..728b653308 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs @@ -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 diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Auto.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Auto.hs index e07aa1dfb2..05bdb5c862 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Auto.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Auto.hs @@ -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 ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CaseSplit.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CaseSplit.hs index 33bdefe811..79ce781d4d 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CaseSplit.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CaseSplit.hs @@ -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 ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs index d84e2b7e43..e3959a629b 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs @@ -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 () diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs index c8714787e9..577e9ab94a 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs @@ -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 ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Context.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Context.hs index c67ec8c7bc..f13421b4e1 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Context.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Context.hs @@ -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 _ = [] diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Debug.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Debug.hs index f32562cc2e..a66fe016d2 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Debug.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Debug.hs @@ -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 diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/FeatureSet.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/FeatureSet.hs index 96008a4778..a5bf4b53c8 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/FeatureSet.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/FeatureSet.hs @@ -1,6 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Tactic.FeatureSet ( Feature (..) @@ -12,11 +11,11 @@ module Ide.Plugin.Tactic.FeatureSet , prettyFeatureSet ) where -import Data.List (intercalate) -import Data.Maybe (mapMaybe, listToMaybe) -import Data.Set (Set) -import qualified Data.Set as S -import qualified Data.Text as T +import Data.List (intercalate) +import Data.Maybe (listToMaybe, mapMaybe) +import Data.Set (Set) +import qualified Data.Set as S +import qualified Data.Text as T ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs index a3efa75a6b..b05952b1af 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs @@ -10,23 +10,25 @@ module Ide.Plugin.Tactic.GHC where import Control.Monad.State -import Data.Function (on) -import Data.List (isPrefixOf) -import qualified Data.Map as M -import Data.Maybe (isJust) -import Data.Set (Set) -import qualified Data.Set as S +import Data.Function (on) +import Data.List (isPrefixOf) +import qualified Data.Map as M +import Data.Maybe (isJust) +import Data.Set (Set) +import qualified Data.Set as S import Data.Traversable import DataCon import Development.IDE.GHC.Compat -import GHC.SourceGen (match, case', lambda) -import Generics.SYB (mkQ, everything, listify, Data, mkT, everywhere) +import GHC.SourceGen (case', lambda, match) +import Generics.SYB (Data, everything, everywhere, + listify, mkQ, mkT) import Ide.Plugin.Tactic.Types import OccName import TcType import TyCoRep import Type -import TysWiredIn (intTyCon, floatTyCon, doubleTyCon, charTyCon) +import TysWiredIn (charTyCon, doubleTyCon, floatTyCon, + intTyCon) import Unique import Var @@ -60,7 +62,7 @@ cloneTyVar t = -- | Is this a function type? isFunction :: Type -> Bool isFunction (tacticsSplitFunTy -> (_, _, [], _)) = False -isFunction _ = True +isFunction _ = True ------------------------------------------------------------------------------ @@ -94,7 +96,7 @@ freshTyvars t = do (mkT $ \tv -> case M.lookup tv reps of Just tv' -> tv' - Nothing -> tv + Nothing -> tv ) t @@ -137,7 +139,7 @@ containsHsVar :: Data a => RdrName -> a -> Bool containsHsVar name x = not $ null $ listify ( \case ((HsVar _ (L _ a)) :: HsExpr GhcPs) | eqRdrName a name -> True - _ -> False + _ -> False ) x @@ -147,7 +149,7 @@ containsHole :: Data a => a -> Bool containsHole x = not $ null $ listify ( \case ((HsVar _ (L _ name)) :: HsExpr GhcPs) -> isHole $ occName name - _ -> False + _ -> False ) x @@ -288,5 +290,5 @@ unXPat :: Pat GhcPs -> Pat GhcPs #if __GLASGOW_HASKELL__ == 808 unXPat (XPat (L _ pat)) = unXPat pat #endif -unXPat pat = pat +unXPat pat = pat diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Judgements.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Judgements.hs index 06d070548d..f2d830052a 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Judgements.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Judgements.hs @@ -30,17 +30,17 @@ module Ide.Plugin.Tactic.Judgements ) where import Control.Arrow -import Control.Lens hiding (Context) +import Control.Lens hiding (Context) import Data.Bool import Data.Char import Data.Coerce -import Data.Generics.Product (field) -import Data.Map (Map) -import qualified Data.Map as M +import Data.Generics.Product (field) +import Data.Map (Map) +import qualified Data.Map as M import Data.Maybe -import Data.Set (Set) -import qualified Data.Set as S -import DataCon (DataCon) +import Data.Set (Set) +import qualified Data.Set as S +import DataCon (DataCon) import Development.IDE.Spans.LocalBindings import Ide.Plugin.Tactic.Types import OccName @@ -272,7 +272,7 @@ disallowing :: DisallowReason -> [OccName] -> Judgement' a -> Judgement' a disallowing reason (S.fromList -> ns) = field @"_jHypothesis" %~ (\z -> Hypothesis . flip fmap (unHypothesis z) $ \hi -> case S.member (hi_name hi) ns of - True -> overProvenance (DisallowedPrv reason) hi + True -> overProvenance (DisallowedPrv reason) hi False -> hi ) @@ -404,4 +404,4 @@ isDisallowed _ = False -- | Eliminates 'DisallowedPrv' provenances. expandDisallowed :: Provenance -> Provenance expandDisallowed (DisallowedPrv _ prv) = expandDisallowed prv -expandDisallowed prv = prv +expandDisallowed prv = prv diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies.hs index ca42e15ac5..9686306257 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies.hs @@ -2,14 +2,14 @@ module Ide.Plugin.Tactic.KnownStrategies where -import Control.Monad.Error.Class -import Ide.Plugin.Tactic.Context (getCurrentDefinitions) -import Ide.Plugin.Tactic.Tactics -import Ide.Plugin.Tactic.Types -import OccName (mkVarOcc) -import Refinery.Tactic -import Ide.Plugin.Tactic.Machinery (tracing) -import Ide.Plugin.Tactic.KnownStrategies.QuickCheck (deriveArbitrary) +import Control.Monad.Error.Class +import Ide.Plugin.Tactic.Context (getCurrentDefinitions) +import Ide.Plugin.Tactic.KnownStrategies.QuickCheck (deriveArbitrary) +import Ide.Plugin.Tactic.Machinery (tracing) +import Ide.Plugin.Tactic.Tactics +import Ide.Plugin.Tactic.Types +import OccName (mkVarOcc) +import Refinery.Tactic knownStrategies :: TacticsM () diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies/QuickCheck.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies/QuickCheck.hs index 7c595a0b57..3fe2263995 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies/QuickCheck.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies/QuickCheck.hs @@ -2,27 +2,28 @@ module Ide.Plugin.Tactic.KnownStrategies.QuickCheck where -import Control.Monad.Except (MonadError(throwError)) -import Data.Bool (bool) -import Data.List (partition) -import DataCon ( DataCon, dataConName ) -import Development.IDE.GHC.Compat (HsExpr, GhcPs, noLoc) -import GHC.Exts ( IsString(fromString) ) -import GHC.List ( foldl' ) -import GHC.SourceGen (int) -import GHC.SourceGen.Binds ( match, valBind ) -import GHC.SourceGen.Expr ( case', lambda, let' ) -import GHC.SourceGen.Overloaded ( App((@@)), HasList(list) ) -import GHC.SourceGen.Pat ( conP ) -import Ide.Plugin.Tactic.CodeGen -import Ide.Plugin.Tactic.Judgements (jGoal) -import Ide.Plugin.Tactic.Machinery (tracePrim) -import Ide.Plugin.Tactic.Types -import OccName (occNameString, mkVarOcc, HasOccName(occName) ) -import Refinery.Tactic (goal, rule ) -import TyCon (tyConName, TyCon, tyConDataCons ) -import Type ( splitTyConApp_maybe ) -import Data.Generics (mkQ, everything) +import Control.Monad.Except (MonadError (throwError)) +import Data.Bool (bool) +import Data.Generics (everything, mkQ) +import Data.List (partition) +import DataCon (DataCon, dataConName) +import Development.IDE.GHC.Compat (GhcPs, HsExpr, noLoc) +import GHC.Exts (IsString (fromString)) +import GHC.List (foldl') +import GHC.SourceGen (int) +import GHC.SourceGen.Binds (match, valBind) +import GHC.SourceGen.Expr (case', lambda, let') +import GHC.SourceGen.Overloaded (App ((@@)), HasList (list)) +import GHC.SourceGen.Pat (conP) +import Ide.Plugin.Tactic.CodeGen +import Ide.Plugin.Tactic.Judgements (jGoal) +import Ide.Plugin.Tactic.Machinery (tracePrim) +import Ide.Plugin.Tactic.Types +import OccName (HasOccName (occName), mkVarOcc, + occNameString) +import Refinery.Tactic (goal, rule) +import TyCon (TyCon, tyConDataCons, tyConName) +import Type (splitTyConApp_maybe) ------------------------------------------------------------------------------ @@ -64,7 +65,7 @@ deriveArbitrary = do -- | Helper data type for the generator of a specific data con. data Generator = Generator { genRecursiveCount :: Integer - , genExpr :: HsExpr GhcPs + , genExpr :: HsExpr GhcPs } diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer/TacticProviders.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer/TacticProviders.hs index f564df2ba2..d495bb8d37 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer/TacticProviders.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer/TacticProviders.hs @@ -12,17 +12,17 @@ module Ide.Plugin.Tactic.LanguageServer.TacticProviders ) where import Control.Monad -import Control.Monad.Error.Class (MonadError(throwError)) +import Control.Monad.Error.Class (MonadError (throwError)) import Data.Aeson import Data.Coerce -import qualified Data.Map as M +import qualified Data.Map as M import Data.Maybe import Data.Monoid -import qualified Data.Text as T +import qualified Data.Text as T import Data.Traversable import Development.IDE.GHC.Compat import GHC.Generics -import GHC.LanguageExtensions.Type (Extension (LambdaCase)) +import GHC.LanguageExtensions.Type (Extension (LambdaCase)) import Ide.Plugin.Tactic.Auto import Ide.Plugin.Tactic.FeatureSet import Ide.Plugin.Tactic.GHC @@ -34,17 +34,17 @@ import Ide.PluginUtils import Ide.Types import Language.LSP.Types import OccName -import Prelude hiding (span) -import Refinery.Tactic (goal) +import Prelude hiding (span) +import Refinery.Tactic (goal) ------------------------------------------------------------------------------ -- | A mapping from tactic commands to actual tactics for refinery. commandTactic :: TacticCommand -> OccName -> TacticsM () -commandTactic Auto = const auto -commandTactic Intros = const intros -commandTactic Destruct = useNameFromHypothesis destruct -commandTactic Homomorphism = useNameFromHypothesis homo +commandTactic Auto = const auto +commandTactic Intros = const intros +commandTactic Destruct = useNameFromHypothesis destruct +commandTactic Homomorphism = useNameFromHypothesis homo commandTactic DestructLambdaCase = const destructLambdaCase commandTactic HomomorphismLambdaCase = const homoLambdaCase @@ -180,7 +180,7 @@ tcCommandId c = coerce $ T.pack $ "tactics" <> show c <> "Command" -- type, and that both are usual algebraic types. homoFilter :: Type -> Type -> Bool homoFilter (algebraicTyCon -> Just t1) (algebraicTyCon -> Just t2) = t1 == t2 -homoFilter _ _ = False +homoFilter _ _ = False ------------------------------------------------------------------------------ @@ -188,5 +188,5 @@ homoFilter _ _ = False -- algebraic types. destructFilter :: Type -> Type -> Bool destructFilter _ (algebraicTyCon -> Just _) = True -destructFilter _ _ = False +destructFilter _ _ = False diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs index a061aa43cd..ac1b18463d 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -6,6 +5,7 @@ {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -13,29 +13,29 @@ module Ide.Plugin.Tactic.Machinery ( module Ide.Plugin.Tactic.Machinery ) where -import Class (Class(classTyVars)) +import Class (Class (classTyVars)) import Control.Arrow import Control.Monad.Error.Class import Control.Monad.Reader -import Control.Monad.State (MonadState(..)) -import Control.Monad.State.Class (gets, modify) -import Control.Monad.State.Strict (StateT (..)) -import Data.Bool (bool) +import Control.Monad.State (MonadState (..)) +import Control.Monad.State.Class (gets, modify) +import Control.Monad.State.Strict (StateT (..)) +import Data.Bool (bool) import Data.Coerce import Data.Either import Data.Foldable -import Data.Functor ((<&>)) -import Data.Generics (mkQ, everything, gcount) -import Data.List (sortBy) -import qualified Data.Map as M -import Data.Ord (comparing, Down(..)) -import Data.Set (Set) -import qualified Data.Set as S +import Data.Functor ((<&>)) +import Data.Generics (everything, gcount, mkQ) +import Data.List (sortBy) +import qualified Data.Map as M +import Data.Ord (Down (..), comparing) +import Data.Set (Set) +import qualified Data.Set as S import Development.IDE.GHC.Compat import Ide.Plugin.Tactic.Judgements -import Ide.Plugin.Tactic.Simplify (simplify) +import Ide.Plugin.Tactic.Simplify (simplify) import Ide.Plugin.Tactic.Types -import OccName (HasOccName(occName)) +import OccName (HasOccName (occName)) import Refinery.ProofState import Refinery.Tactic import Refinery.Tactic.Internal @@ -204,7 +204,7 @@ tryUnifyUnivarsButNotSkolems skolems goal inst = [unCType inst] [unCType goal] of Unifiable subst -> pure subst - _ -> Nothing + _ -> Nothing diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Naming.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Naming.hs index fbc72dd7be..31944ad1dd 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Naming.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Naming.hs @@ -3,18 +3,18 @@ module Ide.Plugin.Tactic.Naming where import Control.Monad.State.Strict -import Data.Bool (bool) +import Data.Bool (bool) import Data.Char -import Data.Map (Map) -import qualified Data.Map as M -import Data.Set (Set) -import qualified Data.Set as S +import Data.Map (Map) +import qualified Data.Map as M +import Data.Set (Set) +import qualified Data.Set as S import Data.Traversable import Name import TcType import TyCon import Type -import TysWiredIn (listTyCon, pairTyCon, unitTyCon) +import TysWiredIn (listTyCon, pairTyCon, unitTyCon) ------------------------------------------------------------------------------ @@ -72,7 +72,7 @@ mkGoodName mkGoodName in_scope t = let tn = mkTyName t in mkVarOcc $ case S.member (mkVarOcc tn) in_scope of - True -> tn ++ show (length in_scope) + True -> tn ++ show (length in_scope) False -> tn diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Range.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Range.hs index 9bf5c17d54..3c8de54ee4 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Range.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Range.hs @@ -1,7 +1,7 @@ module Ide.Plugin.Tactic.Range where -import qualified FastString as FS import Development.IDE.Types.Location +import qualified FastString as FS import SrcLoc ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs index 2f5e5a4e0d..b89f290756 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs @@ -8,14 +8,15 @@ module Ide.Plugin.Tactic.Simplify ( simplify ) where -import Data.Generics (everywhere, mkT, GenericT) -import Data.List.Extra (unsnoc) -import Data.Monoid (Endo (..)) -import Development.IDE.GHC.Compat -import GHC.SourceGen (var) -import GHC.SourceGen.Expr (lambda) -import Ide.Plugin.Tactic.CodeGen.Utils -import Ide.Plugin.Tactic.GHC (fromPatCompatPs, containsHsVar) +import Data.Generics (GenericT, everywhere, mkT) +import Data.List.Extra (unsnoc) +import Data.Monoid (Endo (..)) +import Development.IDE.GHC.Compat +import GHC.SourceGen (var) +import GHC.SourceGen.Expr (lambda) +import Ide.Plugin.Tactic.CodeGen.Utils +import Ide.Plugin.Tactic.GHC (containsHsVar, + fromPatCompatPs) ------------------------------------------------------------------------------ @@ -93,7 +94,7 @@ simplifyCompose = mkT $ \case simplifyRemoveParens :: GenericT simplifyRemoveParens = mkT $ \case HsPar _ (L _ x) | isAtomicHsExpr x -> x - (x :: HsExpr GhcPs) -> x + (x :: HsExpr GhcPs) -> x ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Tactics.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Tactics.hs index 44c53b3d95..0e3c99d016 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Tactics.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Tactics.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Tactic.Tactics @@ -9,18 +9,18 @@ module Ide.Plugin.Tactic.Tactics , runTactic ) where -import Control.Monad (when) -import Control.Monad.Except (throwError) -import Control.Monad.Reader.Class (MonadReader(ask)) +import Control.Monad (when) +import Control.Monad.Except (throwError) +import Control.Monad.Reader.Class (MonadReader (ask)) import Control.Monad.State.Class -import Control.Monad.State.Strict (StateT(..), runStateT) -import Data.Bool (bool) +import Control.Monad.State.Strict (StateT (..), runStateT) +import Data.Bool (bool) import Data.Foldable import Data.List -import qualified Data.Map as M +import qualified Data.Map as M import Data.Maybe -import Data.Set (Set) -import qualified Data.Set as S +import Data.Set (Set) +import qualified Data.Set as S import DataCon import Development.IDE.GHC.Compat import GHC.Exts @@ -33,11 +33,11 @@ import Ide.Plugin.Tactic.Judgements import Ide.Plugin.Tactic.Machinery import Ide.Plugin.Tactic.Naming import Ide.Plugin.Tactic.Types -import Name (occNameString) +import Name (occNameString) import Refinery.Tactic import Refinery.Tactic.Internal import TcType -import Type hiding (Var) +import Type hiding (Var) ------------------------------------------------------------------------------ @@ -224,7 +224,7 @@ splitDataCon dc = case splitTyConApp_maybe $ unCType g of Just (tc, apps) -> do case elem dc $ tyConDataCons tc of - True -> buildDataCon (unwhitelistingSplit jdg) dc apps + True -> buildDataCon (unwhitelistingSplit jdg) dc apps False -> throwError $ IncorrectDataCon dc Nothing -> throwError $ GoalMismatch "splitDataCon" g diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/TestTypes.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/TestTypes.hs index 972ac4a35b..970e7b6671 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/TestTypes.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/TestTypes.hs @@ -2,9 +2,9 @@ module Ide.Plugin.Tactic.TestTypes where -import qualified Data.Text as T -import Data.Aeson -import Ide.Plugin.Tactic.FeatureSet +import Data.Aeson +import qualified Data.Text as T +import Ide.Plugin.Tactic.FeatureSet ------------------------------------------------------------------------------ -- | The list of tactics exposed to the outside world. These are attached to @@ -21,11 +21,11 @@ data TacticCommand -- | Generate a title for the command. tacticTitle :: TacticCommand -> T.Text -> T.Text -tacticTitle Auto _ = "Attempt to fill hole" -tacticTitle Intros _ = "Introduce lambda" -tacticTitle Destruct var = "Case split on " <> var -tacticTitle Homomorphism var = "Homomorphic case split on " <> var -tacticTitle DestructLambdaCase _ = "Lambda case split" +tacticTitle Auto _ = "Attempt to fill hole" +tacticTitle Intros _ = "Introduce lambda" +tacticTitle Destruct var = "Case split on " <> var +tacticTitle Homomorphism var = "Homomorphic case split on " <> var +tacticTitle DestructLambdaCase _ = "Lambda case split" tacticTitle HomomorphismLambdaCase _ = "Homomorphic lambda case split" diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Types.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Types.hs index 413b0f69b7..b42998a09f 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Types.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Types.hs @@ -20,26 +20,28 @@ module Ide.Plugin.Tactic.Types , Range ) where -import Control.Lens hiding (Context, (.=)) -import Control.Monad.Reader -import Control.Monad.State -import Data.Coerce -import Data.Function -import Data.Generics.Product (field) -import Data.Set (Set) -import Data.Tree -import Development.IDE.GHC.Compat hiding (Node) -import Development.IDE.GHC.Orphans () -import Development.IDE.Types.Location -import GHC.Generics -import Ide.Plugin.Tactic.Debug -import Ide.Plugin.Tactic.FeatureSet (FeatureSet) -import OccName -import Refinery.Tactic -import System.IO.Unsafe (unsafePerformIO) -import Type -import UniqSupply (takeUniqFromSupply, mkSplitUniqSupply, UniqSupply) -import Unique (nonDetCmpUnique, Uniquable, getUnique, Unique) +import Control.Lens hiding (Context, (.=)) +import Control.Monad.Reader +import Control.Monad.State +import Data.Coerce +import Data.Function +import Data.Generics.Product (field) +import Data.Set (Set) +import Data.Tree +import Development.IDE.GHC.Compat hiding (Node) +import Development.IDE.GHC.Orphans () +import Development.IDE.Types.Location +import GHC.Generics +import Ide.Plugin.Tactic.Debug +import Ide.Plugin.Tactic.FeatureSet (FeatureSet) +import OccName +import Refinery.Tactic +import System.IO.Unsafe (unsafePerformIO) +import Type +import UniqSupply (UniqSupply, mkSplitUniqSupply, + takeUniqFromSupply) +import Unique (Uniquable, Unique, getUnique, + nonDetCmpUnique) ------------------------------------------------------------------------------ @@ -79,13 +81,13 @@ instance Show (Pat GhcPs) where ------------------------------------------------------------------------------ data TacticState = TacticState - { ts_skolems :: !(Set TyVar) + { ts_skolems :: !(Set TyVar) -- ^ The known skolems. - , ts_unifier :: !TCvSubst + , ts_unifier :: !TCvSubst -- ^ The current substitution of univars. - , ts_used_vals :: !(Set OccName) + , ts_used_vals :: !(Set OccName) -- ^ Set of values used by tactics. - , ts_intro_vals :: !(Set OccName) + , ts_intro_vals :: !(Set OccName) -- ^ Set of values introduced by tactics. , ts_unused_top_vals :: !(Set OccName) -- ^ Set of currently unused arguments to the function being defined. @@ -95,7 +97,7 @@ data TacticState = TacticState -- value is 'False' are guaranteed to loop, and must be pruned. , ts_recursion_count :: !Int -- ^ Number of calls to recursion. We penalize each. - , ts_unique_gen :: !UniqSupply + , ts_unique_gen :: !UniqSupply } deriving stock (Show, Generic) instance Show UniqSupply where @@ -247,11 +249,11 @@ overProvenance f (HyInfo name prv ty) = HyInfo name (f prv) ty ------------------------------------------------------------------------------ -- | The current bindings and goal for a hole to be filled by refinery. data Judgement' a = Judgement - { _jHypothesis :: !(Hypothesis a) + { _jHypothesis :: !(Hypothesis a) , _jBlacklistDestruct :: !Bool - , _jWhitelistSplit :: !Bool - , _jIsTopHole :: !Bool - , _jGoal :: !a + , _jWhitelistSplit :: !Bool + , _jIsTopHole :: !Bool + , _jGoal :: !a } deriving stock (Eq, Generic, Functor, Show) @@ -335,9 +337,9 @@ type Trace = Rose String data Context = Context { ctxDefiningFuncs :: [(OccName, CType)] -- ^ The functions currently being defined - , ctxModuleFuncs :: [(OccName, CType)] + , ctxModuleFuncs :: [(OccName, CType)] -- ^ Everything defined in the current module - , ctxFeatureSet :: FeatureSet + , ctxFeatureSet :: FeatureSet } deriving stock (Eq, Ord, Show) diff --git a/plugins/hls-tactics-plugin/test/AutoTupleSpec.hs b/plugins/hls-tactics-plugin/test/AutoTupleSpec.hs index 328a1650a3..2681c0acc0 100644 --- a/plugins/hls-tactics-plugin/test/AutoTupleSpec.hs +++ b/plugins/hls-tactics-plugin/test/AutoTupleSpec.hs @@ -2,17 +2,17 @@ module AutoTupleSpec where -import Data.Either (isRight) -import Ide.Plugin.Tactic.Judgements (mkFirstJudgement) -import Ide.Plugin.Tactic.Machinery -import Ide.Plugin.Tactic.Tactics (auto') -import Ide.Plugin.Tactic.Types -import OccName (mkVarOcc) -import Test.Hspec -import Test.QuickCheck -import Type (mkTyVarTy) -import TysPrim (alphaTyVars) -import TysWiredIn (mkBoxedTupleTy) +import Data.Either (isRight) +import Ide.Plugin.Tactic.Judgements (mkFirstJudgement) +import Ide.Plugin.Tactic.Machinery +import Ide.Plugin.Tactic.Tactics (auto') +import Ide.Plugin.Tactic.Types +import OccName (mkVarOcc) +import Test.Hspec +import Test.QuickCheck +import Type (mkTyVarTy) +import TysPrim (alphaTyVars) +import TysWiredIn (mkBoxedTupleTy) spec :: Spec diff --git a/plugins/hls-tactics-plugin/test/GoldenSpec.hs b/plugins/hls-tactics-plugin/test/GoldenSpec.hs index 94c64a4abc..7a8b63e0d8 100644 --- a/plugins/hls-tactics-plugin/test/GoldenSpec.hs +++ b/plugins/hls-tactics-plugin/test/GoldenSpec.hs @@ -7,24 +7,27 @@ module GoldenSpec where -import Control.Applicative.Combinators ( skipManyTill ) -import Control.Lens hiding ((<.>), failing) -import Control.Monad (unless) +import Control.Applicative.Combinators (skipManyTill) +import Control.Lens hiding (failing, (<.>)) +import Control.Monad (unless) import Control.Monad.IO.Class import Data.Aeson -import Data.Default (Default(def)) +import Data.Default (Default (def)) import Data.Foldable -import qualified Data.Map as M +import qualified Data.Map as M import Data.Maybe -import Data.Text (Text) -import qualified Data.Text.IO as T -import qualified Ide.Plugin.Config as Plugin -import Ide.Plugin.Tactic.FeatureSet (FeatureSet, allFeatures) +import Data.Text (Text) +import qualified Data.Text.IO as T +import qualified Ide.Plugin.Config as Plugin +import Ide.Plugin.Tactic.FeatureSet (FeatureSet, allFeatures) import Ide.Plugin.Tactic.TestTypes import Language.LSP.Test import Language.LSP.Types -import Language.LSP.Types.Lens hiding (id, capabilities, message, executeCommand, applyEdit, rename, line, title, name, actions) -import System.Directory (doesFileExist) +import Language.LSP.Types.Lens hiding (actions, applyEdit, + capabilities, executeCommand, + id, line, message, name, + rename, title) +import System.Directory (doesFileExist) import System.FilePath import Test.Hspec @@ -128,7 +131,7 @@ pointRange ------------------------------------------------------------------------------ -- | Get the title of a code action. codeActionTitle :: (Command |? CodeAction) -> Maybe Text -codeActionTitle InL{} = Nothing +codeActionTitle InL{} = Nothing codeActionTitle (InR(CodeAction title _ _ _ _ _ _)) = Just title @@ -160,7 +163,7 @@ mkTest name fp line col ts = it name $ do setFeatureSet :: FeatureSet -> Session () setFeatureSet features = do let unObject (Object obj) = obj - unObject _ = undefined + unObject _ = undefined def_config = def :: Plugin.Config config = def_config diff --git a/plugins/hls-tactics-plugin/test/Server.hs b/plugins/hls-tactics-plugin/test/Server.hs index 521ab6b1fe..fd7f14fa9e 100644 --- a/plugins/hls-tactics-plugin/test/Server.hs +++ b/plugins/hls-tactics-plugin/test/Server.hs @@ -1,12 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} module Main(main) where import Data.Default import Development.IDE.Main import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide -import Ide.Plugin.Tactic as T +import Ide.Plugin.Tactic as T import Ide.PluginUtils main :: IO () diff --git a/plugins/hls-tactics-plugin/test/UnificationSpec.hs b/plugins/hls-tactics-plugin/test/UnificationSpec.hs index a5a21567ae..ef47cbd174 100644 --- a/plugins/hls-tactics-plugin/test/UnificationSpec.hs +++ b/plugins/hls-tactics-plugin/test/UnificationSpec.hs @@ -4,21 +4,21 @@ module UnificationSpec where import Control.Arrow -import Data.Bool (bool) -import Data.Functor ((<&>)) -import Data.Maybe (mapMaybe) -import qualified Data.Set as S +import Data.Bool (bool) +import Data.Functor ((<&>)) +import Data.Maybe (mapMaybe) +import qualified Data.Set as S import Data.Traversable -import Data.Tuple (swap) +import Data.Tuple (swap) import Ide.Plugin.Tactic.Debug import Ide.Plugin.Tactic.Machinery import Ide.Plugin.Tactic.Types -import TcType (tcGetTyVar_maybe, substTy) +import TcType (substTy, tcGetTyVar_maybe) import Test.Hspec import Test.QuickCheck -import Type (mkTyVarTy) -import TysPrim (alphaTyVars) -import TysWiredIn (mkBoxedTupleTy) +import Type (mkTyVarTy) +import TysPrim (alphaTyVars) +import TysWiredIn (mkBoxedTupleTy) instance Show Type where diff --git a/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs b/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs index 952b8e3476..ba66257007 100644 --- a/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs +++ b/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs @@ -1,8 +1,8 @@ data ADT = One | Two Int | Three | Four Bool ADT | Five case_split :: ADT -> Int -case_split One = _ -case_split (Two i) = _ -case_split Three = _ +case_split One = _ +case_split (Two i) = _ +case_split Three = _ case_split (Four b a) = _ -case_split Five = _ +case_split Five = _ diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs index 60435ffe25..10d54f3cde 100644 --- a/shake-bench/src/Development/Benchmark/Rules.hs +++ b/shake-bench/src/Development/Benchmark/Rules.hs @@ -1,13 +1,13 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE ApplicativeDo #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} {- | This module provides a bunch of Shake rules to build multiple revisions of a @@ -72,9 +72,12 @@ import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), (.!=), (.:?)) -import Data.List (find, isInfixOf, stripPrefix, transpose) +import Data.Char (isDigit) +import Data.List (find, isInfixOf, + stripPrefix, + transpose) import Data.List.Extra (lower) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import Development.Shake @@ -87,15 +90,16 @@ import GHC.Stack (HasCallStack) import qualified Graphics.Rendering.Chart.Backend.Diagrams as E import Graphics.Rendering.Chart.Easy ((.=)) import qualified Graphics.Rendering.Chart.Easy as E -import System.Directory (createDirectoryIfMissing, findExecutable, renameFile) +import System.Directory (createDirectoryIfMissing, + findExecutable, + renameFile) import System.FilePath +import System.Time.Extra (Seconds) import qualified Text.ParserCombinators.ReadP as P +import Text.Printf import Text.Read (Read (..), get, readMaybe, readP_to_Prec) -import Text.Printf -import Data.Char (isDigit) -import System.Time.Extra (Seconds) newtype GetExperiments = GetExperiments () deriving newtype (Binary, Eq, Hashable, NFData, Show) newtype GetVersions = GetVersions () deriving newtype (Binary, Eq, Hashable, NFData, Show) @@ -257,7 +261,7 @@ profilingP inp | Just delay <- stripPrefix "profiled-" inp, Just i <- readMaybe profilingP _ = Nothing profilingPath :: ProfilingMode -> FilePath -profilingPath NoProfiling = "unprofiled" +profilingPath NoProfiling = "unprofiled" profilingPath (CheapHeapProfiling i) = "profiled-" <> show i -- TODO generalize BuildSystem @@ -328,7 +332,7 @@ benchRules build MkBenchRules{..} = do liftIO $ renameFile "ghcide.eventlog" outEventlog liftIO $ case prof of CheapHeapProfiling{} -> renameFile "ghcide.hp" outHp - NoProfiling -> writeFile outHp dummyHp + NoProfiling -> writeFile outHp dummyHp -- extend csv output with allocation data csvContents <- liftIO $ lines <$> readFile outcsv @@ -352,7 +356,7 @@ parseMaxResidencyAndAllocations input = where inps = reverse $ lines input f label = case find (label `isInfixOf`) inps of - Just l -> read $ filter isDigit $ head $ words l + Just l -> read $ filter isDigit $ head $ words l Nothing -> -1 @@ -550,9 +554,9 @@ instance Read Frame where -- | A file path containing the output of -S for a given run data RunLog = RunLog - { runVersion :: !String, - runFrames :: ![Frame], - runSuccess :: !Bool + { runVersion :: !String, + runFrames :: ![Frame], + runSuccess :: !Bool } loadRunLog :: HasCallStack => Escaped FilePath -> String -> Action RunLog diff --git a/src/Ide/Arguments.hs b/src/Ide/Arguments.hs index cd0b5eff05..643769b2c9 100644 --- a/src/Ide/Arguments.hs +++ b/src/Ide/Arguments.hs @@ -1,10 +1,9 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 -{-# LANGUAGE CPP #-} -- To get precise GHC version +{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above module Ide.Arguments @@ -16,12 +15,12 @@ module Ide.Arguments , haskellLanguageServerNumericVersion ) where -import Data.Version -import Development.GitRev -import Options.Applicative -import Paths_haskell_language_server -import System.Environment -import HieDb.Run +import Data.Version +import Development.GitRev +import HieDb.Run +import Options.Applicative +import Paths_haskell_language_server +import System.Environment -- --------------------------------------------------------------------- @@ -32,17 +31,17 @@ data Arguments | LspMode LspArguments data LspArguments = LspArguments - {argLSP :: Bool - ,argsCwd :: Maybe FilePath - ,argFiles :: [FilePath] - ,argsShakeProfiling :: Maybe FilePath - ,argsTesting :: Bool - ,argsExamplePlugin :: Bool + {argLSP :: Bool + ,argsCwd :: Maybe FilePath + ,argFiles :: [FilePath] + ,argsShakeProfiling :: Maybe FilePath + ,argsTesting :: Bool + ,argsExamplePlugin :: Bool -- These next two are for compatibility with existing hie clients, allowing -- them to just change the name of the exe and still work. - , argsDebugOn :: Bool - , argsLogFile :: Maybe String - , argsThreads :: Int + , argsDebugOn :: Bool + , argsLogFile :: Maybe String + , argsThreads :: Int , argsProjectGhcVersion :: Bool } deriving Show @@ -122,7 +121,7 @@ haskellLanguageServerVersion = do path <- getExecutablePath let gitHashSection = case $(gitHash) of x | x == "UNKNOWN" -> "" - x -> " (GIT hash: " <> x <> ")" + x -> " (GIT hash: " <> x <> ")" return $ "haskell-language-server version: " <> haskellLanguageServerNumericVersion <> " (GHC: " <> VERSION_ghc <> ") (PATH: " <> path <> ")" diff --git a/src/Ide/Version.hs b/src/Ide/Version.hs index cc7aac19e2..f174290fc8 100644 --- a/src/Ide/Version.hs +++ b/src/Ide/Version.hs @@ -1,21 +1,21 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} -- | Information and display strings for HIE's version -- and the current project's version module Ide.Version where +import Data.Maybe (listToMaybe) +import Data.Version import Development.GitRev (gitCommitCount) import Options.Applicative.Simple (simpleVersion) import qualified Paths_haskell_language_server as Meta -import System.Info -import Data.Version -import Data.Maybe (listToMaybe) import System.Directory -import System.Process import System.Exit +import System.Info +import System.Process import Text.ParserCombinators.ReadP -- >>> hlsVersion @@ -37,7 +37,7 @@ hlsVersion = data ProgramsOfInterest = ProgramsOfInterest { cabalVersion :: Maybe Version , stackVersion :: Maybe Version - , ghcVersion :: Maybe Version + , ghcVersion :: Maybe Version } showProgramVersionOfInterest :: ProgramsOfInterest -> String @@ -67,7 +67,7 @@ findVersionOf tool = Just path -> readProcessWithExitCode path ["--numeric-version"] "" >>= \case (ExitSuccess, sout, _) -> pure $ consumeParser myVersionParser sout - _ -> pure Nothing + _ -> pure Nothing where myVersionParser = do skipSpaces diff --git a/test/functional/Command.hs b/test/functional/Command.hs index cd39bbf89d..4d5e67621f 100644 --- a/test/functional/Command.hs +++ b/test/functional/Command.hs @@ -1,16 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} module Command (tests) where -import Control.Lens hiding (List) -import Control.Monad.IO.Class -import qualified Data.Text as T -import Data.Char -import Language.LSP.Test -import Language.LSP.Types as LSP -import Language.LSP.Types.Lens as LSP -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.HUnit +import Control.Lens hiding (List) +import Control.Monad.IO.Class +import Data.Char +import qualified Data.Text as T +import Language.LSP.Test +import Language.LSP.Types as LSP +import Language.LSP.Types.Lens as LSP +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit tests :: TestTree tests = testGroup "commands" [ diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 2ff96754e6..5caf585e5b 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -2,19 +2,19 @@ {-# LANGUAGE ScopedTypeVariables #-} module Completion(tests) where -import Control.Monad.IO.Class -import Control.Lens hiding ((.=)) -import Data.Aeson (object, (.=)) -import Language.LSP.Test -import Language.LSP.Types -import Language.LSP.Types.Lens hiding (applyEdit) -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.ExpectedFailure (ignoreTestBecause) -import Test.Tasty.HUnit -import qualified Data.Text as T -import Data.Default (def) -import Ide.Plugin.Config (Config (maxCompletions)) +import Control.Lens hiding ((.=)) +import Control.Monad.IO.Class +import Data.Aeson (object, (.=)) +import Data.Default (def) +import qualified Data.Text as T +import Ide.Plugin.Config (Config (maxCompletions)) +import Language.LSP.Test +import Language.LSP.Types +import Language.LSP.Types.Lens hiding (applyEdit) +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit tests :: TestTree tests = testGroup "completions" [ diff --git a/test/functional/Config.hs b/test/functional/Config.hs index 8e25b244e6..70efc4bf86 100644 --- a/test/functional/Config.hs +++ b/test/functional/Config.hs @@ -2,19 +2,19 @@ module Config (tests) where -import Control.Lens hiding (List) import Control.Applicative.Combinators (skipManyTill) +import Control.Lens hiding (List) import Control.Monad import Control.Monad.IO.Class import Data.Aeson import Data.Default -import qualified Data.Map as Map -import qualified Data.Text as T +import qualified Data.Map as Map +import qualified Data.Text as T import Ide.Plugin.Config -import Language.LSP.Test as Test +import Language.LSP.Test as Test import Language.LSP.Types -import qualified Language.LSP.Types.Lens as L -import System.FilePath (()) +import qualified Language.LSP.Types.Lens as L +import System.FilePath (()) import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit diff --git a/test/functional/Deferred.hs b/test/functional/Deferred.hs index 91c2a19248..ff15873d46 100644 --- a/test/functional/Deferred.hs +++ b/test/functional/Deferred.hs @@ -1,21 +1,21 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module Deferred(tests) where -import Control.Applicative.Combinators -import Control.Monad.IO.Class -import Control.Lens hiding (List) +import Control.Applicative.Combinators +import Control.Lens hiding (List) +import Control.Monad.IO.Class -- import Control.Monad -- import Data.Maybe -import Language.LSP.Test -import Language.LSP.Types -import Language.LSP.Types.Lens hiding (id, message) +import Language.LSP.Test +import Language.LSP.Types +import Language.LSP.Types.Lens hiding (id, message) -- import qualified Language.LSP.Types.Lens as LSP -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.ExpectedFailure (ignoreTestBecause) -import Test.Tasty.HUnit +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit tests :: TestTree diff --git a/test/functional/Definition.hs b/test/functional/Definition.hs index ddf5529acd..c902d4e94a 100644 --- a/test/functional/Definition.hs +++ b/test/functional/Definition.hs @@ -1,15 +1,15 @@ module Definition (tests) where -import Control.Lens -import Control.Monad.IO.Class -import Language.LSP.Test -import Language.LSP.Types -import Language.LSP.Types.Lens -import System.Directory -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.ExpectedFailure (ignoreTestBecause) -import Test.Tasty.HUnit +import Control.Lens +import Control.Monad.IO.Class +import Language.LSP.Test +import Language.LSP.Types +import Language.LSP.Types.Lens +import System.Directory +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit tests :: TestTree tests = testGroup "definitions" [ diff --git a/test/functional/Diagnostic.hs b/test/functional/Diagnostic.hs index 26ea60616d..620401856c 100644 --- a/test/functional/Diagnostic.hs +++ b/test/functional/Diagnostic.hs @@ -2,18 +2,18 @@ module Diagnostic (tests) where -import Control.Applicative.Combinators -import Control.Lens hiding (List) +import Control.Applicative.Combinators +import Control.Lens hiding (List) import Control.Monad.IO.Class -import Data.Aeson (toJSON) +import Data.Aeson (toJSON) import qualified Data.Default import Ide.Plugin.Config -import Language.LSP.Test hiding (message) +import Language.LSP.Test hiding (message) import Language.LSP.Types -import qualified Language.LSP.Types.Lens as LSP +import qualified Language.LSP.Types.Lens as LSP import Test.Hls.Util import Test.Tasty -import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit -- --------------------------------------------------------------------- diff --git a/test/functional/Format.hs b/test/functional/Format.hs index 75968373b7..006e1cbdb5 100644 --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -1,21 +1,22 @@ -{-# LANGUAGE OverloadedStrings, CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Format (tests) where -import Control.Monad.IO.Class -import Data.Aeson -import qualified Data.ByteString.Lazy as BS -import qualified Data.Text.Encoding as T -import Language.LSP.Test -import Language.LSP.Types +import Control.Lens ((^.)) +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy as BS +import qualified Data.Text.Encoding as T +import Language.LSP.Test +import Language.LSP.Types import qualified Language.LSP.Types.Lens as LSP -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.Golden -import Test.Tasty.HUnit -import Control.Lens ((^.)) +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.Golden +import Test.Tasty.HUnit #if AGPL -import qualified Data.Text.IO as T +import qualified Data.Text.IO as T #endif tests :: TestTree diff --git a/test/functional/FunctionalBadProject.hs b/test/functional/FunctionalBadProject.hs index bca731f965..b84b19db4b 100644 --- a/test/functional/FunctionalBadProject.hs +++ b/test/functional/FunctionalBadProject.hs @@ -9,8 +9,8 @@ module FunctionalBadProject (tests) where -- import Language.LSP.Types as LSP -- import Language.LSP.Types.Lens as LSP hiding (contents, error ) -- import Test.Hls.Util -import Test.Tasty -import Test.Tasty.HUnit +import Test.Tasty +import Test.Tasty.HUnit -- --------------------------------------------------------------------- -- TODO: Currently this can not succeed, since such an error is thrown in "runActionWithContext" which diff --git a/test/functional/FunctionalLiquid.hs b/test/functional/FunctionalLiquid.hs index 5ecdab96e8..bec5264786 100644 --- a/test/functional/FunctionalLiquid.hs +++ b/test/functional/FunctionalLiquid.hs @@ -2,14 +2,14 @@ module FunctionalLiquid (tests) where -import Control.Lens hiding (List) +import Control.Lens hiding (List) import Control.Monad.IO.Class import Data.Aeson import Data.Default -import Language.LSP.Test hiding (message) -import Language.LSP.Types as LSP -import Language.LSP.Types.Lens as LSP hiding (contents) import Ide.Plugin.Config +import Language.LSP.Test hiding (message) +import Language.LSP.Types as LSP +import Language.LSP.Types.Lens as LSP hiding (contents) import Test.Hls.Util import Test.Tasty import Test.Tasty.ExpectedFailure (ignoreTestBecause) diff --git a/test/functional/HaddockComments.hs b/test/functional/HaddockComments.hs index acc650575f..5f88064f86 100644 --- a/test/functional/HaddockComments.hs +++ b/test/functional/HaddockComments.hs @@ -1,29 +1,29 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} module HaddockComments ( tests, ) where -import Control.Monad.IO.Class (liftIO) -import qualified Data.ByteString.Lazy as LBS -import Data.Foldable (find) -import Data.Maybe (mapMaybe) -import Data.Text (Text) -import Data.Text.Encoding (encodeUtf8) -import Language.LSP.Test -import Language.LSP.Types -import System.FilePath ((<.>), ()) -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.Golden -import Test.Tasty.HUnit +import Control.Monad.IO.Class (liftIO) +import qualified Data.ByteString.Lazy as LBS +import Data.Foldable (find) +import Data.Maybe (mapMaybe) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Language.LSP.Test +import Language.LSP.Types +import System.FilePath ((<.>), ()) +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.Golden +import Test.Tasty.HUnit tests :: TestTree tests = @@ -66,11 +66,11 @@ data GenCommentsType = Signature | Record toTitle :: GenCommentsType -> Text toTitle Signature = "Generate signature comments" -toTitle Record = "Generate fields comments" +toTitle Record = "Generate fields comments" caTitle :: (Command |? CodeAction) -> Maybe Text caTitle (InR CodeAction {_title}) = Just _title -caTitle _ = Nothing +caTitle _ = Nothing haddockCommentsPath :: String haddockCommentsPath = "test" "testdata" "haddockComments" diff --git a/test/functional/HieBios.hs b/test/functional/HieBios.hs index a8442b5d4a..f58bda3fb1 100644 --- a/test/functional/HieBios.hs +++ b/test/functional/HieBios.hs @@ -1,16 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} module HieBios (tests) where -import Control.Lens ((^.)) -import Control.Monad.IO.Class -import qualified Data.Text as T -import Language.LSP.Test -import Language.LSP.Types +import Control.Lens ((^.)) +import Control.Monad.IO.Class +import qualified Data.Text as T +import Language.LSP.Test +import Language.LSP.Types import qualified Language.LSP.Types.Lens as L -import System.FilePath (()) -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.HUnit +import System.FilePath (()) +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit tests :: TestTree tests = testGroup "hie-bios" [ diff --git a/test/functional/Highlight.hs b/test/functional/Highlight.hs index 6457c120a6..a92e6e2686 100644 --- a/test/functional/Highlight.hs +++ b/test/functional/Highlight.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} module Highlight (tests) where -import Control.Monad.IO.Class -import Language.LSP.Test -import Language.LSP.Types -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.HUnit +import Control.Monad.IO.Class +import Language.LSP.Test +import Language.LSP.Types +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit tests :: TestTree tests = testGroup "highlight" [ diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 7b3846ba67..b865f96cf1 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -1,34 +1,32 @@ module Main where -import Class -import Command -import Completion -import Config -import Deferred -import Definition -import Diagnostic -import Eval -import Format -import FunctionalBadProject -import FunctionalCodeAction -import FunctionalLiquid -import HaddockComments -import HieBios -import Highlight -import ModuleName -import Progress -import Reference -import Rename -import Symbol -import Splice -import Test.Tasty -import Test.Tasty.Ingredients.Rerun -import Test.Tasty.Runners ( - consoleTestReporter, - listingTests, - ) -import Test.Tasty.Runners.AntXML -import TypeDefinition +import Class +import Command +import Completion +import Config +import Deferred +import Definition +import Diagnostic +import Eval +import Format +import FunctionalBadProject +import FunctionalCodeAction +import FunctionalLiquid +import HaddockComments +import HieBios +import Highlight +import ModuleName +import Progress +import Reference +import Rename +import Splice +import Symbol +import Test.Tasty +import Test.Tasty.Ingredients.Rerun +import Test.Tasty.Runners (consoleTestReporter, + listingTests) +import Test.Tasty.Runners.AntXML +import TypeDefinition main :: IO () main = diff --git a/test/functional/Progress.hs b/test/functional/Progress.hs index 9df8de0fa6..31d0680276 100644 --- a/test/functional/Progress.hs +++ b/test/functional/Progress.hs @@ -1,30 +1,31 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} module Progress (tests) where -import Control.Applicative.Combinators -import Control.Lens hiding ((.=)) -import Control.Monad.IO.Class -import Data.Aeson (Value, decode, encode, object, toJSON, (.=)) -import Data.Default -import Data.List (delete) -import Data.Maybe (fromJust) -import Data.Text (Text, pack) -import Ide.Plugin.Config -import Language.LSP.Test -import Language.LSP.Types -import Language.LSP.Types.Capabilities -import qualified Language.LSP.Types.Lens as L -import System.FilePath (()) -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.ExpectedFailure (ignoreTestBecause) -import Test.Tasty.HUnit +import Control.Applicative.Combinators +import Control.Lens hiding ((.=)) +import Control.Monad.IO.Class +import Data.Aeson (Value, decode, encode, object, + toJSON, (.=)) +import Data.Default +import Data.List (delete) +import Data.Maybe (fromJust) +import Data.Text (Text, pack) +import Ide.Plugin.Config +import Language.LSP.Test +import Language.LSP.Types +import Language.LSP.Types.Capabilities +import qualified Language.LSP.Types.Lens as L +import System.FilePath (()) +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit tests :: TestTree tests = diff --git a/test/functional/Reference.hs b/test/functional/Reference.hs index dabfa4a9d1..26eb5571ef 100644 --- a/test/functional/Reference.hs +++ b/test/functional/Reference.hs @@ -1,16 +1,16 @@ module Reference (tests) where -import Control.Lens -import Control.Monad.IO.Class -import Data.List -import Language.LSP.Test -import Language.LSP.Types -import Language.LSP.Types.Lens -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.ExpectedFailure (ignoreTestBecause) -import Test.Tasty.HUnit -import Data.Coerce +import Control.Lens +import Control.Monad.IO.Class +import Data.Coerce +import Data.List +import Language.LSP.Test +import Language.LSP.Types +import Language.LSP.Types.Lens +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit tests :: TestTree tests = testGroup "references" [ diff --git a/test/functional/Rename.hs b/test/functional/Rename.hs index 576bbaf6c8..98fbed1a57 100644 --- a/test/functional/Rename.hs +++ b/test/functional/Rename.hs @@ -1,13 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} module Rename (tests) where -import Control.Monad.IO.Class (liftIO) -import Language.LSP.Test -import Language.LSP.Types -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Control.Monad.IO.Class (liftIO) +import Language.LSP.Test +import Language.LSP.Types +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit tests :: TestTree tests = testGroup "rename" [ diff --git a/test/functional/Splice.hs b/test/functional/Splice.hs index a0c5f02e65..ad28d8040d 100644 --- a/test/functional/Splice.hs +++ b/test/functional/Splice.hs @@ -1,29 +1,29 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} module Splice (tests) where -import Control.Applicative.Combinators -import Control.Monad -import Control.Monad.IO.Class -import Data.List (find) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Ide.Plugin.Splice.Types -import Language.LSP.Test -import Language.LSP.Types -import System.Directory -import System.FilePath -import System.Time.Extra (sleep) -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.HUnit +import Control.Applicative.Combinators +import Control.Monad +import Control.Monad.IO.Class +import Data.List (find) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Ide.Plugin.Splice.Types +import Language.LSP.Test +import Language.LSP.Types +import System.Directory +import System.FilePath +import System.Time.Extra (sleep) +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit tests :: TestTree tests = @@ -130,5 +130,5 @@ pointRange -- | Get the title of a code action. codeActionTitle :: (Command |? CodeAction) -> Maybe Text -codeActionTitle InL{} = Nothing +codeActionTitle InL{} = Nothing codeActionTitle (InR(CodeAction title _ _ _ _ _ _)) = Just title diff --git a/test/functional/Symbol.hs b/test/functional/Symbol.hs index 04af41ede0..2dba0bd65b 100644 --- a/test/functional/Symbol.hs +++ b/test/functional/Symbol.hs @@ -1,17 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} module Symbol (tests) where -import Control.Lens (to, ix, (^?), _Just) -import Control.Monad.IO.Class -import Data.List -import Language.LSP.Test as Test -import Language.LSP.Types -import qualified Language.LSP.Types.Lens as L -import Language.LSP.Types.Capabilities -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.ExpectedFailure (ignoreTestBecause) -import Test.Tasty.HUnit +import Control.Lens (_Just, ix, to, (^?)) +import Control.Monad.IO.Class +import Data.List +import Language.LSP.Test as Test +import Language.LSP.Types +import Language.LSP.Types.Capabilities +import qualified Language.LSP.Types.Lens as L +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit tests :: TestTree tests = testGroup "document symbols" [ diff --git a/test/functional/TypeDefinition.hs b/test/functional/TypeDefinition.hs index 4bf49efb84..4f5d780f3a 100644 --- a/test/functional/TypeDefinition.hs +++ b/test/functional/TypeDefinition.hs @@ -1,13 +1,13 @@ module TypeDefinition (tests) where -import Control.Monad.IO.Class -import Data.Tuple.Extra (first3) -import Language.LSP.Test -import Language.LSP.Types -import System.FilePath (()) -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.HUnit +import Control.Monad.IO.Class +import Data.Tuple.Extra (first3) +import Language.LSP.Test +import Language.LSP.Types +import System.FilePath (()) +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit tests :: TestTree tests = testGroup "type definitions" [ diff --git a/test/wrapper/Main.hs b/test/wrapper/Main.hs index 6a8c19be38..b91dd5b5a3 100644 --- a/test/wrapper/Main.hs +++ b/test/wrapper/Main.hs @@ -1,12 +1,13 @@ -import Data.List.Extra (trimEnd) -import Data.Maybe -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.Ingredients.Rerun -import Test.Tasty.Runners ( listingTests, consoleTestReporter) -import System.Process -import System.Environment +import Data.List.Extra (trimEnd) +import Data.Maybe +import System.Environment +import System.Process +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Ingredients.Rerun +import Test.Tasty.Runners (consoleTestReporter, + listingTests) main :: IO () main = do