Merge branch 'master' into ghcide-ca

Author: jneira

.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.hs

@@ -12,7 +12,8 @@ import           Development.IDE.Core.IdeConfiguration as X (IdeConfiguration (.
                                                              isWorkspaceFile)
 import           Development.IDE.Core.OfInterest       as X (getFilesOfInterest)
 import           Development.IDE.Core.RuleTypes        as X
-import           Development.IDE.Core.Rules            as X (getAtPoint,
+import           Development.IDE.Core.Rules            as X (IsHiFileStable (..),
+                                                             getAtPoint,
                                                              getClientConfigAction,
                                                              getDefinition,
                                                              getParsedModule,
@@ -21,10 +22,12 @@ import           Development.IDE.Core.Service          as X (runAction)
 import           Development.IDE.Core.Shake            as X (FastResult (..),
                                                              IdeAction (..),
                                                              IdeRule, IdeState,
+                                                             RuleBody (..),
                                                              ShakeExtras,
                                                              actionLogger,
                                                              define,
                                                              defineEarlyCutoff,
+                                                             defineNoDiagnostics,
                                                              getClientConfig,
                                                              getPluginConfig,
                                                              ideLogger,

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

@@ -115,15 +115,12 @@ import           Control.Concurrent.STM            hiding (orElse)
 import           Data.Aeson                        (toJSON)
 import           Data.Binary
 import           Data.Binary.Put
-import           Data.Bits                         (shiftR)
 import qualified Data.ByteString.Lazy              as LBS
 import           Data.Coerce
 import           Data.Functor
 import qualified Data.HashMap.Strict               as HashMap
 import           Data.Tuple.Extra                  (dupe)
 import           Data.Unique
-import           Data.Word
-import           Foreign.Marshal.Array             (withArrayLen)
 import           GHC.Fingerprint
 import qualified Language.LSP.Server               as LSP
 import qualified Language.LSP.Types                as LSP

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

@@ -103,7 +103,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
@@ -200,7 +200,7 @@ fileExistsRules lspEnv vfs = do
 -- Requires an lsp client that provides WatchedFiles notifications, but assumes that this has already been checked.
 fileExistsRulesFast :: (NormalizedFilePath -> Action Bool) -> VFSHandle -> Rules ()
 fileExistsRulesFast isWatched vfs =
-    defineEarlyCutoff $ \GetFileExists file -> do
+    defineEarlyCutoff $ RuleNoDiagnostics $ \GetFileExists file -> do
         isWF <- isWatched file
         if isWF
             then fileExistsFast vfs file
@@ -222,7 +222,7 @@ For the VFS lookup, however, we won't get prompted to flush the result, so inste
 we use 'alwaysRerun'.
 -}
 
-fileExistsFast :: VFSHandle -> NormalizedFilePath -> Action (Maybe BS.ByteString, ([a], Maybe Bool))
+fileExistsFast :: VFSHandle -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool)
 fileExistsFast vfs file = do
     -- Could in principle use 'alwaysRerun' here, but it's too slwo, See Note [Invalidating file existence results]
     mp <- getFileExistsMapUntracked
@@ -233,21 +233,21 @@ fileExistsFast vfs file = do
       -- 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
-    pure (summarizeExists exist, ([], Just exist))
+    pure (summarizeExists exist, Just exist)
 
 summarizeExists :: Bool -> Maybe BS.ByteString
 summarizeExists x = Just $ if x then BS.singleton 1 else BS.empty
 
 fileExistsRulesSlow :: VFSHandle -> Rules ()
 fileExistsRulesSlow vfs =
-  defineEarlyCutoff $ \GetFileExists file -> fileExistsSlow vfs file
+  defineEarlyCutoff $ RuleNoDiagnostics $ \GetFileExists file -> fileExistsSlow vfs file
 
-fileExistsSlow :: VFSHandle -> NormalizedFilePath -> Action (Maybe BS.ByteString, ([a], Maybe Bool))
+fileExistsSlow :: VFSHandle -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool)
 fileExistsSlow vfs file = do
     -- See Note [Invalidating file existence results]
     alwaysRerun
     exist <- liftIO $ getFileExistsVFS vfs file
-    pure (summarizeExists exist, ([], Just exist))
+    pure (summarizeExists exist, Just exist)
 
 getFileExistsVFS :: VFSHandle -> NormalizedFilePath -> IO Bool
 getFileExistsVFS vfs file = do

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

@@ -14,8 +14,13 @@ module Development.IDE.Core.FileStore(
     VFSHandle,
     makeVFSHandle,
     makeLSPVFSHandle,
-    isFileOfInterestRule
-    ,resetFileStore) where
+    isFileOfInterestRule,
+    resetFileStore,
+    resetInterfaceStore,
+    getModificationTimeImpl,
+    addIdeGlobal,
+    getFileContentsImpl
+    ) where
 
 import           Control.Concurrent.Extra
 import           Control.Concurrent.STM                       (atomically)
@@ -31,7 +36,8 @@ 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, OfInterestVar(..))
+import           Development.IDE.Core.OfInterest              (OfInterestVar (..),
+                                                               getFilesOfInterest)
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake
 import           Development.IDE.GHC.Orphans                  ()
@@ -65,8 +71,11 @@ import           Language.LSP.Server                          hiding
 import qualified Language.LSP.Server                          as LSP
 import           Language.LSP.Types                           (FileChangeType (FcChanged),
                                                                FileEvent (FileEvent),
-                                                               uriToFilePath, toNormalizedFilePath)
+                                                               NormalizedFilePath (NormalizedFilePath),
+                                                               toNormalizedFilePath,
+                                                               uriToFilePath)
 import           Language.LSP.VFS
+import           System.FilePath
 
 makeVFSHandle :: IO VFSHandle
 makeVFSHandle = do
@@ -91,14 +100,22 @@ makeLSPVFSHandle lspEnv = VFSHandle
 
 
 isFileOfInterestRule :: Rules ()
-isFileOfInterestRule = defineEarlyCutoff $ \IsFileOfInterest f -> do
+isFileOfInterestRule = defineEarlyCutoff $ RuleNoDiagnostics $ \IsFileOfInterest f -> do
     filesOfInterest <- getFilesOfInterest
     let res = maybe NotFOI IsFOI $ f `HM.lookup` filesOfInterest
-    return (Just $ BS.pack $ show $ hash res, ([], Just res))
+    return (Just $ BS.pack $ show $ hash res, Just res)
 
 getModificationTimeRule :: VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules ()
-getModificationTimeRule vfs isWatched =
-    defineEarlyCutoff $ \(GetModificationTime_ missingFileDiags) file -> do
+getModificationTimeRule vfs isWatched = defineEarlyCutoff $ Rule $ \(GetModificationTime_ missingFileDiags) file ->
+    getModificationTimeImpl vfs isWatched missingFileDiags file
+
+getModificationTimeImpl :: VFSHandle
+    -> (NormalizedFilePath -> Action Bool)
+    -> Bool
+    -> NormalizedFilePath
+    -> Action
+        (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
+getModificationTimeImpl vfs isWatched missingFileDiags file = do
         let file' = fromNormalizedFilePath file
         let wrap time@(l,s) = (Just $ BS.pack $ show time, ([], Just $ ModificationTime l s))
         mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file
@@ -111,7 +128,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 +138,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 +163,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
@@ -181,16 +210,21 @@ internalTimeToUTCTime large small =
 #endif
 
 getFileContentsRule :: VFSHandle -> Rules ()
-getFileContentsRule vfs =
-    define $ \GetFileContents file -> do
-        -- need to depend on modification time to introduce a dependency with Cutoff
-        time <- use_ GetModificationTime file
-        res <- liftIO $ ideTryIOException file $ do
-            mbVirtual <- getVirtualFile vfs $ filePathToUri' file
-            pure $ Rope.toText . _text <$> mbVirtual
-        case res of
-            Left err       -> return ([err], Nothing)
-            Right contents -> return ([], Just (time, contents))
+getFileContentsRule vfs = define $ \GetFileContents file -> getFileContentsImpl vfs file
+
+getFileContentsImpl
+    :: VFSHandle
+    -> NormalizedFilePath
+    -> Action ([FileDiagnostic], Maybe (FileVersion, Maybe T.Text))
+getFileContentsImpl vfs file = do
+    -- need to depend on modification time to introduce a dependency with Cutoff
+    time <- use_ GetModificationTime file
+    res <- liftIO $ ideTryIOException file $ do
+        mbVirtual <- getVirtualFile vfs $ filePathToUri' file
+        pure $ Rope.toText . _text <$> mbVirtual
+    case res of
+        Left err       -> return ([err], Nothing)
+        Right contents -> return ([], Just (time, contents))
 
 ideTryIOException :: NormalizedFilePath -> IO a -> IO (Either FileDiagnostic a)
 ideTryIOException fp act =

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

@@ -56,10 +56,10 @@ instance Binary   GetFilesOfInterest
 ofInterestRules :: Rules ()
 ofInterestRules = do
     addIdeGlobal . OfInterestVar =<< liftIO (newVar HashMap.empty)
-    defineEarlyCutoff $ \GetFilesOfInterest _file -> assert (null $ fromNormalizedFilePath _file) $ do
+    defineEarlyCutoff $ RuleNoDiagnostics $ \GetFilesOfInterest _file -> assert (null $ fromNormalizedFilePath _file) $ do
         alwaysRerun
         filesOfInterest <- getFilesOfInterestUntracked
-        pure (Just $ BS.fromString $ show filesOfInterest, ([], Just filesOfInterest))
+        pure (Just $ BS.fromString $ show filesOfInterest, Just filesOfInterest)
 
 
 -- | Get the files that are open in the IDE.