mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-09-20 05:07:28 +03:00
Rebase ghcide changes, and match in hls branch
This commit is contained in:
parent
1470977ceb
commit
5bae0dd9a2
@ -16,4 +16,4 @@ package ghcide
|
||||
|
||||
write-ghc-environment-files: never
|
||||
|
||||
index-state: 2020-02-09T06:58:05Z
|
||||
index-state: 2020-03-03T21:14:55Z
|
||||
|
48
exe/Main.hs
48
exe/Main.hs
@ -12,18 +12,15 @@ module Main(main) where
|
||||
|
||||
import Arguments
|
||||
import Control.Concurrent.Extra
|
||||
import Control.DeepSeq (NFData)
|
||||
import Control.Exception
|
||||
import Control.Monad.Extra
|
||||
import Control.Monad.IO.Class
|
||||
import qualified Crypto.Hash.SHA1 as H
|
||||
import Data.Binary (Binary)
|
||||
import Data.ByteString.Base16
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.Default
|
||||
import Data.Dynamic (Typeable)
|
||||
import Data.Functor ((<&>))
|
||||
import qualified Data.HashSet as HashSet
|
||||
import Data.Hashable (Hashable)
|
||||
import Data.List.Extra
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe
|
||||
@ -46,10 +43,9 @@ import Development.IDE.Types.Diagnostics
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Logger
|
||||
import Development.IDE.Types.Options
|
||||
import Development.Shake (Action, RuleResult, Rules, action, doesFileExist, need)
|
||||
import Development.Shake (Action, Rules, action, doesFileExist, doesDirectoryExist, need)
|
||||
import DynFlags
|
||||
import GHC hiding (def)
|
||||
import GHC.Generics (Generic)
|
||||
-- import qualified GHC.Paths
|
||||
import HIE.Bios
|
||||
import HIE.Bios.Cradle
|
||||
@ -63,6 +59,7 @@ import Language.Haskell.LSP.Types (LspId(IdInt))
|
||||
import qualified Language.Haskell.LSP.Core as LSP
|
||||
import Linker
|
||||
-- import Paths_haskell_language_server
|
||||
import RuleTypes
|
||||
import qualified System.Directory.Extra as IO
|
||||
-- import System.Environment
|
||||
import System.Exit
|
||||
@ -152,7 +149,7 @@ main = do
|
||||
, optShakeProfiling = argsShakeProfiling
|
||||
}
|
||||
debouncer <- newAsyncDebouncer
|
||||
initialise caps (loadGhcSessionIO >> mainRule >> pluginRules plugins >> action kick)
|
||||
initialise caps (cradleRules >> mainRule >> pluginRules plugins >> action kick)
|
||||
getLspId event (logger minBound) debouncer options vfs
|
||||
else do
|
||||
putStrLn $ "(haskell-language-server)Ghcide setup tester in " ++ dir ++ "."
|
||||
@ -189,7 +186,7 @@ main = do
|
||||
let options =
|
||||
(defaultIdeOptions $ return $ return . grab)
|
||||
{ optShakeProfiling = argsShakeProfiling }
|
||||
ide <- initialise def (loadGhcSessionIO >> mainRule) (pure $ IdInt 0) (showEvent lock) (logger Info) noopDebouncer options vfs
|
||||
ide <- initialise def (cradleRules >> mainRule) (pure $ IdInt 0) (showEvent lock) (logger Info) noopDebouncer options vfs
|
||||
|
||||
putStrLn "\nStep 6/6: Type checking the files"
|
||||
setFilesOfInterest ide $ HashSet.fromList $ map toNormalizedFilePath files
|
||||
@ -203,6 +200,10 @@ main = do
|
||||
|
||||
unless (null failed) exitFailure
|
||||
|
||||
cradleRules :: Rules ()
|
||||
cradleRules = do
|
||||
loadGhcSessionIO
|
||||
cradleToSession
|
||||
|
||||
expandFiles :: [FilePath] -> IO [FilePath]
|
||||
expandFiles = concatMapM $ \x -> do
|
||||
@ -230,19 +231,6 @@ showEvent lock (EventFileDiagnostics (toNormalizedFilePath -> file) diags) =
|
||||
showEvent lock e = withLock lock $ print e
|
||||
|
||||
|
||||
-- Rule type for caching GHC sessions.
|
||||
type instance RuleResult GetHscEnv = HscEnvEq
|
||||
|
||||
data GetHscEnv = GetHscEnv
|
||||
{ hscenvOptions :: [String] -- componentOptions from hie-bios
|
||||
, hscenvDependencies :: [FilePath] -- componentDependencies from hie-bios
|
||||
}
|
||||
deriving (Eq, Show, Typeable, Generic)
|
||||
instance Hashable GetHscEnv
|
||||
instance NFData GetHscEnv
|
||||
instance Binary GetHscEnv
|
||||
|
||||
|
||||
loadGhcSessionIO :: Rules ()
|
||||
loadGhcSessionIO =
|
||||
-- This rule is for caching the GHC session. E.g., even when the cabal file
|
||||
@ -255,6 +243,7 @@ loadGhcSessionIO =
|
||||
getComponentOptions :: Cradle a -> IO ComponentOptions
|
||||
getComponentOptions cradle = do
|
||||
let showLine s = putStrLn ("> " ++ s)
|
||||
-- WARNING 'runCradle is very expensive and must be called as few times as possible
|
||||
cradleRes <- runCradle (cradleOptsProg cradle) showLine ""
|
||||
case cradleRes of
|
||||
CradleSuccess r -> pure r
|
||||
@ -310,8 +299,14 @@ setHiDir f d =
|
||||
-- override user settings to avoid conflicts leading to recompilation
|
||||
d { hiDir = Just f}
|
||||
|
||||
cradleToSession :: Maybe FilePath -> Cradle a -> Action HscEnvEq
|
||||
cradleToSession mbYaml cradle = do
|
||||
cradleToSession :: Rules ()
|
||||
cradleToSession = define $ \LoadCradle nfp -> do
|
||||
let f = fromNormalizedFilePath nfp
|
||||
|
||||
-- If the path points to a directory, load the implicit cradle
|
||||
mbYaml <- doesDirectoryExist f <&> \isDir -> if isDir then Nothing else Just f
|
||||
cradle <- liftIO $ maybe (loadImplicitCradle $ addTrailingPathSeparator f) loadCradle mbYaml
|
||||
|
||||
cmpOpts <- liftIO $ getComponentOptions cradle
|
||||
let opts = componentOptions cmpOpts
|
||||
deps = componentDependencies cmpOpts
|
||||
@ -321,7 +316,7 @@ cradleToSession mbYaml cradle = do
|
||||
_ -> deps
|
||||
existingDeps <- filterM doesFileExist deps'
|
||||
need existingDeps
|
||||
useNoFile_ $ GetHscEnv opts deps
|
||||
([],) . pure <$> useNoFile_ (GetHscEnv opts deps)
|
||||
|
||||
|
||||
loadSession :: FilePath -> Action (FilePath -> Action HscEnvEq)
|
||||
@ -335,8 +330,9 @@ loadSession dir = liftIO $ do
|
||||
return $ normalise <$> res'
|
||||
let session :: Maybe FilePath -> Action HscEnvEq
|
||||
session file = do
|
||||
c <- liftIO $ maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle file
|
||||
cradleToSession file c
|
||||
-- In the absence of a cradle file, just pass the directory from where to calculate an implicit cradle
|
||||
let cradle = toNormalizedFilePath $ fromMaybe dir file
|
||||
use_ LoadCradle cradle
|
||||
return $ \file -> session =<< liftIO (cradleLoc file)
|
||||
|
||||
|
||||
|
34
exe/RuleTypes.hs
Normal file
34
exe/RuleTypes.hs
Normal file
@ -0,0 +1,34 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module RuleTypes (GetHscEnv(..), LoadCradle(..)) where
|
||||
|
||||
import Control.DeepSeq
|
||||
import Data.Binary
|
||||
import Data.Hashable (Hashable)
|
||||
import Development.Shake
|
||||
import Development.IDE.GHC.Util
|
||||
import Data.Typeable (Typeable)
|
||||
import GHC.Generics (Generic)
|
||||
|
||||
-- Rule type for caching GHC sessions.
|
||||
type instance RuleResult GetHscEnv = HscEnvEq
|
||||
|
||||
data GetHscEnv = GetHscEnv
|
||||
{ hscenvOptions :: [String] -- componentOptions from hie-bios
|
||||
, hscenvDependencies :: [FilePath] -- componentDependencies from hie-bios
|
||||
}
|
||||
deriving (Eq, Show, Typeable, Generic)
|
||||
|
||||
instance Hashable GetHscEnv
|
||||
instance NFData GetHscEnv
|
||||
instance Binary GetHscEnv
|
||||
|
||||
-- Rule type for caching cradle loading
|
||||
type instance RuleResult LoadCradle = HscEnvEq
|
||||
|
||||
data LoadCradle = LoadCradle
|
||||
deriving (Eq, Show, Typeable, Generic)
|
||||
|
||||
instance Hashable LoadCradle
|
||||
instance NFData LoadCradle
|
||||
instance Binary LoadCradle
|
2
ghcide
2
ghcide
@ -1 +1 @@
|
||||
Subproject commit b98b101f87113f96f360d5eadda1125a16b88a12
|
||||
Subproject commit 66900802b9e86ad941d863d862683aa5b972425b
|
@ -92,6 +92,7 @@ executable haskell-language-server
|
||||
other-modules:
|
||||
Arguments
|
||||
Paths_haskell_language_server
|
||||
RuleTypes
|
||||
autogen-modules:
|
||||
Paths_haskell_language_server
|
||||
ghc-options:
|
||||
|
Loading…
Reference in New Issue
Block a user