summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorstuebinm2021-12-20 13:51:28 +0100
committerstuebinm2021-12-20 13:51:28 +0100
commit65e496a811002af9948d0453675567c9eaf827d9 (patch)
tree75e9e9ffbae5b7fe5a0a88691deec4fda2fa1383
parent5c69c3118d60ff445905201669bd48cc8d2ed909 (diff)
generalise unwrapURI a bit
-rw-r--r--lib/Properties.hs23
1 files changed, 19 insertions, 4 deletions
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 ())