lightstep-haskell 0.5.1 → 0.5.2

raw patch · 3 files changed

+27/−9 lines, 3 files

Files

• examples/readme/Main.hs +21/−2
• lightstep-haskell.cabal +1/−1
• src/LightStep/HighLevel/IO.hs +5/−6

@@ -2,10 +2,10 @@  import Control.Concurrent import Control.Concurrent.Async-import LightStep.HighLevel.IO (LogEntryKey (..), addLog, getEnvConfig, setTag, withSingletonLightStep, withSpan)+import LightStep.HighLevel.IO (LogEntryKey (..), addLog, currentSpanContext, getEnvConfig, setParentSpanContext, setTag, withSingletonLightStep, withSpan)  seriousBusinessMain :: IO ()-seriousBusinessMain = concurrently_ frontend backend+seriousBusinessMain = concurrently_ frontend backend >> threadDelay 1000000   where     frontend =       withSpan "RESTful API" $ do@@ -43,6 +43,25 @@         withSpan "Hadoop" $ do           threadDelay 100000           setTag "learning" "super_deep"+        withSpan "Parallel map reduce" $ do+          result <- withSpan "Reduce" $ do+            Just ctx <- currentSpanContext+            (a, b) <- do+              threadDelay 100000+              concurrently+                ( withSpan "Calculate a" $ do+                    setParentSpanContext ctx+                    threadDelay 100000+                    return "Lorem "+                )+                ( withSpan "Calculate b" $ do+                    setParentSpanContext ctx+                    threadDelay 100000+                    return "ipsum"+                )+            threadDelay 100000+            pure (a <> b)+          setTag "result" result  main :: IO () main = do

@@ -1,7 +1,7 @@ cabal-version: 2.4  name:           lightstep-haskell-version:        0.5.1+version:        0.5.2 synopsis:       LightStep OpenTracing client library description:    LightStep OpenTracing client library. Uses GRPC transport via proto-lens. category:       Tools

@@ -89,10 +89,9 @@   tId <- myThreadId   modifyMVar_     globalSharedMutableSpanStacks-    ( \stacks ->-        let (sp : sps) = stacks HM.! tId-            !stacks' = HM.insert tId (f sp : sps) stacks-         in pure stacks'+    ( \stacks -> case HM.lookup tId stacks of+        Just (sp : sps) -> pure $! HM.insert tId (f sp : sps) stacks+        _ -> pure stacks     )  currentSpanContext :: MonadIO m => m (Maybe SpanContext)@@ -100,8 +99,8 @@   tId <- myThreadId   stacks <- readMVar globalSharedMutableSpanStacks   let ctx =-        case stacks HM.! tId of-          (sp : _) -> Just $ sp ^. spanContext+        case HM.lookup tId stacks of+          Just (sp : _) -> Just $ sp ^. spanContext           _ -> Nothing   pure ctx