From b9bb7717d4cd98c7a346b63f075ac2f495685687 Mon Sep 17 00:00:00 2001
From: Paul-Elliot <peada@free.fr>
Date: Thu, 28 Sep 2023 17:07:00 +0200
Subject: [PATCH] Media: fix warning when a non-asset ref is a media target

Signed-off-by: Paul-Elliot <peada@free.fr>
---
 src/model/semantics.ml        | 50 ++++++++++++++++++++---------------
 test/pages/medias.t/index.mld |  6 ++++-
 test/pages/medias.t/run.t     |  8 ++++--
 3 files changed, 40 insertions(+), 24 deletions(-)

diff --git a/src/model/semantics.ml b/src/model/semantics.ml
index b9caae91ad..da318433f7 100644
--- a/src/model/semantics.ml
+++ b/src/model/semantics.ml
@@ -285,30 +285,38 @@ let rec nestable_block_element :
        (kind, { value = `Reference href; location = href_location }, content, m);
    location;
   } -> (
+      let fallback error =
+        Error.raise_warning error;
+        let placeholder =
+          match kind with
+          | `Simple -> `Code_span href
+          | `With_text -> `Styled (`Emphasis, content)
+        in
+        `Paragraph
+          (inline_elements status [ placeholder |> Location.at location ])
+        |> Location.at location
+      in
       match Error.raise_warnings (Reference.parse href_location href) with
-      | Result.Ok target ->
+      | Result.Ok target -> (
           let text = inline_elements status content in
-          let target =
-            match target with
-            | `Asset _ as a -> a
-            | `Root (_, `TAsset) as a -> a
-            | `Root (s, `TUnknown) -> `Root (s, `TAsset)
-            | `Root _ -> failwith "a"
-            | `Dot (_, s) -> failwith s
-            | `Resolved _ -> failwith "todo2"
-            | _ -> failwith "todo"
-          in
-          `Media (`Reference target, m, text) |> Location.at location
-      | Result.Error error ->
-          Error.raise_warning error;
-          let placeholder =
-            match kind with
-            | `Simple -> `Code_span href
-            | `With_text -> `Styled (`Emphasis, content)
+          let asset_ref_of_ref :
+              Paths.Reference.t -> (Paths.Reference.Asset.t, _) result =
+            function
+            | `Asset _ as a -> Ok a
+            | `Root (_, `TAsset) as a -> Ok a
+            | `Root (s, `TUnknown) -> Ok (`Root (s, `TAsset))
+            | `Dot (p, s) -> Ok (`Dot (p, s))
+            | _ ->
+                Error
+                  (not_allowed ~suggestion:"Use a reference to an asset"
+                     href_location ~what:"Non-asset reference"
+                     ~in_what:"media target")
           in
-          `Paragraph
-            (inline_elements status [ placeholder |> Location.at location ])
-          |> Location.at location)
+          match asset_ref_of_ref target with
+          | Error error -> fallback error
+          | Ok target ->
+              `Media (`Reference target, m, text) |> Location.at location)
+      | Result.Error error -> fallback error)
 
 and nestable_block_elements status elements =
   List.map (nestable_block_element status) elements
diff --git a/test/pages/medias.t/index.mld b/test/pages/medias.t/index.mld
index 32b5ae2573..1a7bbceb36 100644
--- a/test/pages/medias.t/index.mld
+++ b/test/pages/medias.t/index.mld
@@ -26,4 +26,8 @@ Some image:
 
 {2 Links}
 
-{video:https://interactive-examples.mdn.mozilla.net/media/cc0-videos/flower.webm}
\ No newline at end of file
+{video:https://interactive-examples.mdn.mozilla.net/media/cc0-videos/flower.webm}
+
+{1 Errors}
+
+- Wrong qualification:{image!module-x}
diff --git a/test/pages/medias.t/run.t b/test/pages/medias.t/run.t
index f475c5d631..49e7b77cd2 100644
--- a/test/pages/medias.t/run.t
+++ b/test/pages/medias.t/run.t
@@ -1,6 +1,9 @@
 We need to odoc-compile the package mld file, listing its children
 
   $ odoc compile index.mld --child asset-caml.gif
+  File "index.mld", line 33, characters 30-38:
+  Warning: Non-asset reference is not allowed in media target.
+  Suggestion: Use a reference to an asset
 
 This will have produced a file called 'page-index.odoc'.
 
@@ -15,8 +18,8 @@ Link and generate the HTML (forgetting the asset!):
   $ odoc support-files -o html
 
 To test visually, indent:
-  $ cp -r html /tmp/
-  $ firefox /tmp/html/index/index.html
+ $ cp -r html /tmp/
+ $ firefox /tmp/html/index/index.html
 
 Testing the working references:
 
@@ -58,6 +61,7 @@ Testing latex and manpages
   \ocamlinlinecode{https://picsum.\allowbreak{}photos/200/300}
   \ocamlinlinecode{https://upload.\allowbreak{}wikimedia.\allowbreak{}org/wikipedia/commons/f/f1/Cri\_\allowbreak{}du\_\allowbreak{}chameau.\allowbreak{}ogg}
   \ocamlinlinecode{https://interactive-examples.\allowbreak{}mdn.\allowbreak{}mozilla.\allowbreak{}net/media/cc0-videos/flower.\allowbreak{}webm}
+  \ocamlinlinecode{module-x}
 
   $ odoc man-generate -o man page-index.odocl
   $ cat man/index.3o | grep gif