From 6f58e0bc9e7667e54d164a0c1c96e43c3a3ebbb5 Mon Sep 17 00:00:00 2001
From: Colbyn Wadman <hello@colbyn.com>
Date: Tue, 5 Feb 2019 13:10:29 -0700
Subject: [PATCH 1/5] =?UTF-8?q?Added=20support=20for=20feature=20overrides?=
=?UTF-8?q?=20via=20a=20configuration=20file=20called=20=E2=80=98hie.yaml?=
=?UTF-8?q?=E2=80=99.=20See=20=E2=80=98./docs/hie-yaml-file.md=E2=80=99=20?=
=?UTF-8?q?for=20details.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
---
.gitignore | 3 +-
docs/hie-yaml-file.md | 19 +++++
src/Haskell/Ide/Engine/Plugin/HieExtras.hs | 18 +++--
src/Haskell/Ide/Engine/Transport/LspStdio.hs | 42 +++++-----
src/Haskell/Ide/Engine/User/Config.hs | 83 ++++++++++++++++++++
5 files changed, 138 insertions(+), 27 deletions(-)
create mode 100644 docs/hie-yaml-file.md
create mode 100644 src/Haskell/Ide/Engine/User/Config.hs
diff --git a/.gitignore b/.gitignore
index 2ffbdb80f..1777f21b0 100644
--- a/.gitignore
+++ b/.gitignore
@@ -68,4 +68,5 @@ test-logs/
.vscode
# shake build information
-_build/
\ No newline at end of file
+_build/
+/.hie.yaml
\ No newline at end of file
diff --git a/docs/hie-yaml-file.md b/docs/hie-yaml-file.md
new file mode 100644
index 000000000..7d1f9ae63
--- /dev/null
+++ b/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.
+
+
diff --git a/src/Haskell/Ide/Engine/Plugin/HieExtras.hs b/src/Haskell/Ide/Engine/Plugin/HieExtras.hs
index 7924e8b7b..6025e8c44 100644
--- a/src/Haskell/Ide/Engine/Plugin/HieExtras.hs
+++ b/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
diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs
index f14f50df4..f89863c3d 100644
--- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs
+++ b/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
diff --git a/src/Haskell/Ide/Engine/User/Config.hs b/src/Haskell/Ide/Engine/User/Config.hs
new file mode 100644
index 000000000..911935292
--- /dev/null
+++ b/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
+
From ad95c12fd1c2067f89e67bda6afcb3d6fe7dd0ca Mon Sep 17 00:00:00 2001
From: Colbyn Wadman <hello@colbyn.com>
Date: Tue, 5 Feb 2019 19:50:53 -0700
Subject: [PATCH 2/5] Whoops, forgot to add module to cabal file.
---
haskell-ide-engine.cabal | 1 +
1 file changed, 1 insertion(+)
diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal
index d22b6f732..20dd67b67 100644
--- a/haskell-ide-engine.cabal
+++ b/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
From 5c0b9474363be71d22a0f29a3a6f8aa1610e8a5c Mon Sep 17 00:00:00 2001
From: Colbyn Wadman <hello@colbyn.com>
Date: Sat, 23 Feb 2019 15:15:04 -0700
Subject: [PATCH 3/5] Use preexisting config format.
---
.gitignore | 3 +-
README.md | 18 ++++-
docs/hie-yaml-file.md | 19 -----
haskell-ide-engine.cabal | 1 -
hie-plugin-api/Haskell/Ide/Engine/Config.hs | 52 +++++++++++-
src/Haskell/Ide/Engine/Plugin/HieExtras.hs | 14 ++--
src/Haskell/Ide/Engine/Transport/LspStdio.hs | 21 +++--
src/Haskell/Ide/Engine/User/Config.hs | 83 --------------------
8 files changed, 84 insertions(+), 127 deletions(-)
delete mode 100644 docs/hie-yaml-file.md
delete mode 100644 src/Haskell/Ide/Engine/User/Config.hs
diff --git a/.gitignore b/.gitignore
index 1777f21b0..2ffbdb80f 100644
--- a/.gitignore
+++ b/.gitignore
@@ -68,5 +68,4 @@ test-logs/
.vscode
# shake build information
-_build/
-/.hie.yaml
\ No newline at end of file
+_build/
\ No newline at end of file
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/docs/hie-yaml-file.md b/docs/hie-yaml-file.md
deleted file mode 100644
index 7d1f9ae63..000000000
--- a/docs/hie-yaml-file.md
+++ /dev/null
@@ -1,19 +0,0 @@
-# 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.
-
-
diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal
index 20dd67b67..d22b6f732 100644
--- a/haskell-ide-engine.cabal
+++ b/haskell-ide-engine.cabal
@@ -44,7 +44,6 @@ 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
diff --git a/hie-plugin-api/Haskell/Ide/Engine/Config.hs b/hie-plugin-api/Haskell/Ide/Engine/Config.hs
index cfaa10b2e..5d3328e9a 100644
--- a/hie-plugin-api/Haskell/Ide/Engine/Config.hs
+++ b/hie-plugin-api/Haskell/Ide/Engine/Config.hs
@@ -1,9 +1,14 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
module Haskell.Ide.Engine.Config where
import Data.Aeson
import Data.Default
+import Data.Functor ((<&>))
+import Control.Monad (join)
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
-- ---------------------------------------------------------------------
@@ -16,6 +21,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 Config
+ parse filePath = decodeFileStrict filePath <&> \case
+ Just x -> x
+ Nothing -> def
+
+ 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, _, _) -> parse filePath
+ (_, Just filePath, _) -> parse filePath
+ (_, _, Just filePath) -> parse filePath
+ _ -> return def
+
+ checkForConfigFile :: FilePath -> IO (Maybe FilePath)
+ checkForConfigFile dir = SD.doesFileExist settingsFilePath <&> \case
+ True -> Just settingsFilePath
+ _ -> Nothing
+ where
+ settingsFilePath :: FilePath
+ settingsFilePath = dir <> "/settings.json"
+
-- ---------------------------------------------------------------------
data Config =
@@ -26,6 +63,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 +77,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 +92,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 +106,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 +114,8 @@ instance ToJSON Config where
, "liquidOn" .= l
, "completionSnippetsOn" .= c
, "formatOnImportOn" .= f
+ , "onSaveOnly" .= saveOnly
+ , "noAutocompleteArguments" .= noAutoArg
]
+
+
diff --git a/src/Haskell/Ide/Engine/Plugin/HieExtras.hs b/src/Haskell/Ide/Engine/Plugin/HieExtras.hs
index 6025e8c44..5d8693fb7 100644
--- a/src/Haskell/Ide/Engine/Plugin/HieExtras.hs
+++ b/src/Haskell/Ide/Engine/Plugin/HieExtras.hs
@@ -52,13 +52,13 @@ 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
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
@@ -124,8 +124,8 @@ mkQuery :: T.Text -> T.Text -> HoogleQuery
mkQuery name importedFrom = name <> " module:" <> importedFrom
<> " is:exact"
-mkCompl :: UserConfig.HieConfigFile -> CompItem -> J.CompletionItem
-mkCompl userConfig 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
@@ -134,7 +134,7 @@ mkCompl userConfig CI{origName,importedFrom,thingType,label} =
argTypes = maybe [] getArgs thingType
insertText
| [] <- argTypes = label
- | otherwise = if UserConfig.hasUserOverrideRequest UserConfig.NoAutoCompleteArguments userConfig
+ | otherwise = if noAutocompleteArguments config
then label
else label <> " " <> argText
argText :: T.Text
@@ -340,8 +340,8 @@ instance ModuleCache CachedCompletions where
newtype WithSnippets = WithSnippets Bool
-- | Returns the cached completions for the given module and position.
-getCompletions :: UserConfig.HieConfigFile -> Uri -> PosPrefixInfo -> WithSnippets -> IdeM (IdeResult [J.CompletionItem])
-getCompletions userConfig 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
@@ -440,7 +440,7 @@ getCompletions userConfig uri prefixInfo (WithSnippets withSnippets) =
| "{-# " `T.isPrefixOf` fullLine
= filtPragmaCompls (pragmaSuffix fullLine)
| otherwise
- = filtModNameCompls ++ map (toggleSnippets . mkCompl userConfig . 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 f89863c3d..bde7e620d 100644
--- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs
+++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs
@@ -55,7 +55,6 @@ 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
@@ -121,13 +120,12 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do
rin <- atomically newTChan :: IO (TChan ReactorInput)
commandIds <- allLspCmdIds plugins
-
- userConfig <- UserConfig.getUserConfigFile Nothing
+ configFile <- getConfigFromFileSystem Nothing
let dp lf = do
diagIn <- atomically newTChan
let react = runReactor lf scheduler diagnosticProviders hps sps
- reactorFunc = react $ reactor userConfig rin diagIn
+ reactorFunc = react $ reactor configFile rin diagIn
let errorHandler :: Scheduler.ErrorHandler
errorHandler lid code e =
@@ -195,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)
-- ---------------------------------------------------------------------
@@ -371,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. UserConfig.HieConfigFile -> TChan ReactorInput -> TChan DiagnosticsRequest -> R void
-reactor userConfig 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
@@ -497,7 +493,7 @@ reactor userConfig inp diagIn = do
-- -------------------------------
NotDidChangeTextDocument notification ->
- if UserConfig.hasUserOverrideRequest UserConfig.OnSaveOnly userConfig
+ configVal (onSaveOnly configFile) onSaveOnly >>= \flag -> if flag
then liftIO $ U.logm "****** reactor: not processing NotDidChangeTextDocument"
else do
liftIO $ U.logm "****** reactor: processing NotDidChangeTextDocument"
@@ -662,9 +658,10 @@ reactor userConfig 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 userConfig doc prefix snippets
+ $ lift $ Hie.getCompletions configState doc prefix snippets
makeRequest hreq
ReqCompletionItemResolve req -> do
diff --git a/src/Haskell/Ide/Engine/User/Config.hs b/src/Haskell/Ide/Engine/User/Config.hs
deleted file mode 100644
index 911935292..000000000
--- a/src/Haskell/Ide/Engine/User/Config.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-{-# 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
-
From 7c89ef552bc3e58a9442b60e93d16dad9c83e7f1 Mon Sep 17 00:00:00 2001
From: Colbyn Wadman <hello@colbyn.com>
Date: Sat, 23 Feb 2019 15:52:45 -0700
Subject: [PATCH 4/5] Updated test file.
---
test/unit/JsonSpec.hs | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
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
From c1f1468bda239da2631f9b9cd913afc237acbc51 Mon Sep 17 00:00:00 2001
From: Colbyn Wadman <hello@colbyn.com>
Date: Sat, 23 Feb 2019 16:27:24 -0700
Subject: [PATCH 5/5] Small changes to work with an older prelude.
---
hie-plugin-api/Haskell/Ide/Engine/Config.hs | 28 +++++++++++---------
hie-plugin-api/hie-plugin-api.cabal | 1 +
src/Haskell/Ide/Engine/Transport/LspStdio.hs | 6 ++---
3 files changed, 19 insertions(+), 16 deletions(-)
diff --git a/hie-plugin-api/Haskell/Ide/Engine/Config.hs b/hie-plugin-api/Haskell/Ide/Engine/Config.hs
index 5d3328e9a..3d55aa82f 100644
--- a/hie-plugin-api/Haskell/Ide/Engine/Config.hs
+++ b/hie-plugin-api/Haskell/Ide/Engine/Config.hs
@@ -1,16 +1,18 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE LambdaCase #-}
module Haskell.Ide.Engine.Config where
import Data.Aeson
import Data.Default
-import Data.Functor ((<&>))
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
@@ -29,10 +31,8 @@ getConfigFromFileSystem root = E.handle onIOException go
onIOException :: E.IOException -> IO Config
onIOException _ = return def
- parse :: FilePath -> IO Config
- parse filePath = decodeFileStrict filePath <&> \case
- Just x -> x
- Nothing -> def
+ parse :: FilePath -> IO (Maybe Config)
+ parse filePath = LBS.readFile filePath <**> return decode
go :: IO Config
go = do
@@ -40,18 +40,20 @@ getConfigFromFileSystem root = E.handle onIOException go
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
+ (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 <&> \case
- True -> Just settingsFilePath
- _ -> Nothing
+ 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"
+ settingsFilePath = dir ++ "/settings.json"
-- ---------------------------------------------------------------------
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/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs
index bde7e620d..d8133a39d 100644
--- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs
+++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs
@@ -493,9 +493,9 @@ reactor configFile inp diagIn = do
-- -------------------------------
NotDidChangeTextDocument notification ->
- configVal (onSaveOnly configFile) onSaveOnly >>= \flag -> if flag
- then liftIO $ U.logm "****** reactor: not processing NotDidChangeTextDocument"
- else do
+ 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