feat(users/Profpatsch/whatcd-resolver): render anon json+ld objs r/7716

Some json+ld objects cannot be expanded any further, they are missing
the `@id` tag. Now we also render them as objects.

Change-Id: I1c8f26f3c34e69420c349e66a3ce5a36dc55a1ea
Reviewed-on: https://cl.tvl.fyi/c/depot/+/11173
Reviewed-by: Profpatsch <mail@profpatsch.de>
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI

1 files changed, 66 insertions, 42 deletions

diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
index 7f2c4ec7e8..d21892b9e7 100644
--- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
+++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
@@ -453,6 +453,7 @@ getBestTorrentsTable = do
 -- | A recursive `json+ld` structure.
 data Jsonld
   = JsonldObject JsonldObject
+  | JsonldAnonymousObject JsonldAnonymousObject
   | JsonldArray [Jsonld]
   | JsonldField Json.Value
   deriving stock (Show, Eq)
@@ -468,64 +469,87 @@ data JsonldObject = JsonldObject'
   }
   deriving stock (Show, Eq)
 
+-- | A json+ld object that cannot be inspected further by resolving its ID
+data JsonldAnonymousObject = JsonldAnonymousObject'
+  { -- | `@type` field; currently just the plain value without taking into account the json+ld context
+    type_ :: Set Text,
+    -- | fields of this anonymous object
+    fields :: Map Text Jsonld
+  }
+  deriving stock (Show, Eq)
+
 jsonldParser :: (Monad m) => Json.ParseT err m Jsonld
 jsonldParser =
   Json.asValue >>= \cur -> do
     if
       | Json.Object _ <- cur -> do
-          typeMay <- Json.keyMay "@type" $ (Json.asArraySet Json.asText Json.<|> (Set.singleton <$> Json.asText))
+          type_ <-
+            Json.keyMay "@type" (Json.asArraySet Json.asText Json.<|> (Set.singleton <$> Json.asText))
+              <&> fromMaybe Set.empty
           idMay <- Json.keyMay "@id" $ Json.asText
+          fields <-
+            Json.asObjectMap jsonldParser
+              <&> Map.delete "@type"
+              <&> Map.delete "@id"
+
           if
-            | Just type_ <- typeMay,
-              Just id_ <- idMay -> do
-                previewFields <-
-                  Json.asObjectMap jsonldParser
-                    <&> Map.delete "@type"
-                    <&> Map.delete "@id"
-                pure $ JsonldObject $ JsonldObject' {..}
-            | otherwise -> pure $ JsonldField cur
+            | Just id_ <- idMay -> do
+                pure $ JsonldObject $ JsonldObject' {previewFields = fields, ..}
+            | otherwise -> pure $ JsonldAnonymousObject $ JsonldAnonymousObject' {..}
       | Json.Array _ <- cur -> do
           JsonldArray <$> Json.eachInArray jsonldParser
       | otherwise -> pure $ JsonldField cur
 
 renderJsonld :: Jsonld -> Html
 renderJsonld = \case
-  JsonldObject obj ->
-    [hsx|
-    <dl>
-      <dt>Type</dt>
-      <dd>{obj.type_ & toList & schemaTypes}</dd>
-      <dt>Url</dt>
-      <dd><a href={obj.id_}>{obj.id_}</a></dd>
-      <dt>Fields</dt>
-      <dd>
-        {obj.previewFields & Html.toDefinitionList schemaType renderJsonld}
-        <div>
-          <button
-            hx-get={snippetHref obj.id_}
-            hx-target="closest dl"
-            hx-swap="outerHTML"
-          >more fields …</button>
-        </div>
-      </dd>
-    </dl>
-  |]
-    where
-      snippetHref target =
-        Builder.toLazyByteString $
-          "/snips/jsonld/render"
-            <> Url.renderQueryBuilder True [("target", Just (textToBytesUtf8 target))]
-
-      schemaTypes xs =
-        xs
-          <&> schemaType
-          & List.intersperse ", "
-          & mconcat
-      schemaType t =
-        let href :: Text = [fmt|https://schema.org/{t}|] in [hsx|<a href={href} target="_blank">{t}</a>|]
+  JsonldObject obj -> renderObject obj (Just obj.id_) obj.previewFields
+  JsonldAnonymousObject obj -> renderObject obj Nothing obj.fields
   JsonldArray arr ->
     Html.toOrderedList renderJsonld arr
   JsonldField f -> Html.mkVal f
+  where
+    renderObject obj mId_ fields = do
+      let id_ =
+            mId_ <&> \i ->
+              [hsx|
+                  <dt>Url</dt>
+                  <dd><a href={i}>{i}</a></dd>
+                  |]
+          getMoreButton =
+            mId_ <&> \i ->
+              [hsx|
+              <div>
+                <button
+                  hx-get={snippetHref i}
+                  hx-target="closest dl"
+                  hx-swap="outerHTML"
+                >more fields …</button>
+              </div>
+            |]
+      [hsx|
+      <dl>
+        <dt>Type</dt>
+        <dd>{obj.type_ & toList & schemaTypes}</dd>
+        {id_}
+        <dt>Fields</dt>
+        <dd>
+          {fields & Html.toDefinitionList schemaType renderJsonld}
+          {getMoreButton}
+        </dd>
+      </dl>
+    |]
+    snippetHref target =
+      Builder.toLazyByteString $
+        "/snips/jsonld/render"
+          <> Url.renderQueryBuilder True [("target", Just (textToBytesUtf8 target))]
+
+    schemaTypes xs =
+      xs
+        <&> schemaType
+        & List.intersperse ", "
+        & mconcat
+    schemaType t =
+      let href :: Text = [fmt|https://schema.org/{t}|] in [hsx|<a href={href} target="_blank">{t}</a>|]
 
 -- | A value between (inclusive) 0% and (inclusive) 100%. Precise to 1% steps.
 newtype Percentage = Percentage {unPercentage :: Int}