From 981c7fef0ec26274fdd93af08064499460fbec77 Mon Sep 17 00:00:00 2001
From: Profpatsch <mail@profpatsch.de>
Date: Sat, 16 Mar 2024 17:17:38 +0100
Subject: feat(users/Profpatsch/whatcd-resolver): log json+ld fetching
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This traces the target of a json+ld fetch.

We also simplify the telemetry stuff by using a pseudo-class
`MonadOtel` everywhere.

I wonder if we can get rid of passing the span to `assertM`, because
it’s kind of an antipattern to be honest.

Change-Id: I1448d643c909a29684fa1ae54037177ba2c20639
Reviewed-on: https://cl.tvl.fyi/c/depot/+/11166
Tested-by: BuildkiteCI
Autosubmit: Profpatsch <mail@profpatsch.de>
Reviewed-by: Profpatsch <mail@profpatsch.de>
---
 users/Profpatsch/my-prelude/src/Parse.hs                  | 6 ++++++
 users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs | 4 ++--
 2 files changed, 8 insertions(+), 2 deletions(-)

(limited to 'users/Profpatsch/my-prelude')

diff --git a/users/Profpatsch/my-prelude/src/Parse.hs b/users/Profpatsch/my-prelude/src/Parse.hs
index 116b155f68a4..65a0b0d39ed8 100644
--- a/users/Profpatsch/my-prelude/src/Parse.hs
+++ b/users/Profpatsch/my-prelude/src/Parse.hs
@@ -97,6 +97,12 @@ multipleNE inner = Parse $ \(ctx, from) ->
     -- we assume that, since the same parser is used everywhere, the context will be the same as well (TODO: correct?)
     & second (\((ctx', y) :| ys) -> (ctx', y :| (snd <$> ys)))
 
+-- | Like '(>>>)', but returns the intermediate result alongside the final parse result.
+andParse :: Parse to to2 -> Parse from to -> Parse from (to, to2)
+andParse outer inner = Parse $ \from -> case runParse' inner from of
+  Failure err -> Failure err
+  Success (ctx, to) -> runParse' outer (ctx, to) <&> (second (to,))
+
 -- | Lift a parser into an optional value
 maybe :: Parse from to -> Parse (Maybe from) (Maybe to)
 maybe inner = Parse $ \(ctx, m) -> case m of
diff --git a/users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs b/users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs
index ca78da47067f..78e3897ef5f3 100644
--- a/users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs
+++ b/users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs
@@ -543,11 +543,11 @@ traceQueryIfEnabled tools span logDatabaseQueries qry params = do
         Otel.addAttributes
           span
           $ HashMap.fromList
-          $ ( ("postgres.query", Otel.toAttribute @Text errs.query)
+          $ ( ("_.postgres.query", Otel.toAttribute @Text errs.query)
                 : ( errs.explain
                       & foldMap
                         ( \ex ->
-                            [("postgres.explain", Otel.toAttribute @Text ex)]
+                            [("_.postgres.explain", Otel.toAttribute @Text ex)]
                         )
                   )
             )
-- 
cgit 1.4.1