@@ -8,8 +8,13 @@ module Hakyll.Check
10--------------------------------------------------------------------------------
10--------------------------------------------------------------------------------
11−import Control.Monad (forM_, foldM)
11+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar,
13+import Control.Exception (SomeAsyncException (..),
14+ SomeException (..), throw, try)
15+import Control.Monad (foldM, forM_)
12−import Control.Monad.Reader (ask, ReaderT, runReaderT)
16+import Control.Monad.Reader (ReaderT, ask, runReaderT)
17+import Control.Monad.State (StateT, get, modify, runStateT)
13import Control.Monad.Trans (liftIO)
18import Control.Monad.Trans (liftIO)
14import Control.Monad.Trans.Resource (runResourceT)
19import Control.Monad.Trans.Resource (runResourceT)
15import Data.ByteString.Char8 (unpack)
20import Data.ByteString.Char8 (unpack)
@@ -21,16 +26,11 @@ import System.Directory (doesDirectoryExist,
21import System.Exit (ExitCode (..))
26import System.Exit (ExitCode (..))
22import System.FilePath (takeDirectory, takeExtension,
27import System.FilePath (takeDirectory, takeExtension,
24−import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar,
26import qualified Text.HTML.TagSoup as TS
29import qualified Text.HTML.TagSoup as TS
29--------------------------------------------------------------------------------
32--------------------------------------------------------------------------------
30#ifdef CHECK_EXTERNAL
33#ifdef CHECK_EXTERNAL
31−import Control.Exception (SomeAsyncException (..),
32− SomeException (..), try, throw)
33−import Control.Monad.State (get, modify, StateT, runStateT)
34import Data.List (intercalate)
34import Data.List (intercalate)
35import Data.Typeable (cast)
35import Data.Typeable (cast)
36import Data.Version (versionBranch)
36import Data.Version (versionBranch)
@@ -186,7 +186,7 @@ skip :: URL -> Maybe String -> Checker ()
186skip url maybeReason = do
186skip url maybeReason = do
187 logger <- checkerLogger <$> ask
187 logger <- checkerLogger <$> ask
188 case maybeReason of
188 case maybeReason of
189− Nothing -> return ()
189+ Nothing -> return ()
190 Just reason -> Logger.debug logger reason
190 Just reason -> Logger.debug logger reason
191 putCheckResult url mempty {checkerOk = 1}
191 putCheckResult url mempty {checkerOk = 1}
@@ -241,19 +241,14 @@ checkExternalUrl url = do
241 Left (SomeException e) ->
241 Left (SomeException e) ->
242 case (cast e :: Maybe SomeAsyncException) of
242 case (cast e :: Maybe SomeAsyncException) of
243 Just ae -> throw ae
243 Just ae -> throw ae
244− _ -> faulty url (Just $ showException e)
244+ _ -> faulty url (Just $ showException e)
245 Right _ -> ok url
245 Right _ -> ok url
247 -- Convert exception to a concise form
247 -- Convert exception to a concise form
248 showException e = case cast e of
248 showException e = case cast e of
249 Just (Http.HttpExceptionRequest _ e') -> show e'
249 Just (Http.HttpExceptionRequest _ e') -> show e'
250− _ -> head $ words $ show e
250+ _ -> head $ words $ show e
252−checkExternalUrl url = skip url Nothing
256−--------------------------------------------------------------------------------
257requestExternalUrl :: URL -> Checker (Either SomeException Bool)
252requestExternalUrl :: URL -> Checker (Either SomeException Bool)
258requestExternalUrl url = liftIO $ try $ do
253requestExternalUrl url = liftIO $ try $ do
259 mgr <- Http.newManager Http.tlsManagerSettings
254 mgr <- Http.newManager Http.tlsManagerSettings
@@ -273,6 +268,9 @@ requestExternalUrl url = liftIO $ try $ do
273 -- Nice user agent info
268 -- Nice user agent info
274 ua = fromString $ "hakyll-check/" ++
269 ua = fromString $ "hakyll-check/" ++
275 (intercalate "." $ map show $ versionBranch Paths_hakyll.version)
270 (intercalate "." $ map show $ versionBranch Paths_hakyll.version)
272+checkExternalUrl url = skip url Nothing
278--------------------------------------------------------------------------------
276--------------------------------------------------------------------------------