haskell/haskell-ide-engine
1
1
Fork 0
mirror of https://github.com/haskell/haskell-ide-engine.git synced 2024-08-15 22:10:31 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' of https://github.com/haskell/haskell-ide-engine into new-haskell-lsp-options

Browse Source
This commit is contained in:
Luke Lau 2019-11-18 18:09:57 +00:00
commit 81cebbec40
21 changed files with 140 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

@ -176,7 +176,7 @@ sudo dnf install libicu-devel ncurses-devel
In order to avoid problems with long paths on Windows you can do the following:
1. Edit the group policy: set "Enable Win32 long paths" to "Enabled" (Works
1. In the `Local Group Policy Editor`: `Local Computer Policy -> Computer Configuration -> Administrative Templates -> System -> Filesystem` set `Enable Win32 long paths` to `Enabled` (Works
only for Windows 10).
2. Clone the `haskell-ide-engine` to the root of your logical drive (e.g. to

11
haskell-ide-engine.cabal
View File

@ -71,8 +71,8 @@ library
, gitrev >= 1.1
, haddock-api
, haddock-library
, haskell-lsp == 0.17.*
, haskell-lsp-types == 0.17.*
, haskell-lsp == 0.18.*
, haskell-lsp-types == 0.18.*
, haskell-src-exts
, hie-plugin-api
, hoogle >= 5.0.13
@ -196,11 +196,12 @@ test-suite unit-test
, free
, ghc
, haskell-ide-engine
, haskell-lsp-types == 0.17.*
, haskell-lsp-types == 0.18.*
, hie-test-utils
, hie-plugin-api
, hoogle > 5.0.11
, hspec
, process
, quickcheck-instances
, text
, unordered-containers
@ -284,8 +285,8 @@ test-suite func-test
, filepath
, lsp-test >= 0.8.0.0
, haskell-ide-engine
, haskell-lsp-types == 0.17.*
, haskell-lsp == 0.17.*
, haskell-lsp-types == 0.18.*
, haskell-lsp == 0.18.*
, hie-test-utils
, hie-plugin-api
, hspec

2
hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs
View File

@ -275,7 +275,7 @@ readVFS :: (MonadIde m, MonadIO m) => Uri -> m (Maybe T.Text)
readVFS uri = do
mvf <- getVirtualFile uri
case mvf of
Just (VirtualFile _ txt _) -> return $ Just (Rope.toText txt)
Just (VirtualFile _ txt) -> return $ Just (Rope.toText txt)
Nothing -> return Nothing
getRangeFromVFS :: (MonadIde m, MonadIO m) => Uri -> Range -> m (Maybe T.Text)

2
hie-plugin-api/hie-plugin-api.cabal
View File

@ -45,7 +45,7 @@ library
, ghc
, ghc-mod-core >= 5.9.0.0
, ghc-project-types >= 5.9.0.0
, haskell-lsp == 0.17.*
, haskell-lsp == 0.18.*
, hslogger
, monad-control
, mtl

8
install/src/Stack.hs
View File

@ -3,11 +3,13 @@ module Stack where
import Development.Shake
import Development.Shake.Command
import Development.Shake.FilePath
import Control.Exception
import Control.Monad
import Data.List
import System.Directory ( copyFile )
import System.FilePath ( searchPathSeparator, (</>) )
import System.Environment ( lookupEnv, setEnv, getEnvironment )
import System.IO.Error ( isDoesNotExistError )
import BuildSystem
import Version
import Print
@ -102,7 +104,11 @@ stackBuildFailMsg =
-- |Run actions without the stack cached binaries
withoutStackCachedBinaries :: Action a -> Action a
withoutStackCachedBinaries action = do
mbPath <- liftIO (lookupEnv "PATH")
let getEnvErrorHandler e | isDoesNotExistError e = return Nothing
| otherwise = throwIO e
mbPath <- liftIO (lookupEnv "PATH" `catch` getEnvErrorHandler)
case (mbPath, isRunFromStack) of

13
src/Haskell/Ide/Engine/Plugin/Liquid.hs
View File

@ -166,10 +166,19 @@ runLiquidHaskell fp = do
cp = (shell cmd) { cwd = Just dir }
-- logm $ "runLiquidHaskell:cmd=[" ++ cmd ++ "]"
mpp <- lookupEnv "GHC_PACKAGE_PATH"
mge <- lookupEnv "GHC_ENVIRONMENT"
-- logm $ "runLiquidHaskell:mpp=[" ++ show mpp ++ "]"
-- env <- getEnvironment
-- logm $ "runLiquidHaskell:env=[" ++ show env ++ "]"
(ec,o,e) <- bracket
(unsetEnv "GHC_PACKAGE_PATH")
(\_ -> mapM_ (setEnv "GHC_PACKAGE_PATH") mpp)
(do
unsetEnv "GHC_ENVIRONMENT"
unsetEnv "GHC_PACKAGE_PATH"
)
(\_ -> do
mapM_ (setEnv "GHC_PACKAGE_PATH") mpp
mapM_ (setEnv "GHC_ENVIRONMENT" ) mge
)
(\_ -> readCreateProcessWithExitCode cp "")
-- logm $ "runLiquidHaskell:v=" ++ show (ec,o,e)
return $ Just (ec,[o,e])

11
src/Haskell/Ide/Engine/Transport/LspStdio.hs
View File

@ -219,8 +219,8 @@ mapFileFromVfs tn vtdi = do
vfsFunc <- asksLspFuncs Core.getVirtualFileFunc
mvf <- liftIO $ vfsFunc (J.toNormalizedUri uri)
case (mvf, uriToFilePath uri) of
(Just (VFS.VirtualFile _ yitext _), Just fp) -> do
let text' = Rope.toString yitext
(Just (VFS.VirtualFile _ rope), Just fp) -> do
let text' = Rope.toString rope
-- text = "{-# LINE 1 \"" ++ fp ++ "\"#-}\n" <> text'
let req = GReq tn (Just uri) Nothing Nothing (const $ return ())
$ IdeResultOk <$> do
@ -798,7 +798,7 @@ withDocumentContents reqId uri f = do
(J.responseId reqId)
J.InvalidRequest
"Document was not open"
Just (VFS.VirtualFile _ txt _) -> f (Rope.toText txt)
Just (VFS.VirtualFile _ txt) -> f (Rope.toText txt)
-- | Get the currently configured formatter provider.
-- The currently configured formatter provider is defined in @Config@ by PluginId.
@ -966,14 +966,15 @@ syncOptions = J.TextDocumentSyncOptions
hieOptions :: [T.Text] -> Core.Options
hieOptions commandIds =
def { Core.textDocumentSync = Just syncOptions
, Core.completionKinds = Just ["."]
-- The characters that trigger completion automatically.
, Core.completionTriggerCharacters = Just ['.']
-- As of 2018-05-24, vscode needs the commands to be registered
-- otherwise they will not be available as codeActions (will be
-- silently ignored, despite UI showing to the contrary).
--
-- Hopefully the end May 2018 vscode release will stabilise
-- this, it is a major rework of the machinery anyway.
, Core.executeCommandCommands = commandIds
, Core.executeCommandCommands = Just commandIds
}

6
stack-8.4.2.yaml
View File

@ -19,14 +19,14 @@ extra-deps:
- ghc-lib-parser-8.8.1
- haddock-api-2.20.0
- haddock-library-1.6.0
- haskell-lsp-0.17.0.0
- haskell-lsp-types-0.17.0.0
- haskell-lsp-0.18.0.0
- haskell-lsp-types-0.18.0.0
- haskell-src-exts-1.21.1
- haskell-src-exts-util-0.2.5
- hlint-2.2.3
- hoogle-5.0.17.11
- hsimport-0.11.0
- lsp-test-0.8.0.0
- lsp-test-0.8.2.0
- monad-dijkstra-0.1.1.2
- pretty-show-1.8.2
- rope-utf16-splay-0.3.1.0

6
stack-8.4.3.yaml
View File

@ -19,14 +19,14 @@ extra-deps:
- ghc-lib-parser-8.8.1
- haddock-api-2.20.0
- haddock-library-1.6.0
- haskell-lsp-0.17.0.0
- haskell-lsp-types-0.17.0.0
- haskell-lsp-0.18.0.0
- haskell-lsp-types-0.18.0.0
- haskell-src-exts-1.21.1
- haskell-src-exts-util-0.2.5
- hlint-2.2.3
- hoogle-5.0.17.11
- hsimport-0.11.0
- lsp-test-0.8.0.0
- lsp-test-0.8.2.0
- monad-dijkstra-0.1.1.2
- pretty-show-1.8.2
- rope-utf16-splay-0.3.1.0

6
stack-8.4.4.yaml
View File

@ -18,14 +18,14 @@ extra-deps:
- ghc-lib-parser-8.8.1
- haddock-api-2.20.0
- haddock-library-1.6.0
- haskell-lsp-0.17.0.0
- haskell-lsp-types-0.17.0.0
- haskell-lsp-0.18.0.0
- haskell-lsp-types-0.18.0.0
- haskell-src-exts-1.21.1
- haskell-src-exts-util-0.2.5
- hlint-2.2.3
- hoogle-5.0.17.11
- hsimport-0.11.0
- lsp-test-0.8.0.0
- lsp-test-0.8.2.0
- monad-dijkstra-0.1.1.2
- optparse-simple-0.1.0
- pretty-show-1.9.5

6
stack-8.6.1.yaml
View File

@ -22,14 +22,14 @@ extra-deps:
- floskell-0.10.1
- ghc-lib-parser-8.8.1
- haddock-api-2.21.0
- haskell-lsp-0.17.0.0
- haskell-lsp-types-0.17.0.0
- haskell-lsp-0.18.0.0
- haskell-lsp-types-0.18.0.0
- haskell-src-exts-1.21.1
- haskell-src-exts-util-0.2.5
- hlint-2.2.3
- hoogle-5.0.17.11
- hsimport-0.11.0
- lsp-test-0.8.0.0
- lsp-test-0.8.2.0
- monad-dijkstra-0.1.1.2
- monad-memo-0.4.1
- monoid-subclasses-0.4.6.1

6
stack-8.6.2.yaml
View File

@ -18,14 +18,14 @@ extra-deps:
- floskell-0.10.1
- ghc-lib-parser-8.8.1
- haddock-api-2.21.0
- haskell-lsp-0.17.0.0
- haskell-lsp-types-0.17.0.0
- haskell-lsp-0.18.0.0
- haskell-lsp-types-0.18.0.0
- haskell-src-exts-1.21.1
- haskell-src-exts-util-0.2.5
- hlint-2.2.3
- hoogle-5.0.17.11
- hsimport-0.11.0
- lsp-test-0.8.0.0
- lsp-test-0.8.2.0
- monad-dijkstra-0.1.1.2
- monad-memo-0.4.1
- multistate-0.8.0.1

6
stack-8.6.3.yaml
View File

@ -17,14 +17,14 @@ extra-deps:
- floskell-0.10.1
- ghc-lib-parser-8.8.1
- haddock-api-2.21.0
- haskell-lsp-0.17.0.0
- haskell-lsp-types-0.17.0.0
- haskell-lsp-0.18.0.0
- haskell-lsp-types-0.18.0.0
- haskell-src-exts-1.21.1
- haskell-src-exts-util-0.2.5
- hlint-2.2.3
- hoogle-5.0.17.11
- hsimport-0.11.0
- lsp-test-0.8.0.0
- lsp-test-0.8.2.0
- monad-dijkstra-0.1.1.2
- monad-memo-0.4.1
- multistate-0.8.0.1

6
stack-8.6.4.yaml
View File

@ -17,13 +17,13 @@ extra-deps:
- floskell-0.10.1
- ghc-lib-parser-8.8.1
- haddock-api-2.22.0
- haskell-lsp-0.17.0.0
- haskell-lsp-types-0.17.0.0
- haskell-lsp-0.18.0.0
- haskell-lsp-types-0.18.0.0
- haskell-src-exts-1.21.1
- hlint-2.2.3
- hoogle-5.0.17.11
- hsimport-0.11.0
- lsp-test-0.8.0.0
- lsp-test-0.8.2.0
- monad-dijkstra-0.1.1.2@rev:1
- monad-memo-0.4.1
- multistate-0.8.0.1

6
stack-8.6.5.yaml
View File

@ -18,12 +18,12 @@ extra-deps:
- floskell-0.10.1
- ghc-lib-parser-8.8.1
- haddock-api-2.22.0
- haskell-lsp-0.17.0.0
- haskell-lsp-types-0.17.0.0
- haskell-lsp-0.18.0.0
- haskell-lsp-types-0.18.0.0
- hlint-2.2.3
- hsimport-0.11.0
- hoogle-5.0.17.11
- lsp-test-0.8.0.0
- lsp-test-0.8.2.0
- monad-dijkstra-0.1.1.2@rev:1
- syz-0.2.0.0
- temporary-1.2.1.1

6
stack.yaml
View File

@ -18,11 +18,11 @@ extra-deps:
- floskell-0.10.1
- ghc-lib-parser-8.8.1
- haddock-api-2.22.0
- haskell-lsp-0.17.0.0
- haskell-lsp-types-0.17.0.0
- haskell-lsp-0.18.0.0
- haskell-lsp-types-0.18.0.0
- hlint-2.2.3
- hsimport-0.11.0
- lsp-test-0.8.0.0
- lsp-test-0.8.2.0
- monad-dijkstra-0.1.1.2@rev:1
- syz-0.2.0.0
- temporary-1.2.1.1

11
test/dispatcher/Main.hs
View File

@ -71,12 +71,13 @@ startServer :: IO (Scheduler IO, TChan LogVal, ThreadId)
startServer = do
scheduler <- newScheduler plugins testOptions
logChan <- newTChanIO
dispatcher <- forkIO $
dispatcher <- forkIO $ do
flushStackEnvironment
runScheduler
scheduler
(\lid errCode e -> logToChan logChan ("received an error", Left (lid, errCode, e)))
(\g x -> g x)
def
scheduler
(\lid errCode e -> logToChan logChan ("received an error", Left (lid, errCode, e)))
(\g x -> g x)
def
return (scheduler, logChan, dispatcher)

40
test/functional/FunctionalCodeActionsSpec.hs
View File

@ -212,31 +212,33 @@ spec = describe "code actions" $ do
]
]
describe "add package suggestions" $ do
it "adds to .cabal files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal-exe" $ do
doc <- openDoc "AddPackage.hs" "haskell"
it "adds to .cabal files" $ do
flushStackEnvironment
runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal-exe" $ do
doc <- openDoc "AddPackage.hs" "haskell"
-- ignore the first empty hlint diagnostic publish
[_,diag:_] <- count 2 waitForDiagnostics
-- ignore the first empty hlint diagnostic publish
[_,diag:_] <- count 2 waitForDiagnostics
let prefixes = [ "Could not load module `Data.Text'" -- Windows && GHC >= 8.6
, "Could not find module `Data.Text'" -- Windows
, "Could not load module ‘Data.Text’" -- GHC >= 8.6
, "Could not find module ‘Data.Text’"
]
in liftIO $ diag ^. L.message `shouldSatisfy` \m -> any (`T.isPrefixOf` m) prefixes
let prefixes = [ "Could not load module `Data.Text'" -- Windows && GHC >= 8.6
, "Could not find module `Data.Text'" -- Windows
, "Could not load module ‘Data.Text’" -- GHC >= 8.6
, "Could not find module ‘Data.Text’"
]
in liftIO $ diag ^. L.message `shouldSatisfy` \m -> any (`T.isPrefixOf` m) prefixes
acts <- getAllCodeActions doc
let (CACodeAction action:_) = acts
acts <- getAllCodeActions doc
let (CACodeAction action:_) = acts
liftIO $ do
action ^. L.title `shouldBe` "Add text as a dependency"
action ^. L.kind `shouldBe` Just CodeActionQuickFix
action ^. L.command . _Just . L.command `shouldSatisfy` T.isSuffixOf "package:add"
liftIO $ do
action ^. L.title `shouldBe` "Add text as a dependency"
action ^. L.kind `shouldBe` Just CodeActionQuickFix
action ^. L.command . _Just . L.command `shouldSatisfy` T.isSuffixOf "package:add"
executeCodeAction action
executeCodeAction action
contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "add-package-test.cabal"
liftIO $ T.lines contents `shouldSatisfy` \x -> any (\l -> "text -any" `T.isSuffixOf` (x !! l)) [15, 16]
contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "add-package-test.cabal"
liftIO $ T.lines contents `shouldSatisfy` \x -> any (\l -> "text -any" `T.isSuffixOf` (x !! l)) [15, 16]
it "adds to hpack package.yaml files" $
runSession hieCommand fullCaps "test/testdata/addPackageTest/hpack-exe" $ do

9
test/functional/FunctionalLiquidSpec.hs
View File

@ -98,11 +98,16 @@ spec = describe "liquid haskell diagnostics" $ do
-- liftIO $ show diags3 `shouldBe` ""
liftIO $ do
length diags3 `shouldBe` 1
d ^. range `shouldBe` Range (Position 8 0) (Position 8 7)
d ^. range `shouldBe` Range (Position 8 0) (Position 8 11)
d ^. severity `shouldBe` Just DsError
d ^. code `shouldBe` Nothing
d ^. source `shouldBe` Just "liquid"
d ^. message `shouldSatisfy` (T.isPrefixOf "Error: Liquid Type Mismatch\n Inferred type\n VV : {v : Int | v == (7 : int)}\n \n not a subtype of Required type\n VV : {VV : Int | VV mod 2 == 0}\n")
d ^. message `shouldSatisfy` T.isPrefixOf ("Error: Liquid Type Mismatch\n" <>
" Inferred type\n" <>
" VV : {v : GHC.Types.Int | v == 7}\n" <>
" \n" <>
" not a subtype of Required type\n" <>
" VV : {VV : GHC.Types.Int | VV mod 2 == 0}\n ")
-- ---------------------------------------------------------------------

55
test/unit/LiquidSpec.hs
View File

@ -3,16 +3,19 @@
module LiquidSpec where
import Data.Aeson
import Data.List
import qualified Data.ByteString.Lazy as BS
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Monoid ((<>))
import Data.Maybe (isJust)
import Haskell.Ide.Engine.MonadTypes
import Haskell.Ide.Engine.Plugin.Liquid
import System.Directory
import System.Exit
import System.FilePath
import System.Process
import Test.Hspec
-- import Control.Monad.IO.Class
main :: IO ()
main = hspec spec
@ -24,22 +27,27 @@ spec = do
-- ---------------------------------
it "finds liquid haskell exe in $PATH" $ findExecutable "liquid" >>= (`shouldSatisfy` isJust)
it "the liquid haskell exe in $PATH has the supported version" $ do
mexe <- findExecutable "liquid"
case mexe of
Nothing -> expectationFailure "liquid haskell exe is NOT in $PATH"
Just exe -> do
version <- readProcess exe ["--numeric-version"] ""
version `shouldSatisfy` isPrefixOf "0.8.6.2"
-- ---------------------------------
-- AZ: this test has been moved to func-tests, stack > 2.1 sets
-- its own package environment, we can't run it from here.
-- -- This produces some products in /test/testdata/liquid/.liquid/ that is used in subsequent test
-- it "runs the liquid haskell exe" $ do
-- let
-- fp = cwd </> "test/testdata/liquid/Evens.hs"
-- -- fp = "/home/alanz/tmp/haskell-proc-play/Evens.hs"
-- -- uri = filePathToUri fp
-- Just (ef, (msg:_)) <- runLiquidHaskell fp
-- msg `shouldSatisfy` isPrefixOf "RESULT\n[{\"start\":{\"line\":9,\"column\":1},\"stop\":{\"line\":9,\"column\":8},\"message\":\"Error: Liquid Type Mismatch\\n Inferred type\\n VV : {v : Int | v == (7 : int)}\\n \\n not a subtype of Required type\\n VV : {VV : Int | VV mod 2 == 0}\\n"
-- ef `shouldBe` ExitFailure 1
-- This produces some products in /test/testdata/liquid/.liquid/
-- that are used in subsequent test
it "runs the liquid haskell exe" $ do
let
fp = cwd </> "test/testdata/liquid/Evens.hs"
Just (ef, (msg:_)) <- runLiquidHaskell fp
-- liftIO $ putStrLn $ "msg=" ++ msg
-- liftIO $ putStrLn $ "msg=" ++ unlines (drop 3 (lines msg))
let msg' = unlines (drop 3 (lines msg))
msg' `shouldSatisfy` isInfixOf "RESULT\n[{\"start\":{\"line\""
ef `shouldBe` ExitFailure 1
-- ---------------------------------
it "gets annot file paths" $ do
@ -60,12 +68,15 @@ spec = do
let Just v = decode jf :: Maybe LiquidJson
let [LE { start, stop, message }] = errors v
start `shouldBe` LP 9 1
stop `shouldBe` LP 9 8
stop `shouldBe` LP 9 12
message `shouldSatisfy` T.isPrefixOf
("Error: Liquid Type Mismatch\n Inferred type\n" <>
" VV : {v : Int | v == (7 : int)}\n \n" <>
("Error: Liquid Type Mismatch\n" <>
" Inferred type\n" <>
" VV : {v : GHC.Types.Int | v == 7}\n" <>
" \n" <>
" not a subtype of Required type\n" <>
" VV : {VV : Int | VV mod 2 == 0}\n")
" VV : {VV : GHC.Types.Int | VV mod 2 == 0}\n" <>
" ")
-- ---------------------------------
@ -100,8 +111,8 @@ spec = do
take 2 ts
`shouldBe`
[LE (LP 1 1) (LP 1 1) "GHC.Types.Module"
,LE (LP 6 1) (LP 6 10) "[{v : GHC.Types.Int | v mod 2 == 0}]"]
length ts `shouldBe` 38
,LE (LP 6 1) (LP 6 10) "[{VV : GHC.Types.Int | VV mod 2 == 0}]"]
length ts `shouldBe` 53
-- ---------------------------------
@ -112,8 +123,8 @@ spec = do
take 2 ts
`shouldBe`
[LE (LP 1 1) (LP 1 1) "GHC.Types.Module"
,LE (LP 6 1) (LP 6 10) "[{v : GHC.Types.Int | v mod 2 == 0}]"]
length ts `shouldBe` 38
,LE (LP 6 1) (LP 6 10) "[{VV : GHC.Types.Int | VV mod 2 == 0}]"]
length ts `shouldBe` 53
-- ---------------------------------

13
test/utils/TestUtils.hs
View File

@ -15,6 +15,7 @@ module TestUtils
, hieCommandVomit
, hieCommandExamplePlugin
, getHspecFormattedConfig
, flushStackEnvironment
) where
import Control.Concurrent.STM
@ -54,6 +55,7 @@ testOptions = defaultOptions {
testCommand :: (ToJSON a, Typeable b, ToJSON b, Show b, Eq b)
=> IdePlugins -> IdeGhcM (IdeResult b) -> PluginId -> CommandName -> a -> IdeResult b -> IO ()
testCommand testPlugins act plugin cmd arg res = do
flushStackEnvironment
(newApiRes, oldApiRes) <- runIGM testPlugins $ do
new <- act
old <- makeRequest plugin cmd arg
@ -285,3 +287,14 @@ xmlFormatter = silent {
-- ---------------------------------------------------------------------
flushStackEnvironment :: IO ()
flushStackEnvironment = do
-- We need to clear these environment variables to prevent
-- collisions with stack usages
-- See https://github.com/commercialhaskell/stack/issues/4875
unsetEnv "GHC_PACKAGE_PATH"
unsetEnv "GHC_ENVIRONMENT"
unsetEnv "HASKELL_PACKAGE_SANDBOX"
unsetEnv "HASKELL_PACKAGE_SANDBOXES"
-- ---------------------------------------------------------------------