mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 01:07:18 +03:00
Import the IDE modules unqualified instead of as Compile(rService) (#2227)
Some `Development.IDE.*` modules were imported qualified as either `Compile` or `CompilerService`. These names are at least odd and maybe also misleading. Since there's no actual need to import them qualified, let's just import them not qualified.
This commit is contained in:
Martin Huschenbett
mergify[bot]
parent
c0d6ac2a24
commit
37b7820942
@ -27,8 +27,8 @@ import qualified DA.Daml.LF.ScenarioServiceClient as SSC
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import qualified Development.Shake as Shake
|
||||
import qualified Development.IDE.Core.API as CompilerService
|
||||
import qualified Development.IDE.Core.Rules.Daml as CompilerService
|
||||
import Development.IDE.Core.API
|
||||
import Development.IDE.Core.Rules.Daml
|
||||
import Development.IDE.Types.Diagnostics
|
||||
import Development.IDE.Types.Location
|
||||
import qualified ScenarioService as SS
|
||||
@ -51,8 +51,8 @@ execTest inFiles color mbJUnitOutput cliOptions = do
|
||||
-- Run synchronously at the end to make sure that all gRPC requests
|
||||
-- finish properly. We have seen segfaults on CI sometimes
|
||||
-- which are probably caused by not doing this.
|
||||
CompilerService.runActionSync h (pure ())
|
||||
diags <- CompilerService.getDiagnostics h
|
||||
runActionSync h (pure ())
|
||||
diags <- getDiagnostics h
|
||||
when (any ((Just DsError ==) . _severity . snd) diags) exitFailure
|
||||
|
||||
|
||||
@ -63,12 +63,12 @@ testRun h inFiles lfVersion color mbJUnitOutput = do
|
||||
|
||||
-- take the transitive closure of all imports and run on all of them
|
||||
-- If some dependencies can't be resolved we'll get a Diagnostic out anyway, so don't worry
|
||||
deps <- CompilerService.runAction h $ mapM CompilerService.getDependencies inFiles
|
||||
deps <- runAction h $ mapM getDependencies inFiles
|
||||
let files = nubOrd $ concat $ inFiles : catMaybes deps
|
||||
|
||||
results <- CompilerService.runAction h $
|
||||
results <- runAction h $
|
||||
Shake.forP files $ \file -> do
|
||||
mbScenarioResults <- CompilerService.runScenarios file
|
||||
mbScenarioResults <- runScenarios file
|
||||
results <- case mbScenarioResults of
|
||||
Nothing -> failedTestOutput h file
|
||||
Just scenarioResults -> do
|
||||
@ -84,10 +84,10 @@ testRun h inFiles lfVersion color mbJUnitOutput = do
|
||||
|
||||
|
||||
-- We didn't get scenario results, so we use the diagnostics as the error message for each scenario.
|
||||
failedTestOutput :: IdeState -> NormalizedFilePath -> CompilerService.Action [(VirtualResource, Maybe T.Text)]
|
||||
failedTestOutput :: IdeState -> NormalizedFilePath -> Action [(VirtualResource, Maybe T.Text)]
|
||||
failedTestOutput h file = do
|
||||
mbScenarioNames <- CompilerService.getScenarioNames file
|
||||
diagnostics <- liftIO $ CompilerService.getDiagnostics h
|
||||
mbScenarioNames <- getScenarioNames file
|
||||
diagnostics <- liftIO $ getDiagnostics h
|
||||
let errMsg = showDiagnostics diagnostics
|
||||
pure $ map (, Just errMsg) $ fromMaybe [VRScenario file "Unknown"] mbScenarioNames
|
||||
|
||||
|
||||
@ -57,8 +57,8 @@ import Text.Read
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Text as T
|
||||
import System.Time.Extra
|
||||
import qualified Development.IDE.Core.API as Compile
|
||||
import qualified Development.IDE.Core.Rules.Daml as Compile
|
||||
import Development.IDE.Core.API
|
||||
import Development.IDE.Core.Rules.Daml
|
||||
import qualified Development.IDE.Types.Diagnostics as D
|
||||
import Development.IDE.GHC.Util
|
||||
import Data.Tagged (Tagged (..))
|
||||
@ -131,12 +131,12 @@ getIntegrationTests registerTODO scenarioService version = do
|
||||
}
|
||||
|
||||
-- initialise the compiler service
|
||||
vfs <- Compile.makeVFSHandle
|
||||
damlEnv <- Compile.mkDamlEnv opts (Just scenarioService)
|
||||
vfs <- makeVFSHandle
|
||||
damlEnv <- mkDamlEnv opts (Just scenarioService)
|
||||
pure $
|
||||
withResource
|
||||
(Compile.initialise (Compile.mainRule opts) (const $ pure ()) IdeLogger.noLogging damlEnv (toCompileOpts opts) vfs)
|
||||
Compile.shutdown $ \service ->
|
||||
(initialise (mainRule opts) (const $ pure ()) IdeLogger.noLogging damlEnv (toCompileOpts opts) vfs)
|
||||
shutdown $ \service ->
|
||||
withTestArguments $ \args -> testGroup ("Tests for DAML-LF " ++ renderPretty version) $
|
||||
map (testCase args version service outdir registerTODO) allTestFiles
|
||||
|
||||
@ -154,7 +154,7 @@ instance IsTest TestCase where
|
||||
pure $ res { resultDescription = desc }
|
||||
testOptions = Tagged []
|
||||
|
||||
testCase :: TestArguments -> LF.Version -> IO Compile.IdeState -> FilePath -> (TODO -> IO ()) -> FilePath -> TestTree
|
||||
testCase :: TestArguments -> LF.Version -> IO IdeState -> FilePath -> (TODO -> IO ()) -> FilePath -> TestTree
|
||||
testCase args version getService outdir registerTODO file = singleTest file . TestCase $ \log -> do
|
||||
service <- getService
|
||||
anns <- readFileAnns file
|
||||
@ -167,9 +167,9 @@ testCase args version getService outdir registerTODO file = singleTest file . Te
|
||||
}
|
||||
else do
|
||||
-- FIXME: Use of unsafeClearDiagnostics is only because we don't naturally lose them when we change setFilesOfInterest
|
||||
Compile.unsafeClearDiagnostics service
|
||||
unsafeClearDiagnostics service
|
||||
ex <- try $ mainProj args service outdir log (toNormalizedFilePath file) :: IO (Either SomeException Package)
|
||||
diags <- Compile.getDiagnostics service
|
||||
diags <- getDiagnostics service
|
||||
for_ [file ++ ", " ++ x | Todo x <- anns] (registerTODO . TODO)
|
||||
resDiag <- checkDiagnostics log [fields | DiagnosticFields fields <- anns] $
|
||||
[ideErrorText "" $ T.pack $ show e | Left e <- [ex], not $ "_IGNORE_" `isInfixOf` show e] ++ diags
|
||||
@ -307,7 +307,7 @@ parseRange s =
|
||||
(Position (rowEnd - 1) (colEnd - 1))
|
||||
_ -> error $ "Failed to parse range, got " ++ s
|
||||
|
||||
mainProj :: TestArguments -> Compile.IdeState -> FilePath -> (String -> IO ()) -> NormalizedFilePath -> IO LF.Package
|
||||
mainProj :: TestArguments -> IdeState -> FilePath -> (String -> IO ()) -> NormalizedFilePath -> IO LF.Package
|
||||
mainProj TestArguments{..} service outdir log file = do
|
||||
writeFile <- return $ \a b -> length b `seq` writeFile a b
|
||||
let proj = takeBaseName (fromNormalizedFilePath file)
|
||||
@ -316,8 +316,8 @@ mainProj TestArguments{..} service outdir log file = do
|
||||
let lfSave = timed log "LF saving" . liftIO . writeFileLf (outdir </> proj <.> "dalf")
|
||||
let lfPrettyPrint = timed log "LF pretty-printing" . liftIO . writeFile (outdir </> proj <.> "pdalf") . renderPretty
|
||||
|
||||
Compile.setFilesOfInterest service (Set.singleton file)
|
||||
Compile.runActionSync service $ do
|
||||
setFilesOfInterest service (Set.singleton file)
|
||||
runActionSync service $ do
|
||||
cores <- ghcCompile log file
|
||||
corePrettyPrint cores
|
||||
lf <- lfConvert log file
|
||||
@ -335,16 +335,16 @@ unjust act = do
|
||||
Just v -> return v
|
||||
|
||||
ghcCompile :: (String -> IO ()) -> NormalizedFilePath -> Action [GHC.CoreModule]
|
||||
ghcCompile log file = timed log "GHC compile" $ unjust $ Compile.getGhcCore file
|
||||
ghcCompile log file = timed log "GHC compile" $ unjust $ getGhcCore file
|
||||
|
||||
lfConvert :: (String -> IO ()) -> NormalizedFilePath -> Action LF.Package
|
||||
lfConvert log file = timed log "LF convert" $ unjust $ Compile.getRawDalf file
|
||||
lfConvert log file = timed log "LF convert" $ unjust $ getRawDalf file
|
||||
|
||||
lfTypeCheck :: (String -> IO ()) -> NormalizedFilePath -> Action LF.Package
|
||||
lfTypeCheck log file = timed log "LF type check" $ unjust $ Compile.getDalf file
|
||||
lfTypeCheck log file = timed log "LF type check" $ unjust $ getDalf file
|
||||
|
||||
lfRunScenarios :: (String -> IO ()) -> NormalizedFilePath -> Action ()
|
||||
lfRunScenarios log file = timed log "LF execution" $ void $ unjust $ Compile.runScenarios file
|
||||
lfRunScenarios log file = timed log "LF execution" $ void $ unjust $ runScenarios file
|
||||
|
||||
timed :: MonadIO m => (String -> IO ()) -> String -> m a -> m a
|
||||
timed log msg act = do
|
||||
|
||||
@ -28,9 +28,9 @@ module Development.IDE.Core.Rules(
|
||||
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.Trans.Maybe
|
||||
import qualified Development.IDE.Core.Compile as Compile
|
||||
import qualified Development.IDE.Types.Options as Compile
|
||||
import qualified Development.IDE.Spans.Calculate as Compile
|
||||
import Development.IDE.Core.Compile
|
||||
import Development.IDE.Types.Options
|
||||
import Development.IDE.Spans.Calculate
|
||||
import Development.IDE.Import.DependencyInformation
|
||||
import Development.IDE.Import.FindImports
|
||||
import Development.IDE.Core.FileStore
|
||||
@ -47,7 +47,7 @@ import Development.IDE.GHC.Error
|
||||
import Development.Shake hiding (Diagnostic, Env, newCache)
|
||||
import Development.IDE.Core.RuleTypes
|
||||
|
||||
import GHC
|
||||
import GHC hiding (parseModule, typecheckModule)
|
||||
import Development.IDE.GHC.Compat
|
||||
import UniqSupply
|
||||
import NameCache
|
||||
@ -105,7 +105,7 @@ getAtPoint file pos = fmap join $ runMaybeT $ do
|
||||
files <- transitiveModuleDeps <$> useE GetDependencies file
|
||||
tms <- usesE TypeCheck (file : files)
|
||||
spans <- useE GetSpanInfo file
|
||||
return $ AtPoint.atPoint opts (map Compile.tmrModule tms) spans pos
|
||||
return $ AtPoint.atPoint opts (map tmrModule tms) spans pos
|
||||
|
||||
-- | Goto Definition.
|
||||
getDefinition :: NormalizedFilePath -> Position -> Action (Maybe Location)
|
||||
@ -140,7 +140,7 @@ getParsedModuleRule =
|
||||
(_, contents) <- getFileContents file
|
||||
packageState <- useNoFile_ GhcSession
|
||||
opt <- getIdeOptions
|
||||
liftIO $ Compile.parseModule opt packageState (fromNormalizedFilePath file) contents
|
||||
liftIO $ parseModule opt packageState (fromNormalizedFilePath file) contents
|
||||
|
||||
getLocatedImportsRule :: Rules ()
|
||||
getLocatedImportsRule =
|
||||
@ -149,10 +149,10 @@ getLocatedImportsRule =
|
||||
let ms = pm_mod_summary pm
|
||||
let imports = ms_textual_imps ms
|
||||
env <- useNoFile_ GhcSession
|
||||
let dflags = Compile.addRelativeImport pm $ hsc_dflags env
|
||||
let dflags = addRelativeImport pm $ hsc_dflags env
|
||||
opt <- getIdeOptions
|
||||
xs <- forM imports $ \(mbPkgName, modName) ->
|
||||
(modName, ) <$> locateModule dflags (Compile.optExtensions opt) getFileExists modName mbPkgName
|
||||
(modName, ) <$> locateModule dflags (optExtensions opt) getFileExists modName mbPkgName
|
||||
return (concat $ lefts $ map snd xs, Just $ map (second eitherToMaybe) xs)
|
||||
|
||||
|
||||
@ -174,7 +174,7 @@ rawDependencyInformation f = go (Set.singleton f) Map.empty Map.empty
|
||||
modOrPkgImports <- forM imports $ \imp -> do
|
||||
case imp of
|
||||
(_modName, Just (PackageImport pkg)) -> do
|
||||
pkgs <- ExceptT $ liftIO $ Compile.computePackageDeps packageState pkg
|
||||
pkgs <- ExceptT $ liftIO $ computePackageDeps packageState pkg
|
||||
pure $ Right $ pkg:pkgs
|
||||
(modName, Just (FileImport absFile)) -> pure $ Left (modName, Just absFile)
|
||||
(modName, Nothing) -> pure $ Left (modName, Nothing)
|
||||
@ -237,7 +237,7 @@ getSpanInfoRule =
|
||||
tc <- use_ TypeCheck file
|
||||
imports <- use_ GetLocatedImports file
|
||||
packageState <- useNoFile_ GhcSession
|
||||
x <- liftIO $ Compile.getSrcSpanInfos packageState (fileImports imports) tc
|
||||
x <- liftIO $ getSrcSpanInfos packageState (fileImports imports) tc
|
||||
return ([], Just x)
|
||||
|
||||
-- Typechecks a module.
|
||||
@ -250,7 +250,7 @@ typeCheckRule =
|
||||
setPriority priorityTypeCheck
|
||||
packageState <- useNoFile_ GhcSession
|
||||
opt <- getIdeOptions
|
||||
liftIO $ Compile.typecheckModule opt packageState tms pm
|
||||
liftIO $ typecheckModule opt packageState tms pm
|
||||
|
||||
|
||||
generateCoreRule :: Rules ()
|
||||
@ -260,13 +260,13 @@ generateCoreRule =
|
||||
(tm:tms) <- uses_ TypeCheck (file:transitiveModuleDeps deps)
|
||||
setPriority priorityGenerateCore
|
||||
packageState <- useNoFile_ GhcSession
|
||||
liftIO $ Compile.compileModule packageState tms tm
|
||||
liftIO $ compileModule packageState tms tm
|
||||
|
||||
loadGhcSession :: Rules ()
|
||||
loadGhcSession =
|
||||
defineNoFile $ \GhcSession -> do
|
||||
opts <- getIdeOptions
|
||||
Compile.optGhcSession opts
|
||||
optGhcSession opts
|
||||
|
||||
|
||||
getHieFileRule :: Rules ()
|
||||
|
||||
Loading…
Reference in New Issue
Block a user