module Lib
( Mode(Standard, DryRun, FormatterTest)
, Format(Classic, OneLine, Raw)
, run
)
where
import Codec.Binary.UTF8.String (decodeString)
import Control.Monad (filterM, forM, forM_, when)
import Data.Aeson (decode)
import qualified Data.ByteString.Lazy.Char8 as L8
import Service.HtmlChecker.Client (checkHtml)
import Service.HtmlChecker.Response (ValidationResult, countErrors,
decodeResult, getMessages,
showMessage)
import System.Console.ANSI (hSupportsANSI)
import System.Directory (doesDirectoryExist,
doesFileExist, doesPathExist)
import System.FilePath.Finder (findFiles)
import System.IO (hPutStrLn, stderr, stdout)
data Mode = Standard | DryRun | FormatterTest
data Format = Classic | OneLine | Raw deriving (Eq)
run :: Mode -> Format -> Bool -> String -> [String] -> [FilePath] -> IO Int
run mode format isVerbose validatorUrl excludedDirs paths = do
debugLog isVerbose "validator" validatorUrl
files <- findHtmlFiles excludedDirs paths
when (null files) (errorWithoutStackTrace $ "HTML files not found")
case mode of
DryRun -> do
mapM_ putStrLn files
return 0
_ -> do
errorCounts <- forM files $ \file -> do
debugLog isVerbose "file" file
jsonResponse <- case mode of
FormatterTest -> L8.readFile file
_ -> checkHtml validatorUrl file
debugLog isVerbose "response" $ byteStringToString jsonResponse
case format of
Raw -> do
putStrLn $ byteStringToString jsonResponse
return 0
_ -> do
let prefix =
if paths == [file] then "" else file ++ ": "
let validationResult = decodeResult jsonResponse
printResult format prefix validationResult
return $ countErrors validationResult
return $ sum errorCounts
printResult :: Format -> String -> Maybe ValidationResult -> IO ()
printResult format prefix (Just result) = do
let isOneLine = format == OneLine
isColored <- hSupportsANSI stdout
forM_ (getMessages result)
$ \msg -> putStrLn $ prefix ++ showMessage isOneLine isColored msg
printResult _ prefix Nothing = putStrLn $ prefix ++ "Couldn't parse response."
byteStringToString :: L8.ByteString -> String
byteStringToString = decodeString . L8.unpack
findHtmlFiles :: [String] -> [FilePath] -> IO [FilePath]
findHtmlFiles excludedDirs paths = do
forM_ paths $ \path -> do
found <- doesPathExist path
when
(not found)
(errorWithoutStackTrace $ path ++ ": No such file or directory")
files <- filterM doesFileExist paths
dirs <- filterM doesDirectoryExist paths
filesInDirs <- mapM (findFiles [".html", ".htm"] excludedDirs) dirs
return $ concat (files : filesInDirs)
debugLog :: Bool -> String -> String -> IO ()
debugLog isDebug name value = if isDebug
then hPutStrLn stderr $ "* " ++ name ++ ": " ++ value
else return ()