diff --git a/README.md b/README.md index 65225bc75..372cb9edc 100644 --- a/README.md +++ b/README.md @@ -355,15 +355,29 @@ to VS Code user settings. ## Configuration There are some settings that can be configured via a `settings.json` file: -```json +```javascript { "languageServerHaskell": { + // Default: true. "hlintOn": Boolean, - "maxNumberOfProblems": Number + // Default: 100. + "maxNumberOfProblems": Number, + // Disables interactive “as you type“ linter/diagnostic feedback. + // Default: false. + "onSaveOnly": Boolean, + // Excludes argument types from autocomplete insertions (see “With regards to atom users” for elaboration). + // Default: false. + "noAutocompleteArguments": Boolean, } } ``` +> Note that the above comments are for field specific commentary and must be excluded in your real `settings.json` file. + +#### With regards to atom users: +* If you are using the ‘linter’ package, setting “Lint on Change” to `false` will have no effect unless you create a `settings.json` file with the aforementioned `noAutocompleteArguments` option. +* Completion insertions from the ‘linter’ or the ‘atom-ide-ui’ packages in conjunction with 'hie' and 'ide-haskell-hie' will include the argument types. E.g. selecting `mapM` will insert `mapM a -> m b t a` unless your `settings.json` file includes the aforementioned `noAutocompleteArguments` option. +#### Misc. - VS Code: These settings will show up in the settings window - LanguageClient-neovim: Create this file in `$projectdir/.vim/settings.json` or set `g:LanguageClient_settingsPath` diff --git a/hie-plugin-api/Haskell/Ide/Engine/Config.hs b/hie-plugin-api/Haskell/Ide/Engine/Config.hs index cfaa10b2e..3d55aa82f 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Config.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Config.hs @@ -3,9 +3,16 @@ module Haskell.Ide.Engine.Config where import Data.Aeson import Data.Default +import Control.Monad (join) +import Control.Applicative ((<**>)) +import Data.Maybe (fromMaybe) +import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T +import qualified Control.Exception as E (handle, IOException) +import qualified System.Directory as SD (getCurrentDirectory, getHomeDirectory, doesFileExist) import Language.Haskell.LSP.Types + -- --------------------------------------------------------------------- -- | Callback from haskell-lsp core to convert the generic message to the @@ -16,6 +23,38 @@ getConfigFromNotification (NotificationMessage _ _ (DidChangeConfigurationParams Success c -> Right c Error err -> Left $ T.pack err +-- | +-- Workaround to ‘getConfigFromNotification’ not working (Atom Editor). +getConfigFromFileSystem :: Maybe FilePath -> IO Config +getConfigFromFileSystem root = E.handle onIOException go + where + onIOException :: E.IOException -> IO Config + onIOException _ = return def + + parse :: FilePath -> IO (Maybe Config) + parse filePath = LBS.readFile filePath <**> return decode + + go :: IO Config + go = do + suggested <- join <$> mapM checkForConfigFile root + local <- checkForConfigFile =<< SD.getCurrentDirectory + home <- checkForConfigFile =<< SD.getHomeDirectory + case (suggested, local, home) of + (Just filePath, _, _) -> fromMaybe def <$> parse filePath + (_, Just filePath, _) -> fromMaybe def <$> parse filePath + (_, _, Just filePath) -> fromMaybe def <$> parse filePath + _ -> return def + + checkForConfigFile :: FilePath -> IO (Maybe FilePath) + checkForConfigFile dir = SD.doesFileExist settingsFilePath <**> return f + where + f :: Bool -> Maybe FilePath + f True = Just settingsFilePath + f False = Nothing + + settingsFilePath :: FilePath + settingsFilePath = dir ++ "/settings.json" + -- --------------------------------------------------------------------- data Config = @@ -26,6 +65,10 @@ data Config = , liquidOn :: Bool , completionSnippetsOn :: Bool , formatOnImportOn :: Bool + , onSaveOnly :: Bool + -- ^ Disables interactive “as you type“ linter/diagnostic feedback. + , noAutocompleteArguments :: Bool + -- ^ Excludes argument types from autocomplete insertions (see "Configuration" from README.md for details). } deriving (Show,Eq) instance Default Config where @@ -36,6 +79,8 @@ instance Default Config where , liquidOn = False , completionSnippetsOn = True , formatOnImportOn = True + , onSaveOnly = False + , noAutocompleteArguments = False } -- TODO: Add API for plugins to expose their own LSP config options @@ -49,6 +94,9 @@ instance FromJSON Config where <*> o .:? "liquidOn" .!= liquidOn def <*> o .:? "completionSnippetsOn" .!= completionSnippetsOn def <*> o .:? "formatOnImportOn" .!= formatOnImportOn def + <*> o .:? "onSaveOnly" .!= onSaveOnly def + <*> o .:? "noAutocompleteArguments" .!= noAutocompleteArguments def + -- 2017-10-09 23:22:00.710515298 [ThreadId 11] - ---> {"jsonrpc":"2.0","method":"workspace/didChangeConfiguration","params":{"settings":{"languageServerHaskell":{"maxNumberOfProblems":100,"hlintOn":true}}}} -- 2017-10-09 23:22:00.710667381 [ThreadId 15] - reactor:got didChangeConfiguration notification: @@ -60,7 +108,7 @@ instance FromJSON Config where -- ,("maxNumberOfProblems",Number 100.0)]))])}} instance ToJSON Config where - toJSON (Config h m d l c f) = object [ "languageServerHaskell" .= r ] + toJSON (Config h m d l c f saveOnly noAutoArg) = object [ "languageServerHaskell" .= r ] where r = object [ "hlintOn" .= h , "maxNumberOfProblems" .= m @@ -68,4 +116,8 @@ instance ToJSON Config where , "liquidOn" .= l , "completionSnippetsOn" .= c , "formatOnImportOn" .= f + , "onSaveOnly" .= saveOnly + , "noAutocompleteArguments" .= noAutoArg ] + + diff --git a/hie-plugin-api/hie-plugin-api.cabal b/hie-plugin-api/hie-plugin-api.cabal index b80f6c9ab..e29c751a3 100644 --- a/hie-plugin-api/hie-plugin-api.cabal +++ b/hie-plugin-api/hie-plugin-api.cabal @@ -50,6 +50,7 @@ library , text , transformers , unordered-containers + , bytestring if os(windows) build-depends: Win32 else diff --git a/src/Haskell/Ide/Engine/Plugin/HieExtras.hs b/src/Haskell/Ide/Engine/Plugin/HieExtras.hs index 7924e8b7b..5d8693fb7 100644 --- a/src/Haskell/Ide/Engine/Plugin/HieExtras.hs +++ b/src/Haskell/Ide/Engine/Plugin/HieExtras.hs @@ -52,6 +52,7 @@ import qualified GhcMod.Exe.CaseSplit as GM import qualified GhcMod.Gap as GM import qualified GhcMod.LightGhc as GM import qualified GhcMod.Utils as GM +import Haskell.Ide.Engine.Config import Haskell.Ide.Engine.ArtifactMap import Haskell.Ide.Engine.Context import Haskell.Ide.Engine.MonadFunctions @@ -123,8 +124,8 @@ mkQuery :: T.Text -> T.Text -> HoogleQuery mkQuery name importedFrom = name <> " module:" <> importedFrom <> " is:exact" -mkCompl :: CompItem -> J.CompletionItem -mkCompl CI{origName,importedFrom,thingType,label} = +mkCompl :: Config -> CompItem -> J.CompletionItem +mkCompl config CI{origName,importedFrom,thingType,label} = J.CompletionItem label kind (Just $ maybe "" (<>"\n") typeText <> importedFrom) Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just J.Snippet) Nothing Nothing Nothing Nothing hoogleQuery @@ -133,9 +134,11 @@ mkCompl CI{origName,importedFrom,thingType,label} = argTypes = maybe [] getArgs thingType insertText | [] <- argTypes = label - | otherwise = label <> " " <> argText + | otherwise = if noAutocompleteArguments config + then label + else label <> " " <> argText argText :: T.Text - argText = mconcat $ List.intersperse " " $ zipWith snippet [1..] argTypes + argText = mconcat $ List.intersperse " " $ zipWith snippet [1..] argTypes stripForall t | T.isPrefixOf "forall" t = -- We drop 2 to remove the '.' and the space after it @@ -337,8 +340,8 @@ instance ModuleCache CachedCompletions where newtype WithSnippets = WithSnippets Bool -- | Returns the cached completions for the given module and position. -getCompletions :: Uri -> PosPrefixInfo -> WithSnippets -> IdeM (IdeResult [J.CompletionItem]) -getCompletions uri prefixInfo (WithSnippets withSnippets) = +getCompletions :: Config -> Uri -> PosPrefixInfo -> WithSnippets -> IdeM (IdeResult [J.CompletionItem]) +getCompletions config uri prefixInfo (WithSnippets withSnippets) = pluginGetFile "getCompletions: " uri $ \file -> do let snippetLens = (^? J.textDocument . _Just @@ -390,7 +393,6 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) = map mkModCompl $ mapMaybe (T.stripPrefix enteredQual) $ Fuzzy.simpleFilter fullPrefix allModNamesAsNS - filtCompls = Fuzzy.filterBy label prefixText ctxCompls where isTypeCompl = isTcOcc . occName . origName @@ -438,7 +440,7 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) = | "{-# " `T.isPrefixOf` fullLine = filtPragmaCompls (pragmaSuffix fullLine) | otherwise - = filtModNameCompls ++ map (toggleSnippets . mkCompl . stripAutoGenerated) filtCompls + = filtModNameCompls ++ map (toggleSnippets . mkCompl config . stripAutoGenerated) filtCompls in return $ IdeResultOk result where diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index f14f50df4..d8133a39d 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -120,11 +120,12 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do rin <- atomically newTChan :: IO (TChan ReactorInput) commandIds <- allLspCmdIds plugins + configFile <- getConfigFromFileSystem Nothing let dp lf = do diagIn <- atomically newTChan let react = runReactor lf scheduler diagnosticProviders hps sps - reactorFunc = react $ reactor rin diagIn + reactorFunc = react $ reactor configFile rin diagIn let errorHandler :: Scheduler.ErrorHandler errorHandler lid code e = @@ -192,10 +193,8 @@ type ReactorInput -- --------------------------------------------------------------------- configVal :: c -> (Config -> c) -> R c -configVal defVal field = do - gmc <- asksLspFuncs Core.config - mc <- liftIO gmc - return $ maybe defVal field mc +configVal defVal field = + maybe defVal field <$> (liftIO =<< asksLspFuncs Core.config) -- --------------------------------------------------------------------- @@ -368,8 +367,8 @@ sendErrorLog msg = reactorSend' (`Core.sendErrorLogS` msg) -- | The single point that all events flow through, allowing management of state -- to stitch replies and requests together from the two asynchronous sides: lsp -- server and hie dispatcher -reactor :: forall void. TChan ReactorInput -> TChan DiagnosticsRequest -> R void -reactor inp diagIn = do +reactor :: forall void. Config -> TChan ReactorInput -> TChan DiagnosticsRequest -> R void +reactor configFile inp diagIn = do -- forever $ do let loop :: TrackingNumber -> R void @@ -493,20 +492,23 @@ reactor inp diagIn = do -- ------------------------------- - NotDidChangeTextDocument notification -> do - liftIO $ U.logm "****** reactor: processing NotDidChangeTextDocument" - let - params = notification ^. J.params - vtdi = params ^. J.textDocument - uri = vtdi ^. J.uri - ver = vtdi ^. J.version - J.List changes = params ^. J.contentChanges - mapFileFromVfs tn vtdi - makeRequest $ GReq tn (Just uri) Nothing Nothing (const $ return ()) $ - -- Important - Call this before requestDiagnostics - updatePositionMap uri changes - - queueDiagnosticsRequest diagIn DiagnosticOnChange tn uri ver + NotDidChangeTextDocument notification -> + configVal (onSaveOnly configFile) onSaveOnly >>= \case + True -> liftIO $ U.logm "****** reactor: not processing NotDidChangeTextDocument" + False -> do + liftIO $ U.logm "****** reactor: processing NotDidChangeTextDocument" + let + params = notification ^. J.params + vtdi = params ^. J.textDocument + uri = vtdi ^. J.uri + ver = vtdi ^. J.version + J.List changes = params ^. J.contentChanges + mapFileFromVfs tn vtdi + makeRequest $ GReq tn (Just uri) Nothing Nothing (const $ return ()) $ + -- Important - Call this before requestDiagnostics + updatePositionMap uri changes + + queueDiagnosticsRequest diagIn DiagnosticOnChange tn uri ver -- ------------------------------- @@ -656,9 +658,10 @@ reactor inp diagIn = do case mprefix of Nothing -> callback [] Just prefix -> do + configState <- fromMaybe configFile <$> (liftIO =<< asksLspFuncs Core.config) snippets <- Hie.WithSnippets <$> configVal True completionSnippetsOn let hreq = IReq tn (req ^. J.id) callback - $ lift $ Hie.getCompletions doc prefix snippets + $ lift $ Hie.getCompletions configState doc prefix snippets makeRequest hreq ReqCompletionItemResolve req -> do diff --git a/test/unit/JsonSpec.hs b/test/unit/JsonSpec.hs index a24a9e56a..bc5b6f3df 100644 --- a/test/unit/JsonSpec.hs +++ b/test/unit/JsonSpec.hs @@ -102,4 +102,5 @@ instance Arbitrary Position where return $ Position l c instance Arbitrary Config where - arbitrary = Config <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + arbitrary = Config + <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary