summaryrefslogtreecommitdiff
path: root/src/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll')
-rw-r--r--src/Hakyll/Check.hs55
1 files changed, 32 insertions, 23 deletions
diff --git a/src/Hakyll/Check.hs b/src/Hakyll/Check.hs
index 681318a..3728235 100644
--- a/src/Hakyll/Check.hs
+++ b/src/Hakyll/Check.hs
@@ -82,34 +82,43 @@ checkFile filePath = do
contents <- liftIO $ readFile filePath
Logger.header logger $ "Checking " ++ filePath
- let tags = TS.parseTags contents
- -- Lots of logic here...
- urls = filter (not . null) $
- map stripFragments $
- filter (not . isExternal) $
- getUrls tags
+ let urls = getUrls $ TS.parseTags contents
+ forM_ urls $ \url ->
+ if isExternal url
+ then checkExternalUrl url
+ else checkInternalUrl filePath url
- mapM_ (checkUrl filePath) urls
+
+--------------------------------------------------------------------------------
+checkInternalUrl :: FilePath -> String -> Checker ()
+checkInternalUrl base url = case url' of
+ "" -> tell $ mempty {checkerOk = 1}
+ _ -> do
+ logger <- checkerLogger <$> ask
+ config <- checkerConfig <$> ask
+
+ let dest = destinationDirectory config
+ dir = takeDirectory base
+ filePath
+ | "/" `isPrefixOf` url' = dest ++ url'
+ | otherwise = dir </> url'
+
+ exists <- checkFileExists filePath
+ if exists
+ then tell $ mempty {checkerOk = 1}
+ else do
+ tell $ mempty {checkerFaulty = 1}
+ Logger.error logger $ base ++ ": broken link to " ++ show url
+ where
+ url' = stripFragments url
--------------------------------------------------------------------------------
-checkUrl :: FilePath -> String -> Checker ()
-checkUrl base url = do
+checkExternalUrl :: String -> Checker ()
+checkExternalUrl url = do
logger <- checkerLogger <$> ask
- config <- checkerConfig <$> ask
-
- let dest = destinationDirectory config
- dir = takeDirectory base
- filePath
- | "/" `isPrefixOf` url = dest ++ url
- | otherwise = dir </> url
-
- exists <- checkFileExists filePath
- if exists
- then tell $ mempty {checkerOk = 1}
- else do
- tell $ mempty {checkerFaulty = 1}
- Logger.error logger $ base ++ ": broken reference to " ++ show url
+ Logger.message logger $ "Not checking external url " ++ url
+ -- TODO: use http-conduit and a cache?
--------------------------------------------------------------------------------