summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Hakyll/Check.hs29
-rw-r--r--src/Hakyll/Commands.hs4
-rw-r--r--src/Hakyll/Main.hs13
3 files changed, 30 insertions, 16 deletions
diff --git a/src/Hakyll/Check.hs b/src/Hakyll/Check.hs
index 5908310..6b9918b 100644
--- a/src/Hakyll/Check.hs
+++ b/src/Hakyll/Check.hs
@@ -1,7 +1,8 @@
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
module Hakyll.Check
- ( check
+ ( Check (..)
+ , check
) where
@@ -37,9 +38,14 @@ import Hakyll.Web.Html
--------------------------------------------------------------------------------
-check :: Configuration -> Verbosity -> IO ExitCode
-check config verbosity = do
- ((), write) <- runChecker checkDestination config verbosity
+data Check = All | InternalLinks
+ deriving (Eq, Ord, Show)
+
+
+--------------------------------------------------------------------------------
+check :: Configuration -> Verbosity -> Check -> IO ExitCode
+check config verbosity check' = do
+ ((), write) <- runChecker checkDestination config verbosity check'
return $ if checkerFaulty write >= 0 then ExitFailure 1 else ExitSuccess
@@ -47,6 +53,7 @@ check config verbosity = do
data CheckerRead = CheckerRead
{ checkerConfig :: Configuration
, checkerLogger :: Logger
+ , checkerCheck :: Check
}
@@ -73,10 +80,11 @@ type Checker a = RWST CheckerRead CheckerWrite CheckerState IO a
--------------------------------------------------------------------------------
-runChecker :: Checker a -> Configuration -> Verbosity -> IO (a, CheckerWrite)
-runChecker checker config verbosity = do
+runChecker :: Checker a -> Configuration -> Verbosity -> Check
+ -> IO (a, CheckerWrite)
+runChecker checker config verbosity check' = do
logger <- Logger.new verbosity
- let read' = CheckerRead config logger
+ let read' = CheckerRead config logger check'
(x, _, write) <- runRWST checker read' S.empty
Logger.flush logger
return (x, write)
@@ -146,10 +154,11 @@ checkInternalUrl base url = case url' of
--------------------------------------------------------------------------------
checkExternalUrl :: String -> Checker ()
checkExternalUrl url = do
- logger <- checkerLogger <$> ask
- checked <- (url `S.member`) <$> get
+ logger <- checkerLogger <$> ask
+ needsCheck <- (== All) . checkerCheck <$> ask
+ checked <- (url `S.member`) <$> get
- if checked
+ if not needsCheck || checked
then Logger.debug logger "Already checked, skipping"
else do
isOk <- liftIO $ handle (failure logger) $
diff --git a/src/Hakyll/Commands.hs b/src/Hakyll/Commands.hs
index 23deb7f..b7e85bc 100644
--- a/src/Hakyll/Commands.hs
+++ b/src/Hakyll/Commands.hs
@@ -49,8 +49,8 @@ build conf verbosity rules = do
--------------------------------------------------------------------------------
-- | Run the checker and exit
-check :: Configuration -> Verbosity -> IO ()
-check config verbosity = Check.check config verbosity >>= exitWith
+check :: Configuration -> Verbosity -> Check.Check -> IO ()
+check config verbosity check' = Check.check config verbosity check' >>= exitWith
--------------------------------------------------------------------------------
diff --git a/src/Hakyll/Main.hs b/src/Hakyll/Main.hs
index 86aae28..527548d 100644
--- a/src/Hakyll/Main.hs
+++ b/src/Hakyll/Main.hs
@@ -16,7 +16,8 @@ import System.IO.Unsafe (unsafePerformIO)
--------------------------------------------------------------------------------
-import qualified Hakyll.Commands as Commands
+import qualified Hakyll.Check as Check
+import qualified Hakyll.Commands as Commands
import qualified Hakyll.Core.Configuration as Config
import qualified Hakyll.Core.Logger as Logger
import Hakyll.Core.Rules
@@ -36,9 +37,12 @@ hakyllWith conf rules = do
args' <- cmdArgs hakyllArgs
let verbosity' = if verbose args' then Logger.Debug else Logger.Message
+ check' =
+ if internal_links args' then Check.InternalLinks else Check.All
+
case args' of
Build _ -> Commands.build conf verbosity' rules
- Check _ -> Commands.check conf verbosity'
+ Check _ _ -> Commands.check conf verbosity' check'
Clean _ -> Commands.clean conf
Deploy _ -> Commands.deploy conf
Help _ -> showHelp
@@ -56,7 +60,7 @@ showHelp = print $ CA.helpText [] CA.HelpFormatOne $ cmdArgsMode hakyllArgs
--------------------------------------------------------------------------------
data HakyllArgs
= Build {verbose :: Bool}
- | Check {verbose :: Bool}
+ | Check {verbose :: Bool, internal_links :: Bool}
| Clean {verbose :: Bool}
| Deploy {verbose :: Bool}
| Help {verbose :: Bool}
@@ -70,7 +74,8 @@ data HakyllArgs
hakyllArgs :: HakyllArgs
hakyllArgs = modes
[ (Build $ verboseFlag def) &= help "Generate the site"
- , (Check $ verboseFlag def) &= help "Validate the site output"
+ , (Check (verboseFlag def) (False &= help "Check internal links only")) &=
+ help "Validate the site output"
, (Clean $ verboseFlag def) &= help "Clean up and remove cache"
, (Deploy $ verboseFlag def) &= help "Upload/deploy your site"
, (Help $ verboseFlag def) &= help "Show this message" &= auto