diff options
author | stuebinm | 2021-12-20 13:51:28 +0100 |
---|---|---|
committer | stuebinm | 2021-12-20 13:51:28 +0100 |
commit | 65e496a811002af9948d0453675567c9eaf827d9 (patch) | |
tree | 75e9e9ffbae5b7fe5a0a88691deec4fda2fa1383 /lib | |
parent | 5c69c3118d60ff445905201669bd48cc8d2ed909 (diff) |
generalise unwrapURI a bit
Diffstat (limited to '')
-rw-r--r-- | lib/Properties.hs | 23 |
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 ()) |