    --------------------------------------------------------------------------------
    {-# LANGUAGE CPP               #-}
    {-# LANGUAGE OverloadedStrings #-}
    module Hakyll.Check
        ( Check (..)
        , check
        ) where

    --------------------------------------------------------------------------------
    import           Control.Concurrent.MVar      (MVar, newEmptyMVar, putMVar,
                                                   readMVar)
    import           Control.Exception            (SomeAsyncException (..),
                                                   SomeException (..), throw, try)
    import           Control.Monad                (foldM, forM_)
    import           Control.Monad.Reader         (ReaderT, ask, runReaderT)
    import           Control.Monad.State          (StateT, get, modify, runStateT)
    import           Control.Monad.Trans          (liftIO)
    import           Control.Monad.Trans.Resource (runResourceT)
    import           Data.List                    (isPrefixOf)
    import qualified Data.Map.Lazy                as Map
    #if MIN_VERSION_base(4,9,0)
    import           Data.Semigroup               (Semigroup (..))
    #endif
    import           Network.URI                  (unEscapeString)
    import           System.Directory             (doesDirectoryExist,
                                                   doesFileExist)
    import           System.Exit                  (ExitCode (..))
    import           System.FilePath              (takeDirectory, takeExtension,
                                                   (</>))
    import qualified Text.HTML.TagSoup            as TS

    --------------------------------------------------------------------------------
    #ifdef CHECK_EXTERNAL
    import           Data.List                    (intercalate)
    import           Data.Typeable                (cast)
    import           Data.Version                 (versionBranch)
    import           GHC.Exts                     (fromString)
    import qualified Network.HTTP.Conduit         as Http
    import qualified Network.HTTP.Types           as Http
    import qualified Paths_hakyll                 as Paths_hakyll
    #endif

    --------------------------------------------------------------------------------
    import           Hakyll.Core.Configuration
    import           Hakyll.Core.Logger           (Logger)
    import qualified Hakyll.Core.Logger           as Logger
    import           Hakyll.Core.Util.File
    import           Hakyll.Web.Html

    --------------------------------------------------------------------------------
    data Check = All | InternalLinks
        deriving (Check -> Check -> Bool
    (Check -> Check -> Bool) -> (Check -> Check -> Bool) -> Eq Check
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Check -> Check -> Bool
    $c/= :: Check -> Check -> Bool
    == :: Check -> Check -> Bool
    $c== :: Check -> Check -> Bool
    Eq, Eq Check
    Eq Check =>
    (Check -> Check -> Ordering)
    -> (Check -> Check -> Bool)
    -> (Check -> Check -> Bool)
    -> (Check -> Check -> Bool)
    -> (Check -> Check -> Bool)
    -> (Check -> Check -> Check)
    -> (Check -> Check -> Check)
    -> Ord Check
    Check -> Check -> Bool
    Check -> Check -> Ordering
    Check -> Check -> Check
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: Check -> Check -> Check
    $cmin :: Check -> Check -> Check
    max :: Check -> Check -> Check
    $cmax :: Check -> Check -> Check
    >= :: Check -> Check -> Bool
    $c>= :: Check -> Check -> Bool
    > :: Check -> Check -> Bool
    $c> :: Check -> Check -> Bool
    <= :: Check -> Check -> Bool
    $c<= :: Check -> Check -> Bool
    < :: Check -> Check -> Bool
    $c< :: Check -> Check -> Bool
    compare :: Check -> Check -> Ordering
    $ccompare :: Check -> Check -> Ordering
    $cp1Ord :: Eq Check
    Ord, Int -> Check -> ShowS
    [Check] -> ShowS
    Check -> String
    (Int -> Check -> ShowS)
    -> (Check -> String) -> ([Check] -> ShowS) -> Show Check
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Check] -> ShowS
    $cshowList :: [Check] -> ShowS
    show :: Check -> String
    $cshow :: Check -> String
    showsPrec :: Int -> Check -> ShowS
    $cshowsPrec :: Int -> Check -> ShowS
    Show)

    --------------------------------------------------------------------------------
    check :: Configuration -> Logger -> Check -> IO ExitCode
    check :: Configuration -> Logger -> Check -> IO ExitCode
    check config :: Configuration
    config logger :: Logger
    logger check' :: Check
    check' = do
        ((), state :: CheckerState
    state) <- Checker ()
    -> Configuration -> Logger -> Check -> IO ((), CheckerState)
    forall a.
    Checker a
    -> Configuration -> Logger -> Check -> IO (a, CheckerState)
    runChecker Checker ()
    checkDestination Configuration
    config Logger
    logger Check
    check'
        Int
    failed <- CheckerState -> IO Int
    countFailedLinks CheckerState
    state
        ExitCode -> IO ExitCode
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
    forall a b. (a -> b) -> a -> b
    $ if Int
    failed Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 then Int -> ExitCode
    ExitFailure 1 else ExitCode
    ExitSuccess

    --------------------------------------------------------------------------------
    countFailedLinks :: CheckerState -> IO Int
    countFailedLinks :: CheckerState -> IO Int
    countFailedLinks state :: CheckerState
    state = (Int -> MVar CheckerWrite -> IO Int)
    -> Int -> [MVar CheckerWrite] -> IO Int
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Int -> MVar CheckerWrite -> IO Int
    addIfFailure 0 (CheckerState -> [MVar CheckerWrite]
    forall k a. Map k a -> [a]
    Map.elems CheckerState
    state)
        where addIfFailure :: Int -> MVar CheckerWrite -> IO Int
    addIfFailure failures :: Int
    failures mvar :: MVar CheckerWrite
    mvar = do
                  CheckerWrite
    checkerWrite <- MVar CheckerWrite -> IO CheckerWrite
    forall a. MVar a -> IO a
    readMVar MVar CheckerWrite
    mvar
                  Int -> IO Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> IO Int) -> Int -> IO Int
    forall a b. (a -> b) -> a -> b
    $ Int
    failures Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + CheckerWrite -> Int
    checkerFaulty CheckerWrite
    checkerWrite

    --------------------------------------------------------------------------------
    data CheckerRead = CheckerRead
        { CheckerRead -> Configuration
    checkerConfig :: Configuration
        , CheckerRead -> Logger
    checkerLogger :: Logger
        , CheckerRead -> Check
    checkerCheck  :: Check
        }

    --------------------------------------------------------------------------------
    data CheckerWrite = CheckerWrite
        { CheckerWrite -> Int
    checkerFaulty :: Int
        , CheckerWrite -> Int
    checkerOk     :: Int
        } deriving (Int -> CheckerWrite -> ShowS
    [CheckerWrite] -> ShowS
    CheckerWrite -> String
    (Int -> CheckerWrite -> ShowS)
    -> (CheckerWrite -> String)
    -> ([CheckerWrite] -> ShowS)
    -> Show CheckerWrite
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [CheckerWrite] -> ShowS
    $cshowList :: [CheckerWrite] -> ShowS
    show :: CheckerWrite -> String
    $cshow :: CheckerWrite -> String
    showsPrec :: Int -> CheckerWrite -> ShowS
    $cshowsPrec :: Int -> CheckerWrite -> ShowS
    Show)

    --------------------------------------------------------------------------------
    #if MIN_VERSION_base(4,9,0)
    instance Semigroup CheckerWrite where
        <> :: CheckerWrite -> CheckerWrite -> CheckerWrite
    (<>) (CheckerWrite f1 :: Int
    f1 o1 :: Int
    o1) (CheckerWrite f2 :: Int
    f2 o2 :: Int
    o2) =
            Int -> Int -> CheckerWrite
    CheckerWrite (Int
    f1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    f2) (Int
    o1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    o2)

    instance Monoid CheckerWrite where
        mempty :: CheckerWrite
    mempty  = Int -> Int -> CheckerWrite
    CheckerWrite 0 0
        mappend :: CheckerWrite -> CheckerWrite -> CheckerWrite
    mappend = CheckerWrite -> CheckerWrite -> CheckerWrite
    forall a. Semigroup a => a -> a -> a
    (<>)
    #else
    instance Monoid CheckerWrite where
        mempty                                            = CheckerWrite 0 0
        mappend (CheckerWrite f1 o1) (CheckerWrite f2 o2) =
            CheckerWrite (f1 + f2) (o1 + o2)
    #endif

    --------------------------------------------------------------------------------
    type CheckerState = Map.Map URL (MVar CheckerWrite)

    --------------------------------------------------------------------------------
    type Checker a = ReaderT CheckerRead (StateT CheckerState IO) a

    --------------------------------------------------------------------------------
    type URL = String

    --------------------------------------------------------------------------------
    runChecker :: Checker a -> Configuration -> Logger -> Check
               -> IO (a, CheckerState)
    runChecker :: Checker a
    -> Configuration -> Logger -> Check -> IO (a, CheckerState)
    runChecker checker :: Checker a
    checker config :: Configuration
    config logger :: Logger
    logger check' :: Check
    check' = do
        let read' :: CheckerRead
    read' = CheckerRead :: Configuration -> Logger -> Check -> CheckerRead
    CheckerRead
                        { checkerConfig :: Configuration
    checkerConfig = Configuration
    config
                        , checkerLogger :: Logger
    checkerLogger = Logger
    logger
                        , checkerCheck :: Check
    checkerCheck  = Check
    check'
                        }
        Logger -> IO ()
    Logger.flush Logger
    logger
        StateT CheckerState IO a -> CheckerState -> IO (a, CheckerState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT (Checker a -> CheckerRead -> StateT CheckerState IO a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT Checker a
    checker CheckerRead
    read') CheckerState
    forall k a. Map k a
    Map.empty

    --------------------------------------------------------------------------------
    checkDestination :: Checker ()
    checkDestination :: Checker ()
    checkDestination = do
        Configuration
    config <- CheckerRead -> Configuration
    checkerConfig (CheckerRead -> Configuration)
    -> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    -> ReaderT CheckerRead (StateT CheckerState IO) Configuration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        [String]
    files  <- IO [String]
    -> ReaderT CheckerRead (StateT CheckerState IO) [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [String]
     -> ReaderT CheckerRead (StateT CheckerState IO) [String])
    -> IO [String]
    -> ReaderT CheckerRead (StateT CheckerState IO) [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> IO Bool) -> String -> IO [String]
    getRecursiveContents
            (IO Bool -> String -> IO Bool
    forall a b. a -> b -> a
    const (IO Bool -> String -> IO Bool) -> IO Bool -> String -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False) (Configuration -> String
    destinationDirectory Configuration
    config)

        let htmls :: [String]
    htmls =
                [ Configuration -> String
    destinationDirectory Configuration
    config String -> ShowS
    </> String
    file
                | String
    file <- [String]
    files
                , ShowS
    takeExtension String
    file String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == ".html"
                ]

        [String] -> (String -> Checker ()) -> Checker ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [String]
    htmls String -> Checker ()
    checkFile

    --------------------------------------------------------------------------------
    checkFile :: FilePath -> Checker ()
    checkFile :: String -> Checker ()
    checkFile filePath :: String
    filePath = do
        Logger
    logger   <- CheckerRead -> Logger
    checkerLogger (CheckerRead -> Logger)
    -> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    -> ReaderT CheckerRead (StateT CheckerState IO) Logger
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        String
    contents <- IO String -> ReaderT CheckerRead (StateT CheckerState IO) String
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> ReaderT CheckerRead (StateT CheckerState IO) String)
    -> IO String -> ReaderT CheckerRead (StateT CheckerState IO) String
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    readFile String
    filePath
        Logger -> String -> Checker ()
    forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
    Logger.header Logger
    logger (String -> Checker ()) -> String -> Checker ()
    forall a b. (a -> b) -> a -> b
    $ "Checking file " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    filePath

        let urls :: [String]
    urls = [Tag String] -> [String]
    getUrls ([Tag String] -> [String]) -> [Tag String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ String -> [Tag String]
    forall str. StringLike str => str -> [Tag str]
    TS.parseTags String
    contents
        [String] -> (String -> Checker ()) -> Checker ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [String]
    urls ((String -> Checker ()) -> Checker ())
    -> (String -> Checker ()) -> Checker ()
    forall a b. (a -> b) -> a -> b
    $ \url :: String
    url -> do
            Logger -> String -> Checker ()
    forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
    Logger.debug Logger
    logger (String -> Checker ()) -> String -> Checker ()
    forall a b. (a -> b) -> a -> b
    $ "Checking link " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    url
            MVar CheckerWrite
    m <- IO (MVar CheckerWrite)
    -> ReaderT CheckerRead (StateT CheckerState IO) (MVar CheckerWrite)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO (MVar CheckerWrite)
    forall a. IO (MVar a)
    newEmptyMVar
            String -> String -> MVar CheckerWrite -> Checker ()
    checkUrlIfNeeded String
    filePath (ShowS
    canonicalizeUrl String
    url) MVar CheckerWrite
    m
        where
            -- Check scheme-relative links
            canonicalizeUrl :: ShowS
    canonicalizeUrl url :: String
    url = if String -> Bool
    schemeRelative String
    url then "http:" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    url else String
    url
            schemeRelative :: String -> Bool
    schemeRelative = String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf "//"

    --------------------------------------------------------------------------------
    checkUrlIfNeeded :: FilePath -> URL -> MVar CheckerWrite -> Checker ()
    checkUrlIfNeeded :: String -> String -> MVar CheckerWrite -> Checker ()
    checkUrlIfNeeded filepath :: String
    filepath url :: String
    url m :: MVar CheckerWrite
    m = do
        Logger
    logger     <- CheckerRead -> Logger
    checkerLogger           (CheckerRead -> Logger)
    -> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    -> ReaderT CheckerRead (StateT CheckerState IO) Logger
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        Bool
    needsCheck <- (Check -> Check -> Bool
    forall a. Eq a => a -> a -> Bool
    == Check
    All) (Check -> Bool) -> (CheckerRead -> Check) -> CheckerRead -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CheckerRead -> Check
    checkerCheck (CheckerRead -> Bool)
    -> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    -> ReaderT CheckerRead (StateT CheckerState IO) Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        Bool
    checked    <- (String
    url String -> CheckerState -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    `Map.member`)      (CheckerState -> Bool)
    -> ReaderT CheckerRead (StateT CheckerState IO) CheckerState
    -> ReaderT CheckerRead (StateT CheckerState IO) Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT CheckerRead (StateT CheckerState IO) CheckerState
    forall s (m :: * -> *). MonadState s m => m s
    get
        if Bool -> Bool
    not Bool
    needsCheck Bool -> Bool -> Bool
    || Bool
    checked
            then Logger -> String -> Checker ()
    forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
    Logger.debug Logger
    logger "Already checked, skipping"
            else do (CheckerState -> CheckerState) -> Checker ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((CheckerState -> CheckerState) -> Checker ())
    -> (CheckerState -> CheckerState) -> Checker ()
    forall a b. (a -> b) -> a -> b
    $ String -> MVar CheckerWrite -> CheckerState -> CheckerState
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert String
    url MVar CheckerWrite
    m
                    String -> String -> Checker ()
    checkUrl String
    filepath String
    url

    --------------------------------------------------------------------------------
    checkUrl :: FilePath -> URL -> Checker ()
    checkUrl :: String -> String -> Checker ()
    checkUrl filePath :: String
    filePath url :: String
    url
        | String -> Bool
    isExternal String
    url  = String -> Checker ()
    checkExternalUrl String
    url
        | String -> Bool
    hasProtocol String
    url = String -> Maybe String -> Checker ()
    skip String
    url (Maybe String -> Checker ()) -> Maybe String -> Checker ()
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe String
    forall a. a -> Maybe a
    Just "Unknown protocol, skipping"
        | Bool
    otherwise       = String -> String -> Checker ()
    checkInternalUrl String
    filePath String
    url
      where
        validProtoChars :: String
    validProtoChars = ['A'..'Z'] String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ['a'..'z'] String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ['0'..'9'] String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "+-."
        hasProtocol :: String -> Bool
    hasProtocol str :: String
    str = case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == ':') String
    str of
            (proto :: String
    proto, ':' : _) -> (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    validProtoChars) String
    proto
            _                -> Bool
    False

    --------------------------------------------------------------------------------
    ok :: URL -> Checker ()
    ok :: String -> Checker ()
    ok url :: String
    url = String -> CheckerWrite -> Checker ()
    putCheckResult String
    url CheckerWrite
    forall a. Monoid a => a
    mempty {checkerOk :: Int
    checkerOk = 1}

    --------------------------------------------------------------------------------
    skip :: URL -> Maybe String -> Checker ()
    skip :: String -> Maybe String -> Checker ()
    skip url :: String
    url maybeReason :: Maybe String
    maybeReason = do
        Logger
    logger <- CheckerRead -> Logger
    checkerLogger (CheckerRead -> Logger)
    -> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    -> ReaderT CheckerRead (StateT CheckerState IO) Logger
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        case Maybe String
    maybeReason of
            Nothing     -> () -> Checker ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            Just reason :: String
    reason -> Logger -> String -> Checker ()
    forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
    Logger.debug Logger
    logger String
    reason
        String -> CheckerWrite -> Checker ()
    putCheckResult String
    url CheckerWrite
    forall a. Monoid a => a
    mempty {checkerOk :: Int
    checkerOk = 1}

    --------------------------------------------------------------------------------
    faulty :: URL -> Maybe String -> Checker ()
    faulty :: String -> Maybe String -> Checker ()
    faulty url :: String
    url reason :: Maybe String
    reason = do
        Logger
    logger <- CheckerRead -> Logger
    checkerLogger (CheckerRead -> Logger)
    -> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    -> ReaderT CheckerRead (StateT CheckerState IO) Logger
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        Logger -> String -> Checker ()
    forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
    Logger.error Logger
    logger (String -> Checker ()) -> String -> Checker ()
    forall a b. (a -> b) -> a -> b
    $ "Broken link to " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    url String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    explanation
        String -> CheckerWrite -> Checker ()
    putCheckResult String
    url CheckerWrite
    forall a. Monoid a => a
    mempty {checkerFaulty :: Int
    checkerFaulty = 1}
      where
        formatExplanation :: ShowS
    formatExplanation = (" (" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ")")
        explanation :: String
    explanation = String -> ShowS -> Maybe String -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" ShowS
    formatExplanation Maybe String
    reason

    --------------------------------------------------------------------------------
    putCheckResult :: URL -> CheckerWrite -> Checker ()
    putCheckResult :: String -> CheckerWrite -> Checker ()
    putCheckResult url :: String
    url result :: CheckerWrite
    result = do
        CheckerState
    state <- ReaderT CheckerRead (StateT CheckerState IO) CheckerState
    forall s (m :: * -> *). MonadState s m => m s
    get
        let maybeMVar :: Maybe (MVar CheckerWrite)
    maybeMVar = String -> CheckerState -> Maybe (MVar CheckerWrite)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    url CheckerState
    state
        case Maybe (MVar CheckerWrite)
    maybeMVar of
            Just m :: MVar CheckerWrite
    m -> IO () -> Checker ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Checker ()) -> IO () -> Checker ()
    forall a b. (a -> b) -> a -> b
    $ MVar CheckerWrite -> CheckerWrite -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar CheckerWrite
    m CheckerWrite
    result
            Nothing -> do
                Logger
    logger <- CheckerRead -> Logger
    checkerLogger (CheckerRead -> Logger)
    -> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    -> ReaderT CheckerRead (StateT CheckerState IO) Logger
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    forall r (m :: * -> *). MonadReader r m => m r
    ask
                Logger -> String -> Checker ()
    forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
    Logger.debug Logger
    logger "Failed to find existing entry for checked URL"

    --------------------------------------------------------------------------------
    checkInternalUrl :: FilePath -> URL -> Checker ()
    checkInternalUrl :: String -> String -> Checker ()
    checkInternalUrl base :: String
    base url :: String
    url = case String
    url' of
        "" -> String -> Checker ()
    ok String
    url
        _  -> do
            Configuration
    config <- CheckerRead -> Configuration
    checkerConfig (CheckerRead -> Configuration)
    -> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    -> ReaderT CheckerRead (StateT CheckerState IO) Configuration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT CheckerRead (StateT CheckerState IO) CheckerRead
    forall r (m :: * -> *). MonadReader r m => m r
    ask
            let dest :: String
    dest = Configuration -> String
    destinationDirectory Configuration
    config
                dir :: String
    dir  = ShowS
    takeDirectory String
    base
                filePath :: String
    filePath
                    | "/" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    url' = String
    dest String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    url'
                    | Bool
    otherwise             = String
    dir String -> ShowS
    </> String
    url'

            Bool
    exists <- String -> ReaderT CheckerRead (StateT CheckerState IO) Bool
    checkFileExists String
    filePath
            if Bool
    exists then String -> Checker ()
    ok String
    url else String -> Maybe String -> Checker ()
    faulty String
    url Maybe String
    forall a. Maybe a
    Nothing
      where
        url' :: String
    url' = ShowS
    stripFragments ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ ShowS
    unEscapeString String
    url

    --------------------------------------------------------------------------------
    checkExternalUrl :: URL -> Checker ()
    #ifdef CHECK_EXTERNAL
    checkExternalUrl :: String -> Checker ()
    checkExternalUrl url :: String
    url = do
        Either SomeException Bool
    result <- String -> Checker (Either SomeException Bool)
    requestExternalUrl String
    url
        case Either SomeException Bool
    result of
            Left (SomeException e :: e
    e) ->
                case (e -> Maybe SomeAsyncException
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast e
    e :: Maybe SomeAsyncException) of
                    Just ae :: SomeAsyncException
    ae -> SomeAsyncException -> Checker ()
    forall a e. Exception e => e -> a
    throw SomeAsyncException
    ae
                    _       -> String -> Maybe String -> Checker ()
    faulty String
    url (String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ e -> String
    forall a. (Typeable a, Show a) => a -> String
    showException e
    e)
            Right _ -> String -> Checker ()
    ok String
    url
        where
            -- Convert exception to a concise form
            showException :: a -> String
    showException e :: a
    e = case a -> Maybe HttpException
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    e of
                Just (Http.HttpExceptionRequest _ e' :: HttpExceptionContent
    e') -> HttpExceptionContent -> String
    forall a. Show a => a -> String
    show HttpExceptionContent
    e'
                _                                     -> [String] -> String
    forall a. [a] -> a
    head ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    words (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ a -> String
    forall a. Show a => a -> String
    show a
    e

    requestExternalUrl :: URL -> Checker (Either SomeException Bool)
    requestExternalUrl :: String -> Checker (Either SomeException Bool)
    requestExternalUrl url :: String
    url = IO (Either SomeException Bool)
    -> Checker (Either SomeException Bool)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either SomeException Bool)
     -> Checker (Either SomeException Bool))
    -> IO (Either SomeException Bool)
    -> Checker (Either SomeException Bool)
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> IO (Either SomeException Bool)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO Bool -> IO (Either SomeException Bool))
    -> IO Bool -> IO (Either SomeException Bool)
    forall a b. (a -> b) -> a -> b
    $ do
        Manager
    mgr <- ManagerSettings -> IO Manager
    Http.newManager ManagerSettings
    Http.tlsManagerSettings
        ResourceT IO Bool -> IO Bool
    forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
    runResourceT (ResourceT IO Bool -> IO Bool) -> ResourceT IO Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ do
            Request
    request  <- String -> ResourceT IO Request
    forall (m :: * -> *). MonadThrow m => String -> m Request
    Http.parseRequest String
    url
            Response (ConduitM Any ByteString (ResourceT IO) ())
    response <- Request
    -> Manager
    -> ResourceT
         IO (Response (ConduitM Any ByteString (ResourceT IO) ()))
    forall (m :: * -> *) i.
    MonadResource m =>
    Request -> Manager -> m (Response (ConduitM i ByteString m ()))
    Http.http (Request -> Request
    settings Request
    request) Manager
    mgr
            let code :: Int
    code = Status -> Int
    Http.statusCode (Response (ConduitM Any ByteString (ResourceT IO) ()) -> Status
    forall body. Response body -> Status
    Http.responseStatus Response (ConduitM Any ByteString (ResourceT IO) ())
    response)
            Bool -> ResourceT IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> ResourceT IO Bool) -> Bool -> ResourceT IO Bool
    forall a b. (a -> b) -> a -> b
    $ Int
    code Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 200 Bool -> Bool -> Bool
    && Int
    code Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 300
        where
            -- Add additional request info
            settings :: Request -> Request
    settings r :: Request
    r = Request
    r
                { method :: ByteString
    Http.method         = "HEAD"
                , redirectCount :: Int
    Http.redirectCount  = 10
                , requestHeaders :: RequestHeaders
    Http.requestHeaders = ("User-Agent", ByteString
    ua) (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
    forall a. a -> [a] -> [a]
    : Request -> RequestHeaders
    Http.requestHeaders Request
    r
                }

            -- Nice user agent info
            ua :: ByteString
    ua = String -> ByteString
    forall a. IsString a => String -> a
    fromString (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ "hakyll-check/" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                 (String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "." ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (Int -> String) -> [Int] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> String
    forall a. Show a => a -> String
    show ([Int] -> [String]) -> [Int] -> [String]
    forall a b. (a -> b) -> a -> b
    $ Version -> [Int]
    versionBranch Version
    Paths_hakyll.version)
    #else
    checkExternalUrl url = skip url Nothing
    #endif

    --------------------------------------------------------------------------------
    -- | Wraps doesFileExist, also checks for index.html
    checkFileExists :: FilePath -> Checker Bool
    checkFileExists :: String -> ReaderT CheckerRead (StateT CheckerState IO) Bool
    checkFileExists filePath :: String
    filePath = IO Bool -> ReaderT CheckerRead (StateT CheckerState IO) Bool
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> ReaderT CheckerRead (StateT CheckerState IO) Bool)
    -> IO Bool -> ReaderT CheckerRead (StateT CheckerState IO) Bool
    forall a b. (a -> b) -> a -> b
    $ do
        Bool
    file <- String -> IO Bool
    doesFileExist String
    filePath
        Bool
    dir  <- String -> IO Bool
    doesDirectoryExist String
    filePath
        case (Bool
    file, Bool
    dir) of
            (True, _) -> Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
            (_, True) -> String -> IO Bool
    doesFileExist (String -> IO Bool) -> String -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ String
    filePath String -> ShowS
    </> "index.html"
            _         -> Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    --------------------------------------------------------------------------------
    stripFragments :: String -> String
    stripFragments :: ShowS
    stripFragments = (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> String -> Bool) -> String -> Char -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem ['?', '#'])