Improve logging for dependency installation (#11540)

Also drops the weird Base module and the always empty tags (yet
another reason why I want to burn our own logging lib with fire).

changelog_begin
changelog_end

compiler/damlc/daml-opts/daml-opts-types/DA/Daml/Options/Types.hs

@@ -28,6 +28,7 @@ module DA.Daml.Options.Types
     , pkgNameVersion
     , fullPkgName
     , optUnitId
+    , getLogger
     ) where
 
 import Control.Monad.Reader
@@ -35,6 +36,7 @@ import DA.Bazel.Runfiles
 import qualified DA.Daml.LF.Ast as LF
 import DA.Pretty
 import qualified DA.Service.Logger as Logger
+import qualified DA.Service.Logger.Impl.IO as Logger.IO
 import Data.Maybe
 import qualified Data.Text as T
 import Development.IDE.GHC.Util (prettyPrint)
@@ -221,3 +223,6 @@ fullPkgName (LF.PackageName n) mbV (LF.PackageId h) =
 
 optUnitId :: Options -> Maybe UnitId
 optUnitId Options{..} = fmap (\name -> pkgNameVersion name optMbPackageVersion) optMbPackageName
+
+getLogger :: Options -> T.Text -> IO (Logger.Handle IO)
+getLogger Options {optLogLevel} name = Logger.IO.newStderrLogger optLogLevel name

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

@@ -16,7 +16,7 @@ import Control.Monad.Except
 import Control.Monad.Extra (whenM, whenJust)
 import DA.Bazel.Runfiles
 import qualified DA.Cli.Args as ParseArgs
-import DA.Cli.Damlc.Base
+import DA.Cli.Options
 import DA.Cli.Damlc.BuildInfo
 import qualified DA.Cli.Damlc.InspectDar as InspectDar
 import qualified DA.Cli.Damlc.Command.Damldoc as Damldoc
@@ -24,6 +24,7 @@ import DA.Cli.Damlc.Packaging
 import DA.Cli.Damlc.DependencyDb
 import DA.Cli.Damlc.Test
 import DA.Daml.Compiler.Dar
+import DA.Daml.Compiler.Output
 import qualified DA.Daml.Compiler.Repl as Repl
 import DA.Daml.Compiler.DocTest
 import DA.Daml.LF.ScenarioServiceClient (readScenarioServiceConfig, withScenarioService')

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

@@ -1,18 +0,0 @@
--- Copyright (c) 2021 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
--- SPDX-License-Identifier: Apache-2.0
-
-module DA.Cli.Damlc.Base
-    ( module DA.Cli.Options
-    , module DA.Daml.Compiler.Output
-    , getLogger
-    )
-where
-import           DA.Cli.Options
-import           DA.Daml.Compiler.Output
-import DA.Daml.Options.Types
-import qualified Data.Text as T
-import qualified DA.Service.Logger                 as Logger
-import qualified DA.Service.Logger.Impl.IO         as Logger.IO
-
-getLogger :: Options -> T.Text -> IO (Logger.Handle IO)
-getLogger Options {optLogLevel} name = Logger.IO.newStderrLogger optLogLevel name

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

@@ -23,6 +23,7 @@ import qualified DA.Daml.LF.Ast.Optics as LF
 import qualified DA.Daml.LF.Proto3.Archive as Archive
 import DA.Daml.Options.Types
 import DA.Daml.Package.Config
+import qualified DA.Service.Logger as Logger
 import qualified DA.Pretty
 import qualified Data.Aeson as Aeson
 import Data.Aeson (eitherDecodeFileStrict', encode)
@@ -122,6 +123,7 @@ installDependencies ::
    -> [FilePath] -- Data Dependencies. Can be filepath to dars/dalfs.
    -> IO ()
 installDependencies projRoot opts sdkVer@(PackageSdkVersion thisSdkVer) pDeps pDataDeps = do
+    logger <- getLogger opts "install-dependencies"
     deps <- expandSdkPackages (optDamlLfVersion opts) (filter (`notElem` basePackages) pDeps)
     DataDeps {dataDepsDars, dataDepsDalfs, dataDepsPkgIds, dataDepsNameVersion} <- readDataDeps pDataDeps
     (needsUpdate, newFingerprint) <-
@@ -133,20 +135,29 @@ installDependencies projRoot opts sdkVer@(PackageSdkVersion thisSdkVer) pDeps pD
             thisSdkVer
             (show $ optDamlLfVersion opts)
     when needsUpdate $ do
+        Logger.logDebug logger "Dependencies are not up2date, reinstalling"
         removePathForcibly depsDir
         createDirectoryIfMissing True depsDir
         -- install dependencies
         -----------------------
+        Logger.logDebug logger "Extracting dependencies"
         depsExtracted <- mapM extractDar deps
         checkSdkVersions sdkVer depsExtracted
+        Logger.logDebug logger "Installing dependencies"
         forM_ depsExtracted $ installDar depsDir False
         -- install data-dependencies
         ----------------------------
+        Logger.logDebug logger "Extracting & installing data-dependency DARs"
         forM_ dataDepsDars $ extractDar >=> installDar depsDir True
+        Logger.logDebug logger "Extracting & installing data-dependency DALFs"
         forM_ dataDepsDalfs $ \fp -> BS.readFile fp >>= installDataDepDalf False depsDir fp
+        Logger.logDebug logger "Resolving package ids"
         resolvedPkgIds <- resolvePkgs projRoot opts dataDepsNameVersion
+        Logger.logDebug logger "Querying package ids"
         exclPkgIds <- queryPkgIds Nothing depsDir
+        Logger.logDebug logger "Fetching DALFs from ledger"
         rdalfs <- getDalfsFromLedger (optAccessTokenPath opts) (dataDepsPkgIds ++ M.elems resolvedPkgIds) exclPkgIds
+        Logger.logDebug logger "Installing dalfs from ledger"
         forM_ rdalfs $ \RemoteDalf {..} -> do
             installDataDepDalf
                 remoteDalfIsMain
@@ -154,10 +165,12 @@ installDependencies projRoot opts sdkVer@(PackageSdkVersion thisSdkVer) pDeps pD
                 (packageNameToFp $ packageNameOrId remoteDalfPkgId remoteDalfName)
                 remoteDalfBs
         -- Mark received packages as well as their transitive dependencies as data dependencies.
+        Logger.logDebug logger "Mark data-dependencies"
         markAsDataRec
             (Set.fromList [remoteDalfPkgId | RemoteDalf {remoteDalfPkgId} <- rdalfs])
             Set.empty
         -- write new fingerprint
+        Logger.logDebug logger "Updating fingerprint"
         write (depsDir </> fingerprintFile) $ encode newFingerprint
   where
     markAsDataRec :: Set.Set LF.PackageId -> Set.Set LF.PackageId -> IO ()

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

@@ -40,10 +40,10 @@ import System.Process (callProcess)
 import "ghc-lib-parser" UniqSet
 
 import DA.Bazel.Runfiles
-import DA.Cli.Damlc.Base
 import DA.Daml.Compiler.Dar
 import DA.Daml.Compiler.DataDependencies as DataDeps
 import DA.Daml.Compiler.DecodeDar (DecodedDalf(..), decodeDalf)
+import DA.Daml.Compiler.Output
 import qualified DA.Daml.LF.Ast as LF
 import DA.Daml.LF.Ast.Optics (packageRefs)
 import DA.Daml.Options.Packaging.Metadata
@@ -73,7 +73,9 @@ createProjectPackageDb :: NormalizedFilePath -> Options -> MS.Map UnitId GHC.Mod
 createProjectPackageDb projectRoot (disableScenarioService -> opts) modulePrefixes
   = do
     (needsReinitalization, depsFingerprint) <- dbNeedsReinitialization projectRoot depsDir
+    loggerH <- getLogger opts "package-db"
     when needsReinitalization $ do
+      Logger.logDebug loggerH "package db is not up2date, reinitializing"
       clearPackageDb
 
 
@@ -86,7 +88,6 @@ createProjectPackageDb projectRoot (disableScenarioService -> opts) modulePrefix
       -- TODO Enforce this with useful error messages
       registerDepsInPkgDb depsDir dbPath
 
-      loggerH <- getLogger opts "dependencies"
       mbRes <- withDamlIdeState opts loggerH diagnosticsLogger $ \ide -> runActionSync ide $ runMaybeT $
           (,) <$> useNoFileE GenerateStablePackages
               <*> (fst <$> useE GeneratePackageMap projectRoot)

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

@@ -12,10 +12,10 @@ module DA.Cli.Damlc.Test (
 
 import Control.Monad.Except
 import Control.Monad.Extra
-import DA.Cli.Damlc.Base
 import qualified DA.Daml.LF.Ast as LF
 import qualified DA.Daml.LF.PrettyScenario as SS
 import qualified DA.Daml.LF.ScenarioServiceClient as SSC
+import DA.Daml.Compiler.Output
 import DA.Daml.Options.Types
 import qualified DA.Pretty
 import qualified DA.Pretty as Pretty

libs-haskell/da-hs-base/src/DA/Service/Logger/Impl/IO.hs

@@ -78,14 +78,13 @@ ioLogJson ih threshold prio msg =
     when (prio >= threshold) $
     withMVar (ihOutputLock ih) $
     \_ -> do
-        let tags = []
         now <- getCurrentTime
         let outH = ihOutputH ih
         System.IO.hPutStrLn outH
            $ "\n"
           <> take 22 (show now)
           <> prioToString prio
-          <> showTags (ihContext ih) <> showTags tags
+          <> showTags (ihContext ih)
         BSL8.hPutStrLn outH $ truncateBSL8 $ case Aeson.toJSON msg of
           -- Print strings without quoting
           Aeson.String txt -> BSL8.fromStrict $ TE.encodeUtf8 txt