on master help sign in
Merge pull request #133 from simukis/scheme-relative

Account for scheme-relative URLs

commit79215f71eb501f65d3e74fdda3e592fbcadd9c7e authorJasper Van der Jeugt <jaspervdj@gmail.com> dateMon 22 Apr 2013, 11:16 (14 years ago) parent0954e8963a3000
3 files changed+10−3
src/Hakyll/Check.hs+8−2 src/Hakyll/Web/Html.hs+1−1 tests/Hakyll/Web/Html/Tests.hs+1
src/Hakyll/Check.hs+8−2
@@ -198,12 +198,14 @@ checkExternalUrl url = do
198198 else do
199199 isOk <- liftIO $ handle (failure logger) $
200200 Http.withManager $ \mgr -> do
201− request <- Http.parseUrl url
201+ request <- Http.parseUrl $ urlToCheck url
202202 response <- Http.http (settings request) mgr
203203 let code = Http.statusCode (Http.responseStatus response)
204204 return $ code >= 200 && code < 300
205205
206− modify $ S.insert url
206+ modify $ if schemeRelative url
207+ then S.insert (urlToCheck url) . S.insert url
208+ else S.insert url
207209 if isOk then ok url else faulty url
208210 where
209211 -- Add additional request info
@@ -221,6 +223,10 @@ checkExternalUrl url = do
221223 failure logger (SomeException e) = case cast e of
222224 Just UserInterrupt -> throw UserInterrupt
223225 _ -> Logger.error logger (show e) >> return False
226+
227+ -- Check scheme-relative links
228+ schemeRelative = isPrefixOf "//"
229+ urlToCheck uri = if schemeRelative uri then "http:" ++ uri else uri
224230#else
225231checkExternalUrl _ = return ()
226232#endif
src/Hakyll/Web/Html.hs+1−1
@@ -120,7 +120,7 @@ toSiteRoot = emptyException . joinPath . map parent
120120--------------------------------------------------------------------------------
121121-- | Check if an URL links to an external HTTP(S) source
122122isExternal :: String -> Bool
123−isExternal url = any (flip isPrefixOf url) ["http://", "https://"]
123+isExternal url = any (flip isPrefixOf url) ["http://", "https://", "//"]
124124
125125
126126--------------------------------------------------------------------------------
tests/Hakyll/Web/Html/Tests.hs+1
@@ -58,6 +58,7 @@ tests = testGroup "Hakyll.Web.Html.Tests" $ concat
5858 , fromAssertions "isExternal"
5959 [ assert (isExternal "http://reddit.com")
6060 , assert (isExternal "https://mail.google.com")
61+ , assert (isExternal "//ajax.googleapis.com")
6162 , assert (not (isExternal "../header.png"))
6263 , assert (not (isExternal "/foo/index.html"))
6364 ]