Added support for user configuration

.gitignore

@@ -68,4 +68,5 @@ test-logs/
 .vscode
 
 # shake build information
-_build/
+_build/
+/.hie.yaml

docs/hie-yaml-file.md

@@ -0,0 +1,19 @@
+# Haskell IDE Engine Specific Configuration
+
+## File format and options 
+> `hie` will look for the `hie.yaml` file in `/$PWD/hie.yaml` or `/$HOME/hie.yaml`.
+
+```yaml
+overrides:
+  # Disables interactive “as you type“ linter/diagnostic feedback.
+  - on_save_only
+  # Excludes argument types from autocomplete insertions.
+  - no_autocomplete_arguments
+```
+
+
+### With regards to atom users:
+* If using the ‘linter’ package, setting “Lint on Change” to `false` will have no effect unless you create an `hie.yaml` file with the `on_save_only` 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 `hie.yaml` file includes the `no_autocomplete_arguments` option.
+
+

haskell-ide-engine.cabal

@@ -44,6 +44,7 @@ library
                        Haskell.Ide.Engine.Transport.JsonStdio
                        Haskell.Ide.Engine.Transport.LspStdio
                        Haskell.Ide.Engine.Types
+                       Haskell.Ide.Engine.User.Config
   other-modules:       Paths_haskell_ide_engine
   build-depends:       Cabal >= 1.22
                      , Diff

src/Haskell/Ide/Engine/Plugin/HieExtras.hs

@@ -58,6 +58,7 @@ import           Haskell.Ide.Engine.MonadFunctions
 import           Haskell.Ide.Engine.MonadTypes
 import           Haskell.Ide.Engine.PluginUtils
 import qualified Haskell.Ide.Engine.Plugin.Fuzzy              as Fuzzy
+import qualified Haskell.Ide.Engine.User.Config               as UserConfig
 import           HscTypes
 import qualified Language.Haskell.LSP.VFS                     as VFS
 import qualified Language.Haskell.LSP.Types                   as J
@@ -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 :: UserConfig.HieConfigFile -> CompItem -> J.CompletionItem
+mkCompl userConfig 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 UserConfig.hasUserOverrideRequest UserConfig.NoAutoCompleteArguments userConfig
+            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 :: UserConfig.HieConfigFile -> Uri -> PosPrefixInfo -> WithSnippets -> IdeM (IdeResult [J.CompletionItem])
+getCompletions userConfig 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 userConfig . stripAutoGenerated) filtCompls
           in
             return $ IdeResultOk result
  where

src/Haskell/Ide/Engine/Transport/LspStdio.hs

@@ -55,6 +55,7 @@ import qualified Haskell.Ide.Engine.Plugin.ApplyRefact   as ApplyRefact
 import qualified Haskell.Ide.Engine.Plugin.Brittany      as Brittany
 import qualified Haskell.Ide.Engine.Plugin.Hoogle        as Hoogle
 import qualified Haskell.Ide.Engine.Plugin.HieExtras     as Hie
+import qualified Haskell.Ide.Engine.User.Config          as UserConfig
 import           Haskell.Ide.Engine.Plugin.Base
 import qualified Language.Haskell.LSP.Control            as CTRL
 import qualified Language.Haskell.LSP.Core               as Core
@@ -120,11 +121,13 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do
 
   rin        <- atomically newTChan :: IO (TChan ReactorInput)
   commandIds <- allLspCmdIds plugins
+
+  userConfig <- UserConfig.getUserConfigFile Nothing
 
   let dp lf = do
         diagIn      <- atomically newTChan
         let react = runReactor lf scheduler diagnosticProviders hps sps
-            reactorFunc = react $ reactor rin diagIn
+            reactorFunc = react $ reactor userConfig rin diagIn
 
         let errorHandler :: Scheduler.ErrorHandler
             errorHandler lid code e =
@@ -368,8 +371,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. UserConfig.HieConfigFile -> TChan ReactorInput -> TChan DiagnosticsRequest -> R void
+reactor userConfig inp diagIn = do
   -- forever $ do
   let
     loop :: TrackingNumber -> R void
@@ -493,20 +496,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 ->
+          if UserConfig.hasUserOverrideRequest UserConfig.OnSaveOnly userConfig
+            then liftIO $ U.logm "****** reactor: not processing NotDidChangeTextDocument"
+            else 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
 
         -- -------------------------------
 
@@ -658,7 +664,7 @@ reactor inp diagIn = do
             Just prefix -> do
               snippets <- Hie.WithSnippets <$> configVal True completionSnippetsOn
               let hreq = IReq tn (req ^. J.id) callback
-                           $ lift $ Hie.getCompletions doc prefix snippets
+                           $ lift $ Hie.getCompletions userConfig doc prefix snippets
               makeRequest hreq
 
         ReqCompletionItemResolve req -> do

src/Haskell/Ide/Engine/User/Config.hs

@@ -0,0 +1,83 @@
+{-# LANGUAGE LambdaCase #-}
+module Haskell.Ide.Engine.User.Config
+  ( HieConfigFile
+  , Override(..)
+  , hasUserOverrideRequest
+  , getUserConfigFile
+  )
+where
+
+import Control.Monad (join)
+import Data.Functor ((<&>))
+import qualified Data.Text as T (pack, unpack, toLower)
+import qualified Data.Yaml as Yaml (decodeFileEither)
+import qualified Data.Aeson as A (FromJSON(..), withObject)
+import qualified Data.Aeson.Types as A (parseFieldMaybe)
+import qualified System.Directory as SD (getCurrentDirectory, getHomeDirectory, doesFileExist)
+import qualified Data.Maybe as Maybe (fromMaybe, mapMaybe)
+import qualified Control.Exception as E (handle, IOException)
+
+
+
+newtype HieConfigFile = HieConfigFile
+  { requestOverrides :: [Override]
+  } deriving (Show)
+
+data Override
+  = OnSaveOnly
+  | NoAutoCompleteArguments
+  deriving (Show, Eq)
+
+emptyHieConfigFile :: HieConfigFile
+emptyHieConfigFile = HieConfigFile
+  { requestOverrides = []
+  }
+
+hasUserOverrideRequest :: Override -> HieConfigFile -> Bool
+hasUserOverrideRequest x = elem x . requestOverrides
+
+getUserConfigFile :: Maybe FilePath -> IO HieConfigFile
+getUserConfigFile root = E.handle onIOException go
+  where
+    onIOException :: E.IOException -> IO HieConfigFile
+    onIOException _ = return emptyHieConfigFile
+
+    parse :: FilePath -> IO HieConfigFile
+    parse filePath = Yaml.decodeFileEither filePath <&> \case
+      Left _ -> emptyHieConfigFile
+      Right x -> x
+
+    go :: IO HieConfigFile
+    go = do
+      suggested <- join <$> mapM checkForConfigFile root
+      local <- checkForConfigFile =<< SD.getCurrentDirectory
+      home <- checkForConfigFile =<< SD.getHomeDirectory
+      case (suggested, local, home) of
+        (Just filePath, _, _) -> parse filePath
+        (_, Just filePath, _) -> parse filePath
+        (_, _, Just filePath) -> parse filePath
+        _ -> return emptyHieConfigFile
+
+checkForConfigFile :: FilePath -> IO (Maybe FilePath)
+checkForConfigFile root = SD.doesFileExist hieFilePath <&> \case
+  True -> Just hieFilePath
+  _ -> Nothing
+  where
+    hieFilePath = appendHieFileName root
+
+appendHieFileName :: FilePath -> FilePath
+appendHieFileName root = root <> "/hie.yaml"
+
+instance A.FromJSON HieConfigFile where
+  parseJSON = A.withObject "config file" $ \o -> do
+    overrides <- A.parseFieldMaybe o (T.pack "overrides")
+      <&> Maybe.fromMaybe []
+      <&> Maybe.mapMaybe (f . T.unpack . T.toLower)
+    return $ HieConfigFile {requestOverrides = overrides}
+    where
+      f :: String -> Maybe Override
+      f = \case
+        "on_save_only" -> Just OnSaveOnly
+        "no_autocomplete_arguments" -> Just NoAutoCompleteArguments
+        _ -> Nothing
+