From 65e496a811002af9948d0453675567c9eaf827d9 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 20 Dec 2021 13:51:28 +0100
Subject: generalise unwrapURI a bit

---
 lib/Properties.hs | 23 +++++++++++++++++++----
 1 file changed, 19 insertions(+), 4 deletions(-)

(limited to 'lib')

diff --git a/lib/Properties.hs b/lib/Properties.hs
index 94cfe24..37b6bc4 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -566,13 +566,17 @@ unwrapBadgeToken str f = case parseToken str of
   Nothing -> complain "invalid badge token."
 
 
-unwrapURI :: (KnownSymbol s, HasProperties a)
-  => Proxy s -> Property -> (Text -> LintWriter a) -> (RelPath -> LintWriter a) -> LintWriter a
-unwrapURI sym p@(Property name _) f g = unwrapString p $ \link -> do
+-- | unwraps a URI
+unwrapURI' :: (KnownSymbol s)
+  => Proxy s
+  -> Property
+  -> (Text -> LintWriter a)
+  -> (RelPath -> LintWriter a)
+  -> LintWriter a
+unwrapURI' sym p@(Property name _) f g = unwrapString p $ \link -> do
   subst <- lintConfig configUriSchemas
   case applySubst sym subst link of
     Right uri -> do
-      setProperty name uri
       f uri
     Left NotALink -> unwrapPath link g
     Left err -> complain $ case err of
@@ -588,6 +592,17 @@ unwrapURI sym p@(Property name _) f g = unwrapString p $ \link -> do
         <> intercalate ", " (fmap (<> "://") allowed) <> "."
       VarsDisallowed -> "extended API links are disallowed in links"
 
+-- | unwraps a URI and adjusts the linter's output
+unwrapURI :: (KnownSymbol s, HasProperties a)
+  => Proxy s
+  -> Property
+  -> (Text -> LintWriter a)
+  -> (RelPath -> LintWriter a)
+  -> LintWriter a
+unwrapURI sym p@(Property name _) f =
+  unwrapURI' sym p $ \uri -> setProperty name uri >> f uri
+
+
 -- | just asserts that this is a string
 isString :: Property -> LintWriter a
 isString = flip unwrapString (const $ pure ())
-- 
cgit v1.2.3