--------------------------------------------------------------------------------
{-# 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
import           Network.URI                  (unEscapeString)
import           System.Directory             (doesDirectoryExist,
                                               doesFileExist)
import           System.Exit                  (ExitCode (..))
import           System.FilePath              (takeDirectory, (</>))
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
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
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
Ord, Int -> Check -> ShowS
[Check] -> ShowS
Check -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Check] -> ShowS
$cshowList :: [Check] -> ShowS
show :: Check -> [Char]
$cshow :: Check -> [Char]
showsPrec :: Int -> Check -> ShowS
$cshowsPrec :: Int -> Check -> ShowS
Show)


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


--------------------------------------------------------------------------------
countFailedLinks :: CheckerState -> IO Int
countFailedLinks :: CheckerState -> IO Int
countFailedLinks CheckerState
state = 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 Int
0 (forall k a. Map k a -> [a]
Map.elems CheckerState
state)
    where addIfFailure :: Int -> MVar CheckerWrite -> IO Int
addIfFailure Int
failures MVar CheckerWrite
mvar = do
              CheckerWrite
checkerWrite <- forall a. MVar a -> IO a
readMVar MVar CheckerWrite
mvar
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
failures 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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CheckerWrite] -> ShowS
$cshowList :: [CheckerWrite] -> ShowS
show :: CheckerWrite -> [Char]
$cshow :: CheckerWrite -> [Char]
showsPrec :: Int -> CheckerWrite -> ShowS
$cshowsPrec :: Int -> CheckerWrite -> ShowS
Show)


--------------------------------------------------------------------------------
instance Semigroup CheckerWrite where
    <> :: CheckerWrite -> CheckerWrite -> CheckerWrite
(<>) (CheckerWrite Int
f1 Int
o1) (CheckerWrite Int
f2 Int
o2) =
        Int -> Int -> CheckerWrite
CheckerWrite (Int
f1 forall a. Num a => a -> a -> a
+ Int
f2) (Int
o1 forall a. Num a => a -> a -> a
+ Int
o2)

instance Monoid CheckerWrite where
    mempty :: CheckerWrite
mempty  = Int -> Int -> CheckerWrite
CheckerWrite Int
0 Int
0
    mappend :: CheckerWrite -> CheckerWrite -> CheckerWrite
mappend = forall a. Semigroup a => a -> a -> a
(<>)


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


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

    let htmls :: [[Char]]
htmls =
            [ Configuration -> [Char]
destinationDirectory Configuration
config [Char] -> ShowS
</> [Char]
file
            | [Char]
file <- [[Char]]
files
            , Configuration -> [Char] -> Bool
checkHtmlFile Configuration
config [Char]
file
            ]

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


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

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


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


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


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


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


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


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


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

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


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

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

        -- Nice user agent info
        ua :: ByteString
ua = forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"hakyll-check/" forall a. [a] -> [a] -> [a]
++
             (forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show 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 :: [Char] -> ReaderT CheckerRead (StateT CheckerState IO) Bool
checkFileExists [Char]
filePath = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Bool
file <- [Char] -> IO Bool
doesFileExist [Char]
filePath
    Bool
dir  <- [Char] -> IO Bool
doesDirectoryExist [Char]
filePath
    case (Bool
file, Bool
dir) of
        (Bool
True, Bool
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        (Bool
_, Bool
True) -> [Char] -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ [Char]
filePath [Char] -> ShowS
</> [Char]
"index.html"
        (Bool, Bool)
_         -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False


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