@@ -12,7 +12,7 @@ import Control.Monad.Trans (liftIO)
1212import Control.Monad.Writer (WriterT, runWriterT, tell)
1313import Data.List (isPrefixOf)
1414import Data.Monoid (Monoid (..))
15−import System.Directory (doesFileExist)
15+import System.Directory (doesDirectoryExist, doesFileExist)
1616import System.FilePath (takeDirectory, takeExtension, (</>))
1717import qualified Text.HTML.TagSoup as TS
1818
@@ -36,7 +36,7 @@ data CheckerRead = CheckerRead
3636data CheckerWrite = CheckerWrite
3737 { checkerFaulty :: Int
3838 , checkerOk :: Int
39− }
39+ } deriving (Show)
4040
4141
4242--------------------------------------------------------------------------------
@@ -55,7 +55,8 @@ runCheck :: Configuration -> IO ()
5555runCheck config = do
5656 logger <- Logger.new (verbosity config)
5757 let read' = CheckerRead config logger
58− ((), _write) <- runWriterT $ runReaderT check read'
58+ ((), write) <- runWriterT $ runReaderT check read'
59+ Logger.header logger $ show write
5960 Logger.flush logger
6061
6162
@@ -79,10 +80,15 @@ checkFile :: FilePath -> Checker ()
7980checkFile filePath = do
8081 logger <- checkerLogger <$> ask
8182 contents <- liftIO $ readFile filePath
82−
8383 Logger.header logger $ "Checking " ++ filePath
84+
8485 let tags = TS.parseTags contents
85− urls = filter (not . isExternal) $ getUrls tags
86+ -- Lots of logic here...
87+ urls = filter (not . null) $
88+ map stripFragments $
89+ filter (not . isExternal) $
90+ getUrls tags
91+
8692 mapM_ (checkUrl filePath) urls
8793
8894
@@ -98,9 +104,26 @@ checkUrl base url = do
98104 | "/" `isPrefixOf` url = dest ++ url
99105 | otherwise = dir </> url
100106
101− exists <- liftIO $ doesFileExist filePath
107+ exists <- checkFileExists filePath
102108 if exists
103109 then tell $ mempty {checkerOk = 1}
104110 else do
105111 tell $ mempty {checkerFaulty = 1}
106− Logger.error logger $ base ++ ": broken reference to " ++ url
112+ Logger.error logger $ base ++ ": broken reference to " ++ show url
113+
114+
115+--------------------------------------------------------------------------------
116+-- | Wraps doesFileExist, also checks for index.html
117+checkFileExists :: FilePath -> Checker Bool
118+checkFileExists filePath = liftIO $ do
119+ file <- doesFileExist filePath
120+ dir <- doesDirectoryExist filePath
121+ case (file, dir) of
122+ (True, _) -> return True
123+ (_, True) -> doesFileExist $ filePath </> "index.html"
124+ _ -> return False
125+
126+
127+--------------------------------------------------------------------------------
128+stripFragments :: String -> String
129+stripFragments = takeWhile (not . flip elem ['?', '#'])