diff options
| -rw-r--r-- | src/Hakyll/Check.hs | 29 | ||||
| -rw-r--r-- | src/Hakyll/Commands.hs | 4 | ||||
| -rw-r--r-- | src/Hakyll/Main.hs | 13 |
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 |