From 0dbe448959d6aa03f0ea99a7e180e2cafaedf651 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 4 Dec 2021 15:12:30 +0100
Subject: better lints for invalid links

---
 lib/Uris.hs | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

(limited to 'lib/Uris.hs')

diff --git a/lib/Uris.hs b/lib/Uris.hs
index dfbd454..b674d37 100644
--- a/lib/Uris.hs
+++ b/lib/Uris.hs
@@ -57,15 +57,19 @@ data SubstError =
   | NotALink
   | IsBlocked
   | InvalidLink
-  | WrongScope Text
+  | WrongScope Text [Text]
+  -- ^ This link's schema exists, but cannot be used in this scope.
+  -- The second field contains a list of schemas that may be used instead.
 
 
-applySubst :: KnownSymbol s => Proxy s -> SchemaSet -> Text -> Either SubstError Text
+applySubst :: KnownSymbol s
+  => Proxy s -> SchemaSet -> Text -> Either SubstError Text
 applySubst s substs uri =  do
   (schema, domain, rest) <- note NotALink $ parseUri uri
   rules <- note (SchemaDoesNotExist schema) ( M.lookup schema substs)
   unless (symbolVal s `elem` scope rules)
-    $ Left (WrongScope schema)
+    $ Left (WrongScope schema
+            (M.keys . M.filter (elem (symbolVal s) . scope) $ substs))
   case rules of
     Explicit table _  -> do
       prefix <- note InvalidLink $ M.lookup domain table
-- 
cgit v1.2.3