mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 09:17:43 +03:00
DAML REPL - Explicit package imports (#6707)
* DAML REPL - Explicit package imports changelog_begin - [DAML REPL] The REPL no longer imports all modules from the main DALFs of all specified DARs automatically at start-up. Instead, the REPL will only import modules from packages specified on the command-line using the `--import` flag. changelog_end * Accept package-name or package-id * REPL test case for --import flag * DAML REPL use `UnitId` for import packages Addressing review comment https://github.com/digital-asset/daml/pull/6707#discussion_r453731353 * DAML REPL Parse package-name/id at CLI * DAML REPL Simplify unversioned pkgs Co-authored-by: Andreas Herrmann <andreas.herrmann@tweag.io>
This commit is contained in:
Andreas Herrmann
GitHub
parent
3f2938ecf6
commit
ae65f93e01
@ -13,7 +13,6 @@ import qualified DA.Daml.LF.Ast as LF
|
||||
import DA.Daml.LF.Ast.Optics (packageRefs)
|
||||
import qualified DA.Daml.LF.ReplClient as ReplClient
|
||||
import DA.Daml.LFConversion.UtilGHC
|
||||
import DA.Daml.Options.Packaging.Metadata
|
||||
import DA.Daml.Options.Types
|
||||
import qualified DA.Daml.Preprocessor.Records as Preprocessor
|
||||
import Data.Bifunctor (first)
|
||||
@ -21,6 +20,7 @@ import Data.Functor.Alt
|
||||
import Data.Foldable
|
||||
import Data.Generics.Uniplate.Data (descendBi)
|
||||
import Data.Graph
|
||||
import Data.List (intercalate)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe
|
||||
import qualified Data.NameMap as NM
|
||||
@ -40,6 +40,7 @@ import HsPat (Pat(..))
|
||||
import HscTypes (HscEnv(..))
|
||||
import Language.Haskell.GhclibParserEx.Parse
|
||||
import Lexer (ParseResult(..))
|
||||
import Module (unitIdString)
|
||||
import OccName (occName, OccSet, elemOccSet, mkOccSet, mkVarOcc)
|
||||
import Outputable (ppr, showSDoc)
|
||||
import RdrName (mkRdrUnqual)
|
||||
@ -183,9 +184,9 @@ parseReplInput input dflags =
|
||||
|
||||
-- | Load all packages in the given session.
|
||||
--
|
||||
-- Returns the list of modules in the main DALFs.
|
||||
loadPackages :: ReplClient.Handle -> IdeState -> IO [ImportDecl GhcPs]
|
||||
loadPackages replClient ideState = do
|
||||
-- Returns the list of modules in the specified import packages.
|
||||
loadPackages :: [(LF.PackageName, Maybe LF.PackageVersion)] -> ReplClient.Handle -> IdeState -> IO [ImportDecl GhcPs]
|
||||
loadPackages importPkgs replClient ideState = do
|
||||
-- Load packages
|
||||
Just (PackageMap pkgs) <- runAction ideState (use GeneratePackageMap "Dummy.daml")
|
||||
Just stablePkgs <- runAction ideState (use GenerateStablePackages "Dummy.daml")
|
||||
@ -196,19 +197,29 @@ loadPackages replClient ideState = do
|
||||
hPutStrLn stderr ("Package could not be loaded: " <> show err)
|
||||
exitFailure
|
||||
Right _ -> pure ()
|
||||
-- Determine module names in main DALFs.
|
||||
md <- readMetadata (toNormalizedFilePath' ".")
|
||||
-- Determine module names in imported DALFs.
|
||||
let unversionedPkgs = Map.mapKeys (fst . LF.splitUnitId) pkgs
|
||||
toUnitId (pkgName, mbVersion) = pkgNameVersion pkgName mbVersion
|
||||
lookupPkg (pkgName, Nothing) = Map.lookup pkgName unversionedPkgs
|
||||
lookupPkg (toUnitId -> unitId) = Map.lookup unitId pkgs
|
||||
importLfPkgs <- forM importPkgs $ \importPkg ->
|
||||
case lookupPkg importPkg of
|
||||
Just dalf -> pure $ LF.extPackagePkg $ LF.dalfPackagePkg dalf
|
||||
Nothing -> do
|
||||
hPutStrLn stderr $
|
||||
"Could not find package for import: " <> unitIdString (toUnitId importPkg) <> "\n"
|
||||
<> "Known packages: " <> intercalate ", " (unitIdString <$> Map.keys pkgs)
|
||||
exitFailure
|
||||
pure
|
||||
[ simpleImportDecl . mkModuleName . T.unpack . LF.moduleNameString $ mod
|
||||
| dep <- directDependencies md
|
||||
, let pkg = LF.extPackagePkg $ LF.dalfPackagePkg $ pkgs Map.! dep
|
||||
| pkg <- importLfPkgs
|
||||
, mod <- NM.names $ LF.packageModules pkg
|
||||
]
|
||||
|
||||
|
||||
runRepl :: Options -> ReplClient.Handle -> IdeState -> IO ()
|
||||
runRepl opts replClient ideState = do
|
||||
imports <- loadPackages replClient ideState
|
||||
runRepl :: [(LF.PackageName, Maybe LF.PackageVersion)] -> Options -> ReplClient.Handle -> IdeState -> IO ()
|
||||
runRepl importPkgs opts replClient ideState = do
|
||||
imports <- loadPackages importPkgs replClient ideState
|
||||
let initReplState = ReplState
|
||||
{ imports = imports
|
||||
, bindings = []
|
||||
|
||||
@ -29,6 +29,7 @@ import DA.Daml.LF.ScenarioServiceClient (readScenarioServiceConfig, withScenario
|
||||
import qualified DA.Daml.LF.ReplClient as ReplClient
|
||||
import DA.Daml.Compiler.Validate (validateDar)
|
||||
import qualified DA.Daml.LF.Ast as LF
|
||||
import DA.Daml.LF.Ast.Util (splitUnitId)
|
||||
import qualified DA.Daml.LF.Proto3.Archive as Archive
|
||||
import DA.Daml.LF.Reader
|
||||
import DA.Daml.LanguageServer
|
||||
@ -70,7 +71,7 @@ import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Options (clientSupportsProgress)
|
||||
import "ghc-lib-parser" DynFlags
|
||||
import GHC.Conc
|
||||
import "ghc-lib-parser" Module (unitIdString)
|
||||
import "ghc-lib-parser" Module (unitIdString, stringToUnitId)
|
||||
import qualified Network.Socket as NS
|
||||
import Options.Applicative.Extended
|
||||
import qualified Proto3.Suite as PS
|
||||
@ -91,6 +92,7 @@ import "ghc-lib" HscStats
|
||||
import "ghc-lib-parser" HscTypes
|
||||
import qualified "ghc-lib-parser" Outputable as GHC
|
||||
import qualified SdkVersion
|
||||
import "ghc-lib-parser" Util (looksLikePackageName)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Commands
|
||||
@ -261,6 +263,7 @@ cmdRepl numProcessors =
|
||||
<*> strOption (long "script-lib" <> value "daml-script" <> internal)
|
||||
-- ^ This is useful for tests and `bazel run`.
|
||||
<*> many (strArgument (help "DAR to load in the repl" <> metavar "DAR"))
|
||||
<*> many packageImport
|
||||
<*> strOption (long "ledger-host" <> help "Host of the ledger API")
|
||||
<*> strOption (long "ledger-port" <> help "Port of the ledger API")
|
||||
<*> accessTokenFileFlag
|
||||
@ -271,6 +274,18 @@ cmdRepl numProcessors =
|
||||
help "Optional max inbound message size in bytes."
|
||||
)
|
||||
<*> timeModeFlag
|
||||
packageImport = option readPackage $
|
||||
long "import"
|
||||
<> short 'i'
|
||||
<> help "Import modules of these packages into the REPL"
|
||||
<> metavar "PACKAGE"
|
||||
where
|
||||
readPackage = eitherReader $ \s -> do
|
||||
let pkg@(name, _) = splitUnitId (stringToUnitId s)
|
||||
strName = T.unpack . LF.unPackageName $ name
|
||||
unless (looksLikePackageName strName) $
|
||||
fail $ "Illegal package name: " ++ strName
|
||||
pure pkg
|
||||
accessTokenFileFlag = optional . option str $
|
||||
long "access-token-file"
|
||||
<> metavar "TOKEN_PATH"
|
||||
@ -583,14 +598,14 @@ execBuild projectOpts opts mbOutFile incrementalBuild initPkgDb =
|
||||
execRepl
|
||||
:: ProjectOpts
|
||||
-> Options
|
||||
-> FilePath -> [FilePath]
|
||||
-> FilePath -> [FilePath] -> [(LF.PackageName, Maybe LF.PackageVersion)]
|
||||
-> String -> String
|
||||
-> Maybe FilePath
|
||||
-> Maybe ReplClient.ClientSSLConfig
|
||||
-> Maybe ReplClient.MaxInboundMessageSize
|
||||
-> ReplClient.ReplTimeMode
|
||||
-> Command
|
||||
execRepl projectOpts opts scriptDar dars ledgerHost ledgerPort mbAuthToken mbSslConf mbMaxInboundMessageSize timeMode = Command Repl (Just projectOpts) effect
|
||||
execRepl projectOpts opts scriptDar dars importPkgs ledgerHost ledgerPort mbAuthToken mbSslConf mbMaxInboundMessageSize timeMode = Command Repl (Just projectOpts) effect
|
||||
where effect = do
|
||||
-- We change directory so make this absolute
|
||||
dars <- mapM makeAbsolute dars
|
||||
@ -619,7 +634,7 @@ execRepl projectOpts opts scriptDar dars ledgerHost ledgerPort mbAuthToken mbSsl
|
||||
initPackageDb opts (InitPkgDb True)
|
||||
-- We want diagnostics to go to stdout in the repl.
|
||||
withDamlIdeState opts logger (hDiagnosticsLogger stdout)
|
||||
(Repl.runRepl opts replHandle)
|
||||
(Repl.runRepl importPkgs opts replHandle)
|
||||
|
||||
-- | Remove any build artifacts if they exist.
|
||||
execClean :: ProjectOpts -> Command
|
||||
|
||||
@ -521,6 +521,7 @@ da_haskell_test(
|
||||
visibility = ["//visibility:public"],
|
||||
deps = [
|
||||
"//:sdk-version-hs-lib",
|
||||
"//compiler/daml-lf-ast",
|
||||
"//compiler/damlc:damlc-lib",
|
||||
"//compiler/damlc/daml-compiler",
|
||||
"//compiler/damlc/daml-ide-core",
|
||||
|
||||
@ -57,6 +57,11 @@ main = do
|
||||
staticTimeTests damlc scriptDar testDar getSandboxPort
|
||||
, withSandbox defaultSandboxConf $ \getSandboxPort ->
|
||||
noPackageTests damlc scriptDar getSandboxPort
|
||||
, withSandbox defaultSandboxConf
|
||||
{ dars = [testDar]
|
||||
, mbLedgerId = Just testLedgerId
|
||||
} $ \getSandboxPort ->
|
||||
importTests damlc scriptDar testDar getSandboxPort
|
||||
]
|
||||
|
||||
withTokenFile :: (IO FilePath -> TestTree) -> TestTree
|
||||
@ -126,6 +131,8 @@ testConnection damlc scriptDar testDar ledgerPort mbTokenFile mbCaCrt = do
|
||||
, "--script-lib"
|
||||
, scriptDar
|
||||
, testDar
|
||||
, "--import"
|
||||
, "repl-test"
|
||||
]
|
||||
, [ "--access-token-file=" <> tokenFile | Just tokenFile <- [mbTokenFile] ]
|
||||
, [ "--cacrt=" <> cacrt | Just cacrt <- [mbCaCrt] ]
|
||||
@ -188,4 +195,52 @@ testSetTime damlc scriptDar testDar ledgerPort = do
|
||||
, "--script-lib"
|
||||
, scriptDar
|
||||
, testDar
|
||||
, "--import"
|
||||
, "repl-test"
|
||||
]
|
||||
|
||||
-- | Test the @--import@ flag
|
||||
importTests :: FilePath -> FilePath -> FilePath -> IO Int -> TestTree
|
||||
importTests damlc scriptDar testDar getSandboxPort = testGroup "import"
|
||||
[ testCase "none" $ do
|
||||
port <- getSandboxPort
|
||||
testImport damlc scriptDar testDar port [] False
|
||||
, testCase "unversioned" $ do
|
||||
port <- getSandboxPort
|
||||
testImport damlc scriptDar testDar port ["repl-test"] True
|
||||
, testCase "versioned" $ do
|
||||
port <- getSandboxPort
|
||||
testImport damlc scriptDar testDar port ["repl-test-0.1.0"] True
|
||||
]
|
||||
|
||||
testImport
|
||||
:: FilePath
|
||||
-> FilePath
|
||||
-> FilePath
|
||||
-> Int
|
||||
-> [String]
|
||||
-> Bool
|
||||
-> Assertion
|
||||
testImport damlc scriptDar testDar ledgerPort imports successful = do
|
||||
out <- readCreateProcess cp $ unlines
|
||||
[ "alice <- allocateParty \"Alice\""
|
||||
, "debug (T alice alice)"
|
||||
]
|
||||
let regexString :: String
|
||||
regexString
|
||||
| successful = "^daml> daml> .*: T {proposer = '.*', accepter = '.*'}\ndaml> Goodbye.\n$"
|
||||
| otherwise = "^daml> daml> File: .*\nHidden: .*\nRange: .*\nSource: .*\nSeverity: DsError\nMessage: .*: error:Data constructor not in scope: T : Party -> Party -> .*\ndaml> Goodbye.\n$"
|
||||
let regex = makeRegexOpts defaultCompOpt { multiline = False } defaultExecOpt regexString
|
||||
unless (matchTest regex out) $
|
||||
assertFailure (show out <> " did not match " <> show regexString <> ".")
|
||||
where cp = proc damlc $ concat
|
||||
[ [ "repl"
|
||||
, "--ledger-host=localhost"
|
||||
, "--ledger-port"
|
||||
, show ledgerPort
|
||||
, "--script-lib"
|
||||
, scriptDar
|
||||
, testDar
|
||||
]
|
||||
, [ "--import=" <> pkg | pkg <- imports ]
|
||||
]
|
||||
|
||||
@ -11,6 +11,7 @@ import DA.Bazel.Runfiles
|
||||
import DA.Cli.Damlc.Packaging
|
||||
import DA.Cli.Output
|
||||
import DA.Daml.Compiler.Repl
|
||||
import qualified DA.Daml.LF.Ast as LF
|
||||
import qualified DA.Daml.LF.ReplClient as ReplClient
|
||||
import DA.Daml.Options.Types
|
||||
import DA.Daml.Package.Config
|
||||
@ -264,7 +265,8 @@ testInteraction replClient serviceOut options ideState steps = do
|
||||
withBinaryFile stdinFile ReadMode $ \readIn ->
|
||||
redirectingHandle stdin readIn $ do
|
||||
Right () <- ReplClient.clearResults replClient
|
||||
capture_ $ runRepl options replClient ideState
|
||||
let imports = [(LF.PackageName name, Nothing) | name <- ["repl-test", "repl-test-two"]]
|
||||
capture_ $ runRepl imports options replClient ideState
|
||||
-- Write output to a file so we can conveniently read individual characters.
|
||||
withTempFile $ \clientOutFile -> do
|
||||
writeFileUTF8 clientOutFile out
|
||||
|
||||
Loading…
Reference in New Issue
Block a user