Added support for user configuration

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`
 

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,12 +108,16 @@ 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
                  , "diagnosticsDebounceDuration" .= d
                  , "liquidOn"                    .= l
                  , "completionSnippetsOn"        .= c
                  , "formatOnImportOn"            .= f
+                 , "onSaveOnly"                  .= saveOnly
+                 , "noAutocompleteArguments"     .= noAutoArg
                  ]
+
+

hie-plugin-api/hie-plugin-api.cabal

@@ -50,6 +50,7 @@ library
                      , text
                      , transformers
                      , unordered-containers
+                     , bytestring
   if os(windows)
     build-depends:     Win32
   else

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

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

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