Update to opentelemetry-0.4.0

Author: ethercrow

src/Stack/Build.hs

@@ -57,7 +57,7 @@ import           OpenTelemetry.Eventlog
 build :: HasEnvConfig env
       => Maybe (Set (Path Abs File) -> IO ()) -- ^ callback after discovering all local files
       -> RIO env ()
-build msetLocalFiles = withSpan "Build.build" $ do
+build msetLocalFiles = withSpan_ "Build.build" $ do
   mcp <- view $ configL.to configModifyCodePage
   ghcVersion <- view $ actualCompilerVersionL.to getGhcVersion
   fixCodePage mcp ghcVersion $ do
@@ -70,7 +70,7 @@ build msetLocalFiles = withSpan "Build.build" $ do
     checkSubLibraryDependencies (Map.elems $ smProject sourceMap)
 
     boptsCli <- view $ envConfigL.to envConfigBuildOptsCLI
-    withSpan "Build.build_setLocalFiles" $ do
+    withSpan_ "Build.build_setLocalFiles" $ do
       -- Set local files, necessary for file watching
       stackYaml <- view stackYamlL
       for_ msetLocalFiles $ \setLocalFiles -> do
@@ -88,10 +88,10 @@ build msetLocalFiles = withSpan "Build.build" $ do
                 lpFilesForComponents components lp
         liftIO $ setLocalFiles $ Set.insert stackYaml $ Set.unions files
 
-    withSpan "Build.build_checkComponentsBuildable" $ do
+    withSpan_ "Build.build_checkComponentsBuildable" $ do
       checkComponentsBuildable allLocals
 
-    installMap <- withSpan "Build.Installed.toInstallMap" $ toInstallMap sourceMap
+    installMap <- withSpan_ "Build.Installed.toInstallMap" $ toInstallMap sourceMap
     (installedMap, globalDumpPkgs, snapshotDumpPkgs, localDumpPkgs) <-
         getInstalled installMap
 
@@ -238,7 +238,7 @@ splitObjsWarning = unwords
 -- | Get the @BaseConfigOpts@ necessary for constructing configure options
 mkBaseConfigOpts :: (HasEnvConfig env)
                  => BuildOptsCLI -> RIO env BaseConfigOpts
-mkBaseConfigOpts boptsCli = withSpan "Build.mkBaseConfigOpts" $ do
+mkBaseConfigOpts boptsCli = withSpan_ "Build.mkBaseConfigOpts" $ do
     bopts <- view buildOptsL
     snapDBPath <- packageDatabaseDeps
     localDBPath <- packageDatabaseLocal
@@ -263,7 +263,7 @@ loadPackage
   -> [Text] -- ^ GHC options
   -> [Text] -- ^ Cabal configure options
   -> RIO env Package
-loadPackage loc flags ghcOptions cabalConfigOpts = withSpan "Build.loadPackage" $ do
+loadPackage loc flags ghcOptions cabalConfigOpts = withSpan_ "Build.loadPackage" $ do
   compiler <- view actualCompilerVersionL
   platform <- view platformL
   let pkgConfig = PackageConfig

src/Stack/Build/ConstructPlan.hs

@@ -175,7 +175,7 @@ constructPlan :: forall env. HasEnvConfig env
               -> InstalledMap
               -> Bool
               -> RIO env Plan
-constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap initialBuildSteps = withSpan "Build.ConstructPlan.constructPlan" $ do
+constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap initialBuildSteps = withSpan_ "Build.ConstructPlan.constructPlan" $ do
     logDebug "Constructing the build plan"
 
     when hasBaseInDeps $

src/Stack/Build/Execute.hs

@@ -249,7 +249,7 @@ getSetupExe :: HasEnvConfig env
             -> Path Abs File -- ^ SetupShim.hs input file
             -> Path Abs Dir -- ^ temporary directory
             -> RIO env (Maybe (Path Abs File))
-getSetupExe setupHs setupShimHs tmpdir = withSpan "Build.Execute.getSetupExe" $ do
+getSetupExe setupHs setupShimHs tmpdir = withSpan_ "Build.Execute.getSetupExe" $ do
     wc <- view $ actualCompilerVersionL.whichCompilerL
     platformDir <- platformGhcRelDir
     config <- view configL
@@ -482,7 +482,7 @@ executePlan :: HasEnvConfig env
             -> Map PackageName Target
             -> Plan
             -> RIO env ()
-executePlan boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages installedMap targets plan = withSpan "Build.Execute.executePlan" $ do
+executePlan boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages installedMap targets plan = withSpan_ "Build.Execute.executePlan" $ do
     logDebug "Executing the build plan"
     bopts <- view buildOptsL
     withExecuteEnv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages mlargestPackageName
@@ -512,7 +512,7 @@ copyExecutables
     => Map Text InstallLocation
     -> RIO env ()
 copyExecutables exes | Map.null exes = return ()
-copyExecutables exes = withSpan "Build.Execute.copyExecutables" $ do
+copyExecutables exes = withSpan_ "Build.Execute.copyExecutables" $ do
     snapBin <- (</> bindirSuffix) `liftM` installationRootDeps
     localBin <- (</> bindirSuffix) `liftM` installationRootLocal
     compilerSpecific <- boptsInstallCompilerTool <$> view buildOptsL
@@ -671,7 +671,7 @@ unregisterPackages ::
     -> Path Abs Dir
     -> NonEmpty (GhcPkgId, (PackageIdentifier, Text))
     -> RIO env ()
-unregisterPackages cv localDB ids = withSpan "Build.Execute.unregisterPackages" $ do
+unregisterPackages cv localDB ids = withSpan_ "Build.Execute.unregisterPackages" $ do
     let logReason ident reason =
             logInfo $
             fromString (packageIdentifierString ident) <> ": unregistering" <>
@@ -846,7 +846,7 @@ ensureConfig :: HasEnvConfig env
              -> Path Abs File -- ^ .cabal file
              -> Task
              -> RIO env Bool
-ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp task = withSpan "Build.Execute.ensureConfig" $ do
+ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp task = withSpan_ "Build.Execute.ensureConfig" $ do
     newCabalMod <- liftIO $ modificationTime <$> getFileStatus (toFilePath cabalfp)
     setupConfigfp <- setupConfigFromDir pkgDir
     newSetupConfigMod <- liftIO $ either (const Nothing) (Just . modificationTime) <$>
@@ -1131,7 +1131,7 @@ withSingleContext ActionContext {..} ee@ExecuteEnv {..} task@Task {..} mdeps msu
         -> OutputType
         -> ((KeepOutputOpen -> ExcludeTHLoading -> [String] -> RIO env ()) -> RIO env a)
         -> RIO env a
-    withCabal package pkgDir outputType inner = withSpan "Build.Execute.withCabal" $ do
+    withCabal package pkgDir outputType inner = withSpan_ "Build.Execute.withCabal" $ do
         config <- view configL
         unless (configAllowDifferentUser config) $
             checkOwnership (pkgDir </> configWorkDir config)
@@ -1480,7 +1480,7 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap
                         return $ if b then Just pc else Nothing
             _ -> return Nothing
 
-    copyPreCompiled (PrecompiledCache mlib sublibs exes) = withSpan "Build.Execute.copyPreCompiled" $ do
+    copyPreCompiled (PrecompiledCache mlib sublibs exes) = withSpan_ "Build.Execute.copyPreCompiled" $ do
         wc <- view $ actualCompilerVersionL.whichCompilerL
         announceTask ee task "using precompiled package"
 
@@ -1588,7 +1588,7 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap
         -> (Utf8Builder -> RIO env ())
         -> Map Text ExecutableBuildStatus
         -> RIO env Installed
-    realBuild cache package pkgDir cabal0 announce executableBuildStatuses = withSpan "Build.Execute.realBuild" $ do
+    realBuild cache package pkgDir cabal0 announce executableBuildStatuses = withSpan_ "Build.Execute.realBuild" $ do
         let cabal = cabal0 CloseOnException
         wc <- view $ actualCompilerVersionL.whichCompilerL
 

src/Stack/Build/Installed.hs

@@ -55,7 +55,7 @@ getInstalled :: HasEnvConfig env
                   , [DumpPackage] -- snapshot installed
                   , [DumpPackage] -- locally installed
                   )
-getInstalled {-opts-} installMap = withSpan "Build.Installed.getInstalled" $ do
+getInstalled {-opts-} installMap = withSpan_ "Build.Installed.getInstalled" $ do
     logDebug "Finding out which packages are already installed"
     snapDBPath <- packageDatabaseDeps
     localDBPath <- packageDatabaseLocal
@@ -116,7 +116,7 @@ loadDatabase :: HasEnvConfig env
              -> Maybe (InstalledPackageLocation, Path Abs Dir) -- ^ package database, Nothing for global
              -> [LoadHelper] -- ^ from parent databases
              -> RIO env ([LoadHelper], [DumpPackage])
-loadDatabase installMap mdb lhs0 = withSpan "Build.Installed.loadDatabase" $ do
+loadDatabase installMap mdb lhs0 = withSpan_ "Build.Installed.loadDatabase" $ do
     pkgexe <- getGhcPkgExe
     (lhs1', dps) <- ghcPkgDump pkgexe (fmap snd (maybeToList mdb))
                 $ conduitDumpPackage .| sink

src/Stack/Build/Source.hs

@@ -48,13 +48,13 @@ import OpenTelemetry.Eventlog
 -- | loads and returns project packages
 projectLocalPackages :: HasEnvConfig env
               => RIO env [LocalPackage]
-projectLocalPackages = withSpan "Build.Source.projectLocalPackages" $ do
+projectLocalPackages = withSpan_ "Build.Source.projectLocalPackages" $ do
     sm <- view $ envConfigL.to envConfigSourceMap
     for (toList $ smProject sm) loadLocalPackage
 
 -- | loads all local dependencies - project packages and local extra-deps
 localDependencies :: HasEnvConfig env => RIO env [LocalPackage]
-localDependencies = withSpan "Build.Source.localDependencies" $ do
+localDependencies = withSpan_ "Build.Source.localDependencies" $ do
     bopts <- view $ configL.to configBuild
     sourceMap <- view $ envConfigL . to envConfigSourceMap
     forMaybeM (Map.elems $ smDeps sourceMap) $ \dp ->
@@ -71,7 +71,7 @@ loadSourceMap :: HasBuildConfig env
               -> BuildOptsCLI
               -> SMActual DumpedGlobalPackage
               -> RIO env SourceMap
-loadSourceMap smt boptsCli sma = withSpan "Build.Source.loadSourceMap" $ do
+loadSourceMap smt boptsCli sma = withSpan_ "Build.Source.loadSourceMap" $ do
     bconfig <- view buildConfigL
     let compiler = smaCompiler sma
         project = M.map applyOptsFlagsPP $ smaProject sma
@@ -252,7 +252,7 @@ loadCommonPackage ::
        forall env. (HasBuildConfig env, HasSourceMap env)
     => CommonPackage
     -> RIO env Package
-loadCommonPackage common = withSpan "Build.Source.loadCommonPackage" $ do
+loadCommonPackage common = withSpan_ "Build.Source.loadCommonPackage" $ do
     config <- getPackageConfig (cpFlags common) (cpGhcOptions common) (cpCabalConfigOpts common)
     gpkg <- liftIO $ cpGPD common
     return $ resolvePackage config gpkg
@@ -263,7 +263,7 @@ loadLocalPackage ::
        forall env. (HasBuildConfig env, HasSourceMap env)
     => ProjectPackage
     -> RIO env LocalPackage
-loadLocalPackage pp = withSpan "Build.Source.loadLocalPackage" $ do
+loadLocalPackage pp = withSpan_ "Build.Source.loadLocalPackage" $ do
     sm <- view sourceMapL
     let common = ppCommon pp
     bopts <- view buildOptsL

src/Stack/Config.hs

@@ -147,7 +147,7 @@ makeConcreteResolver
     => AbstractResolver
     -> RIO env RawSnapshotLocation
 makeConcreteResolver (ARResolver r) = pure r
-makeConcreteResolver ar = withSpan "Config.makeConcreteResolver" $ do
+makeConcreteResolver ar = withSpan_ "Config.makeConcreteResolver" $ do
     r <-
         case ar of
             ARResolver r -> assert False $ makeConcreteResolver (ARResolver r)
@@ -436,7 +436,7 @@ getDefaultLocalProgramsBase configStackRoot configPlatform override =
 -- | Load the configuration, using current directory, environment variables,
 -- and defaults as necessary.
 loadConfig :: HasRunner env => (Config -> RIO env a) -> RIO env a
-loadConfig inner = withSpan "Config.loadConfig" $ do
+loadConfig inner = withSpan_ "Config.loadConfig" $ do
     mstackYaml <- view $ globalOptsL.to globalStackYaml
     mproject <- loadProjectConfig mstackYaml
     mresolver <- view $ globalOptsL.to globalResolver
@@ -482,7 +482,7 @@ loadConfig inner = withSpan "Config.loadConfig" $ do
 withBuildConfig
   :: RIO BuildConfig a
   -> RIO Config a
-withBuildConfig inner = withSpan "Config.withBuildConfig" $ do
+withBuildConfig inner = withSpan_ "Config.withBuildConfig" $ do
     config <- ask
 
     -- If provided, turn the AbstractResolver from the command line
@@ -798,7 +798,7 @@ getExtraConfigs userConfigPath = do
 loadConfigYaml
     :: HasLogFunc env
     => (Value -> Yaml.Parser (WithJSONWarnings a)) -> Path Abs File -> RIO env a
-loadConfigYaml parser path = withSpan "Config.loadConfigYaml" $ do
+loadConfigYaml parser path = withSpan_ "Config.loadConfigYaml" $ do
     eres <- loadYaml parser path
     case eres of
         Left err -> liftIO $ throwM (ParseConfigFileException path err)
@@ -853,7 +853,7 @@ loadProjectConfig :: HasLogFunc env
                   => StackYamlLoc
                   -- ^ Override stack.yaml
                   -> RIO env (ProjectConfig (Project, Path Abs File, ConfigMonoid))
-loadProjectConfig mstackYaml = withSpan "Config.loadProjectConfig" $ do
+loadProjectConfig mstackYaml = withSpan_ "Config.loadProjectConfig" $ do
     mfp <- getProjectConfig mstackYaml
     case mfp of
         PCProject fp -> do

src/Stack/Lock.hs

@@ -79,7 +79,7 @@ instance FromJSON (WithJSONWarnings (Unresolved Locked)) where
 loadYamlThrow
     :: HasLogFunc env
     => (Value -> Yaml.Parser (WithJSONWarnings a)) -> Path Abs File -> RIO env a
-loadYamlThrow parser path = withSpan "Lock.loadYamlThrow" $ do
+loadYamlThrow parser path = withSpan_ "Lock.loadYamlThrow" $ do
     val <- liftIO $ Yaml.decodeFileThrow (toFilePath path)
     case Yaml.parseEither parser val of
         Left err -> throwIO $ Yaml.AesonException err
@@ -96,7 +96,7 @@ lockCachedWanted ::
         -> Map PackageName (Bool -> RIO env DepPackage)
         -> RIO env ( SMWanted, [CompletedPLI]))
     -> RIO env SMWanted
-lockCachedWanted stackFile resolver fillWanted = withSpan "Lock.lockCacheWanted" $ do
+lockCachedWanted stackFile resolver fillWanted = withSpan_ "Lock.lockCacheWanted" $ do
     lockFile <- liftIO $ addExtension ".lock" stackFile
     let getLockExists = doesFileExist lockFile
     lfb <- view lockFileBehaviorL
@@ -120,7 +120,7 @@ lockCachedWanted stackFile resolver fillWanted = withSpan "Lock.lockCacheWanted"
         slocCache = toMap $ lckSnapshotLocations locked
         pkgLocCache = toMap $ lckPkgImmutableLocations locked
     (snap, slocCompleted, pliCompleted) <-
-        withSpan "Pantry.loadAndCompleteSnapshotRaw" $ loadAndCompleteSnapshotRaw resolver slocCache pkgLocCache
+        withSpan_ "Pantry.loadAndCompleteSnapshotRaw" $ loadAndCompleteSnapshotRaw resolver slocCache pkgLocCache
     let compiler = snapshotCompiler snap
         snPkgs = Map.mapWithKey (\n p h -> snapToDepPackage h n p) (snapshotPackages snap)
     (wanted, prjCompleted) <- fillWanted pkgLocCache compiler snPkgs

src/Stack/PackageDump.hs

@@ -61,9 +61,9 @@ ghcPkgCmdArgs
     -> [Path Abs Dir] -- ^ if empty, use global
     -> ConduitM Text Void (RIO env) a
     -> RIO env a
-ghcPkgCmdArgs pkgexe@(GhcPkgExe pkgPath) cmd mpkgDbs sink = withSpan "PackageDump.ghcPkgCmdArgs" $ do
-    setTag "args" $ fromString (unwords cmd)
-    setTag "dbs" $ fromString (show mpkgDbs)
+ghcPkgCmdArgs pkgexe@(GhcPkgExe pkgPath) cmd mpkgDbs sink = withSpan "PackageDump.ghcPkgCmdArgs" $ \sp -> do
+    setTag sp "args" $ fromString (unwords cmd)
+    setTag sp "dbs" $ fromString (show mpkgDbs)
     case reverse mpkgDbs of
         (pkgDb:_) -> createDatabase pkgexe pkgDb -- TODO maybe use some retry logic instead?
         _ -> return ()

src/Stack/Prelude.hs

@@ -68,9 +68,9 @@ sinkProcessStderrStdout
   -> ConduitM ByteString Void (RIO env) e -- ^ Sink for stderr
   -> ConduitM ByteString Void (RIO env) o -- ^ Sink for stdout
   -> RIO env (e,o)
-sinkProcessStderrStdout name args sinkStderr sinkStdout = withSpan "sinkProcessStderrStdout" $ do
-  setTag "process" (fromString name)
-  setTag "args" $ fromString (show args)
+sinkProcessStderrStdout name args sinkStderr sinkStdout = withSpan "sinkProcessStderrStdout" $ \sp -> do
+  setTag sp "process" (fromString name)
+  setTag sp "args" $ fromString (show args)
   proc name args $ \pc0 -> do
     let pc = setStdout createSource
            $ setStderr createSource
@@ -94,9 +94,9 @@ sinkProcessStdout
     -> [String] -- ^ Command line arguments
     -> ConduitM ByteString Void (RIO env) a -- ^ Sink for stdout
     -> RIO env a
-sinkProcessStdout name args sinkStdout = withSpan "sinkProcessStdout" $ do
-  setTag "process" (fromString name)
-  setTag "args" $ fromString (show args)
+sinkProcessStdout name args sinkStdout = withSpan "sinkProcessStdout" $ \sp -> do
+  setTag sp "process" (fromString name)
+  setTag sp "args" $ fromString (show args)
   proc name args $ \pc ->
     withLoggedProcess_ (setStdin closed pc) $ \p -> runConcurrently
       $ Concurrently (runConduit $ getStderr p .| CL.sinkNull)
@@ -106,7 +106,7 @@ logProcessStderrStdout
     :: (HasCallStack, HasProcessContext env, HasLogFunc env)
     => ProcessConfig stdin stdoutIgnored stderrIgnored
     -> RIO env ()
-logProcessStderrStdout pc = withSpan "logProcessStderrStdout" $ withLoggedProcess_ pc $ \p ->
+logProcessStderrStdout pc = withSpan_ "logProcessStderrStdout" $ withLoggedProcess_ pc $ \p ->
     let logLines = CB.lines .| CL.mapM_ (logInfo . displayBytesUtf8)
      in runConcurrently
             $ Concurrently (runConduit $ getStdout p .| logLines)
@@ -119,7 +119,7 @@ readProcessNull :: (HasProcessContext env, HasLogFunc env, HasCallStack)
                 => String -- ^ Command
                 -> [String] -- ^ Command line arguments
                 -> RIO env ()
-readProcessNull name args = withSpan "readProcessNull" $
+readProcessNull name args = withSpan_ "readProcessNull" $
   -- We want the output to appear in any exceptions, so we capture and drop it
   void $ proc name args readProcess_
 
@@ -219,5 +219,5 @@ defaultFirstFalse _ = False
 -- | Write a @Builder@ to a file and atomically rename.
 writeBinaryFileAtomic :: MonadIO m => Path absrel File -> Builder -> m ()
 writeBinaryFileAtomic fp builder =
-    liftIO $ withSpan "writeBinaryFileAtomic" $
+    liftIO $ withSpan_ "writeBinaryFileAtomic" $
     withBinaryFileAtomic (toFilePath fp) WriteMode (`hPutBuilder` builder)

src/Stack/Runners.hs

@@ -85,7 +85,7 @@ withConfig
   -> RIO Config a
   -> RIO Runner a
 withConfig shouldReexec inner =
-    withSpan "Runners.withConfig" $ loadConfig $ \config -> do
+    withSpan_ "Runners.withConfig" $ loadConfig $ \config -> do
       -- If we have been relaunched in a Docker container, perform in-container initialization
       -- (switch UID, etc.).  We do this after first loading the configuration since it must
       -- happen ASAP but needs a configuration.

src/Stack/Setup.hs

@@ -191,7 +191,7 @@ setupEnv :: NeedTargets
          -> BuildOptsCLI
          -> Maybe Text -- ^ Message to give user when necessary GHC is not available
          -> RIO BuildConfig EnvConfig
-setupEnv needTargets boptsCLI mResolveMissingGHC = withSpan "setupEnv" $ do
+setupEnv needTargets boptsCLI mResolveMissingGHC = withSpan_ "setupEnv" $ do
     config <- view configL
     bc <- view buildConfigL
     let stackYaml = bcStackYaml bc

src/Stack/Storage/Project.hs

@@ -87,7 +87,7 @@ initProjectStorage ::
     => Path Abs File -- ^ storage file
     -> (ProjectStorage -> RIO env a)
     -> RIO env a
-initProjectStorage fp f = withSpan "Storage.Project.initProjectStorage" $ SQLite.initStorage "Stack" migrateAll fp $ f . ProjectStorage
+initProjectStorage fp f = withSpan_ "Storage.Project.initProjectStorage" $ SQLite.initStorage "Stack" migrateAll fp $ f . ProjectStorage
 
 -- | Run an action in a database transaction
 withProjectStorage ::
@@ -138,7 +138,7 @@ loadConfigCache ::
     => ConfigCacheKey
     -> RIO env (Maybe ConfigCache)
 loadConfigCache key =
-    withSpan "Storage.Project.loadConfigCache" $ withProjectStorage $ do
+    withSpan_ "Storage.Project.loadConfigCache" $ withProjectStorage $ do
         mparent <- getBy key
         case mparent of
             Nothing -> return Nothing