Merge branch 'master' into optionalProgressReporting

Author: pepeiborra

.github/workflows/test.yml

@@ -135,3 +135,9 @@ jobs:
         if: ${{ matrix.test }}
         run: LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-tactics-plugin --test-options="-j1"
 
+      - name: Test brittany plugin
+        if: ${{ matrix.test }}
+        env:
+          HLS_TEST_EXE: hls
+          HLS_WRAPPER_TEST_EXE: hls-wrapper
+        run: cabal test hls-brittany-plugin || cabal test hls-brittany-plugin --test-options="-j1"

README.md

@@ -301,7 +301,7 @@ For example, `haskell-language-server` allows you to choose the formatting provi
 This option obviously would not make sense for language servers for other languages, or even for other Haskell language servers (which need not even support formatting).
 
 Here is a list of the additional settings currently supported by `haskell-language-server`, along with their setting key (you may not need to know this) and default:
-- Formatting provider (`haskell.formattingProvider`, default `ormolu`): what formatter to use; one of `floskell`, `ormolu`, `fourmolu`, `stylish-haskell`, or `brittany` (if compiled with AGPL)
+- Formatting provider (`haskell.formattingProvider`, default `ormolu`): what formatter to use; one of `floskell`, `ormolu`, `fourmolu`, `stylish-haskell`, or `brittany` (if compiled with the brittany plugin)
 - Format on imports (`haskell.formatOnImportOn`, default true): whether to format after adding an import
 - Maximum number of problems to report (`haskell.maxNumberOfProblems`, default 100): the maximum number of problems the server will send to the client
 - Diagnostics on change (`haskell.diagnosticsOnChange`, default true): (currently unused)
@@ -648,7 +648,7 @@ This issue should be fixed in Stack versions >= 2.5.
 #### Problems with dynamic linking
 
 As haskell-language-server prebuilt binaries are statically linked, they don't play well with projects using dynamic linking.
-An usual symptom is the presence of errors containing `unknown symbol` and it is typical in arch linux, where a dynamically linked version of ghc is used. 
+An usual symptom is the presence of errors containing `unknown symbol` and it is typical in arch linux, where a dynamically linked version of ghc is used.
 
 The workaround is to use a version of haskell-language-server compiled from source with `-dynamic` enabled`. See more details [here](https://github.com/haskell/haskell-language-server/issues/1160#issuecomment-756566273).
 

cabal.project

@@ -5,6 +5,7 @@ packages:
          ./ghcide
          ./hls-plugin-api
          ./plugins/hls-tactics-plugin
+         ./plugins/hls-brittany-plugin
          ./plugins/hls-class-plugin
          ./plugins/hls-eval-plugin
          ./plugins/hls-explicit-imports-plugin

docs/plugin-tutorial.md

@@ -96,9 +96,7 @@ idePlugins = pluginDescToIdePlugins allPlugins
       , Ormolu.descriptor   "ormolu"
       , StylishHaskell.descriptor "stylish-haskell"
       , Retrie.descriptor "retrie"
-#if AGPL
       , Brittany.descriptor    "brittany"
-#endif
       , Eval.descriptor "eval"
       ]
 ```

exe/Plugins.hs

@@ -71,7 +71,7 @@ import           Ide.Plugin.Ormolu                 as Ormolu
 import           Ide.Plugin.StylishHaskell         as StylishHaskell
 #endif
 
-#if AGPL && brittany
+#if brittany
 import           Ide.Plugin.Brittany               as Brittany
 #endif
 

ghcide/exe/Main.hs

@@ -88,7 +88,7 @@ main = do
                 Typecheck x | not argLSP -> Just x
                 _                        -> Nothing
 
-            ,Main.argsLogger = logger
+            ,Main.argsLogger = pure logger
 
             ,Main.argsRules = do
                 -- install the main and ghcide-plugin rules

ghcide/ghcide.cabal

@@ -2,7 +2,7 @@ cabal-version:      2.2
 build-type:         Simple
 category:           Development
 name:               ghcide
-version:            1.0.0.0
+version:            1.1.0.0
 license:            Apache-2.0
 license-file:       LICENSE
 author:             Digital Asset and Ghcide contributors

ghcide/session-loader/Development/IDE/Session.hs

@@ -395,8 +395,8 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
            lfp <- flip makeRelative cfp <$> getCurrentDirectory
            logInfo logger $ T.pack ("Consulting the cradle for " <> show lfp)
 
-           when (isNothing hieYaml) $ mRunLspT lspEnv $
-             sendNotification SWindowShowMessage $ notifyUserImplicitCradle lfp
+           when (isNothing hieYaml) $
+             logWarning logger $ implicitCradleWarning lfp
 
            cradle <- maybe (loadImplicitHieCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
 
@@ -820,8 +820,8 @@ getCacheDirsDefault prefix opts = do
 cacheDir :: String
 cacheDir = "ghcide"
 
-notifyUserImplicitCradle:: FilePath -> ShowMessageParams
-notifyUserImplicitCradle fp =ShowMessageParams MtWarning $
+implicitCradleWarning :: FilePath -> T.Text
+implicitCradleWarning fp =
   "No [cradle](https://github.com/mpickering/hie-bios#hie-bios) found for "
   <> T.pack fp <>
   ".\n Proceeding with [implicit cradle](https://hackage.haskell.org/package/implicit-hie).\n"<>

ghcide/src/Development/IDE/Core/FileExists.hs

@@ -101,7 +101,7 @@ modifyFileExists state changes = do
     modifyVar_ var $ evaluate . HashMap.union changesMap
     -- See Note [Invalidating file existence results]
     -- flush previous values
-    mapM_ (deleteValue state GetFileExists) (HashMap.keys changesMap)
+    mapM_ (deleteValue (shakeExtras state) GetFileExists) (HashMap.keys changesMap)
 
 fromChange :: FileChangeType -> Maybe Bool
 fromChange FcCreated = Just True

ghcide/src/Development/IDE/Core/FileStore.hs

@@ -15,7 +15,9 @@ module Development.IDE.Core.FileStore(
     makeVFSHandle,
     makeLSPVFSHandle,
     isFileOfInterestRule
-    ,resetFileStore) where
+    ,resetFileStore
+    ,resetInterfaceStore
+    ) where
 
 import           Control.Concurrent.Extra
 import           Control.Concurrent.STM                       (atomically)
@@ -67,6 +69,7 @@ import           Language.LSP.Types                           (FileChangeType (F
                                                                FileEvent (FileEvent),
                                                                uriToFilePath, toNormalizedFilePath)
 import           Language.LSP.VFS
+import           System.FilePath
 
 makeVFSHandle :: IO VFSHandle
 makeVFSHandle = do
@@ -111,7 +114,7 @@ getModificationTimeRule vfs isWatched =
                 pure (Just $ BS.pack $ show ver, ([], Just $ VFSVersion ver))
             Nothing -> do
                 isWF <- isWatched file
-                unless isWF alwaysRerun
+                unless (isWF || isInterface file) alwaysRerun
                 liftIO $ fmap wrap (getModTime file')
                     `catch` \(e :: IOException) -> do
                         let err | isDoesNotExistError e = "File does not exist: " ++ file'
@@ -121,6 +124,18 @@ getModificationTimeRule vfs isWatched =
                             then return (Nothing, ([], Nothing))
                             else return (Nothing, ([diag], Nothing))
 
+-- | Interface files cannot be watched, since they live outside the workspace.
+--   But interface files are private, in that only HLS writes them.
+--   So we implement watching ourselves, and bypass the need for alwaysRerun.
+isInterface :: NormalizedFilePath -> Bool
+isInterface f = takeExtension (fromNormalizedFilePath f) `elem` [".hi", ".hi-boot"]
+
+-- | Reset the GetModificationTime state of interface files
+resetInterfaceStore :: ShakeExtras -> NormalizedFilePath -> IO ()
+resetInterfaceStore state f = do
+    deleteValue state (GetModificationTime_ True) f
+    deleteValue state (GetModificationTime_ False) f
+
 -- | Reset the GetModificationTime state of watched files
 resetFileStore :: IdeState -> [FileEvent] -> IO ()
 resetFileStore ideState changes = mask $ \_ ->
@@ -134,8 +149,8 @@ resetFileStore ideState changes = mask $ \_ ->
                   OfInterestVar foisVar <- getIdeGlobalExtras (shakeExtras ideState)
                   fois <- readVar foisVar
                   unless (HM.member (toNormalizedFilePath f) fois) $ do
-                    deleteValue ideState (GetModificationTime_ True) (toNormalizedFilePath' f)
-                    deleteValue ideState (GetModificationTime_ False) (toNormalizedFilePath' f)
+                    deleteValue (shakeExtras ideState) (GetModificationTime_ True) (toNormalizedFilePath' f)
+                    deleteValue (shakeExtras ideState) (GetModificationTime_ False) (toNormalizedFilePath' f)
             _ -> pure ()
 
 -- Dir.getModificationTime is surprisingly slow since it performs

ghcide/src/Development/IDE/Core/Rules.hs

@@ -86,7 +86,7 @@ import           Data.Tuple.Extra
 import           Development.IDE.Core.Compile
 import           Development.IDE.Core.FileExists
 import           Development.IDE.Core.FileStore               (getFileContents,
-                                                               modificationTime)
+                                                               modificationTime, resetInterfaceStore)
 import           Development.IDE.Core.OfInterest
 import           Development.IDE.Core.PositionMapping
 import           Development.IDE.Core.RuleTypes
@@ -922,7 +922,7 @@ getModIfaceRule = defineEarlyCutoff $ \GetModIface f -> do
       hiDiags <- case hiFile of
         Just hiFile
           | OnDisk <- status
-          , not (tmrDeferedError tmr) -> liftIO $ writeHiFile hsc hiFile
+          , not (tmrDeferedError tmr) -> writeHiFileAction hsc hiFile
         _ -> pure []
       return (fp, (diags++hiDiags, hiFile))
     NotFOI -> do
@@ -991,7 +991,7 @@ regenerateHiFile sess f ms compNeeded = do
                     -- We don't write the `.hi` file if there are defered errors, since we won't get
                     -- accurate diagnostics next time if we do
                     hiDiags <- if not $ tmrDeferedError tmr
-                               then liftIO $ writeHiFile hsc hiFile
+                               then writeHiFileAction hsc hiFile
                                else pure []
 
                     pure (hiDiags <> gDiags <> concat wDiags)
@@ -1090,6 +1090,14 @@ needsCompilationRule = defineEarlyCutoff $ \NeedsCompilation file -> do
 newtype CompiledLinkables = CompiledLinkables { getCompiledLinkables :: Var (ModuleEnv UTCTime) }
 instance IsIdeGlobal CompiledLinkables
 
+writeHiFileAction :: HscEnv -> HiFileResult -> Action [FileDiagnostic]
+writeHiFileAction hsc hiFile = do
+    extras <- getShakeExtras
+    let targetPath = ml_hi_file $ ms_location $ hirModSummary hiFile
+    liftIO $ do
+        resetInterfaceStore extras $ toNormalizedFilePath' targetPath
+        writeHiFile hsc hiFile
+
 -- | A rule that wires per-file rules together
 mainRule :: Rules ()
 mainRule = do

ghcide/src/Development/IDE/Core/Shake.hs

@@ -420,11 +420,11 @@ setValues state key file val diags = modifyVar_ state $ \vals -> do
 -- | Delete the value stored for a given ide build key
 deleteValue
   :: (Typeable k, Hashable k, Eq k, Show k)
-  => IdeState
+  => ShakeExtras
   -> k
   -> NormalizedFilePath
   -> IO ()
-deleteValue IdeState{shakeExtras = ShakeExtras{state}} key file = modifyVar_ state $ \vals ->
+deleteValue ShakeExtras{state} key file = modifyVar_ state $ \vals ->
     evaluate $ HMap.delete (file, Key key) vals
 
 -- | We return Nothing if the rule has not run and Just Failed if it has failed to produce a value.

ghcide/src/Development/IDE/LSP/LanguageServer.hs

@@ -200,7 +200,11 @@ cancelHandler cancelRequest = LSP.notificationHandler SCancelRequest $ \Notifica
   liftIO $ cancelRequest (SomeLspId _id)
 
 exitHandler :: IO () -> LSP.Handlers (ServerM c)
-exitHandler exit = LSP.notificationHandler SExit (const $ liftIO exit)
+exitHandler exit = LSP.notificationHandler SExit $ const $ do
+    (_, ide) <- ask
+    -- flush out the Shake session to record a Shake profile if applicable
+    liftIO $ restartShakeSession (shakeExtras ide) []
+    liftIO exit
 
 modifyOptions :: LSP.Options -> LSP.Options
 modifyOptions x = x{ LSP.textDocumentSync   = Just $ tweakTDS origTDS