Only change project root once (#2459)

* Only change project root once

As described in #2449, calling withProjectRoot' twice breaks with
relative paths and is also just silly so this PR fixes this by
factoring out the actual logic from init from execInit which does the
project root thingy.

* Add a regression test

compiler/damlc/lib/DA/Cli/Damlc.hs

@@ -196,7 +196,7 @@ cmdInit =
     command "init" $
     info (helper <*> cmd) $ progDesc "Initialize a DAML project" <> fullDesc
   where
-    cmd = execInit <$> lfVersionOpt <*> projectOpts "daml damlc init" <*> pure (InitPkgDb True)
+    cmd = execInit <$> lfVersionOpt <*> projectOpts "daml damlc init"
 
 cmdPackage :: Int -> Mod CommandFields Command
 cmdPackage numProcessors =
@@ -311,7 +311,7 @@ execIde telemetry (Debug debug) enableScenarioService mbProfileDir = NS.withSock
     withLogger $ \loggerH ->
         withScenarioService' enableScenarioService loggerH scenarioServiceConfig $ \mbScenarioService -> do
             -- TODO we should allow different LF versions in the IDE.
-            execInit LF.versionDefault (ProjectOpts Nothing (ProjectCheck "" False)) (InitPkgDb True)
+            initPackageDb LF.versionDefault (InitPkgDb True)
             sdkVersion <- getSdkVersion `catchIO` const (pure "Unknown (not started via the assistant)")
             Logger.logInfo loggerH (T.pack $ "SDK version: " <> sdkVersion)
             runLanguageServer
@@ -387,10 +387,13 @@ withPackageConfig f = do
 
 -- | If we're in a daml project, read the daml.yaml field and create the project local package
 -- database. Otherwise do nothing.
-execInit :: LF.Version -> ProjectOpts -> InitPkgDb -> IO ()
-execInit lfVersion projectOpts (InitPkgDb shouldInit) =
-    when shouldInit $
-    withProjectRoot' projectOpts $ \_relativize -> do
+execInit :: LF.Version -> ProjectOpts -> IO ()
+execInit lfVersion projectOpts =
+    withProjectRoot' projectOpts $ \_relativize -> initPackageDb lfVersion (InitPkgDb True)
+
+initPackageDb :: LF.Version -> InitPkgDb -> IO ()
+initPackageDb lfVersion (InitPkgDb shouldInit) =
+    when shouldInit $ do
         isProject <- doesFileExist projectConfigName
         when isProject $ do
           project <- readProjectConfig $ ProjectPath "."
@@ -455,7 +458,7 @@ mbErr err = maybe (hPutStrLn stderr err >> exitFailure) pure
 
 execBuild :: ProjectOpts -> Options -> Maybe FilePath -> InitPkgDb -> IO ()
 execBuild projectOpts options mbOutFile initPkgDb = withProjectRoot' projectOpts $ \_relativize -> do
-    execInit (optDamlLfVersion options) projectOpts initPkgDb
+    initPackageDb (optDamlLfVersion options) initPkgDb
     withPackageConfig $ \pkgConfig@PackageConfigFields{..} -> do
         putStrLn $ "Compiling " <> pName <> " to a DAR."
         opts <- mkOptions options
@@ -648,10 +651,10 @@ execMigrate projectOpts opts0 inFile1_ inFile2_ mbDir = do
     inFile1 <- makeAbsolute inFile1_
     inFile2 <- makeAbsolute inFile2_
     loggerH <- getLogger opts "migrate"
-    -- initialise the package database
-    execInit (optDamlLfVersion opts) projectOpts (InitPkgDb True)
     withProjectRoot' projectOpts $ \_relativize
      -> do
+        -- initialise the package database
+        initPackageDb (optDamlLfVersion opts) (InitPkgDb True)
         -- for all contained dalfs, generate source, typecheck and generate interface files and
         -- overwrite the existing ones.
         dbPath <- makeAbsolute $

daml-assistant/integration-tests/src/Main.hs

@@ -89,7 +89,7 @@ throwError msg e = fail (T.unpack $ msg <> " " <> e)
 -- commands outside of the assistant.
 noassistantTests :: FilePath -> TestTree
 noassistantTests damlDir = testGroup "no assistant"
-    [ testCase "damlc build" $ withTempDir $ \projDir -> do
+    [ testCase "damlc build --init-package-db=no" $ withTempDir $ \projDir -> do
           writeFileUTF8 (projDir </> "daml.yaml") $ unlines
               [ "sdk-version: " <> sdkVersion
               , "name: a"
@@ -105,6 +105,25 @@ noassistantTests damlDir = testGroup "no assistant"
               ]
           let damlcPath = damlDir </> "sdk" </> sdkVersion </> "damlc" </> "damlc"
           callProcess damlcPath ["build", "--project-root", projDir, "--init-package-db", "no"]
+    , testCase "damlc build --init-package-db=yes" $ withTempDir $ \tmpDir -> do
+          let projDir = tmpDir </> "foobar"
+          createDirectory projDir
+          writeFileUTF8 (projDir </> "daml.yaml") $ unlines
+              [ "sdk-version: " <> sdkVersion
+              , "name: a"
+              , "version: \"1.0\""
+              , "source: Main.daml"
+              , "dependencies: [daml-prim, daml-stdlib]"
+              ]
+          writeFileUTF8 (projDir </> "Main.daml") $ unlines
+              [ "daml 1.2"
+              , "module Main where"
+              , "a : ()"
+              , "a = ()"
+              ]
+          let damlcPath = damlDir </> "sdk" </> sdkVersion </> "damlc" </> "damlc"
+          withCurrentDirectory tmpDir $
+              callProcess damlcPath ["build", "--project-root", "foobar", "--init-package-db", "yes"]
     ]
 
 packagingTests :: FilePath -> TestTree

unreleased.rst

@@ -10,3 +10,5 @@ HEAD — ongoing
 --------------
 
 + [Ledger] Fixed a bug that prevented the ledger from loading transactions with empty workflow ids.
++ [DAML Compiler] The ``--project-root`` option now works properly
+  with relative paths in ``daml build`.`