{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Brok
( brok
) where
import ClassyPrelude
import Data.FileEmbed (embedFile)
import Data.Text.IO (hPutStrLn)
import System.Exit (exitFailure, exitSuccess)
import Data.Version (showVersion)
import Language.Haskell.TH.Syntax (liftString)
import qualified Paths_brok (version)
import Brok.IO.CLI (header, replace)
import Brok.IO.DB (getCached, setCached)
import Brok.IO.Document (readContent)
import Brok.IO.Http (mkManager)
import Brok.IO.Output (output)
import Brok.Options (parse)
import Brok.Types.Brok (Brok, appConfig, mkApp)
import qualified Brok.Types.Config as C (checkCerts, files, ignore, onlyFailures)
import Brok.Types.Document (cachedLinks, checkLinks, ignoredLinks, justLinks, parseLinks)
import Brok.Types.Link (getURL, isSuccess)
import Brok.Types.Next (Next (..))
go :: Brok ()
go = do
config <- asks appConfig
content <- traverse readContent (C.files config)
let parsed = parseLinks <$> content
cached <- getCached
let uncached = cachedLinks cached . ignoredLinks (C.ignore config) <$> parsed
header "Checking URLs"
putStrLn ""
checked <- checkLinks uncached
replace "Fetching complete"
putStrLn ""
header "Documents"
anyErrors <- output (C.onlyFailures config) checked
setCached $ getURL <$> filter isSuccess (concat (justLinks <$> checked))
lift $
if anyErrors
then void exitFailure
else void exitSuccess
putHelp :: IO ()
putHelp = putStr $ decodeUtf8 $(embedFile "template/usage.txt")
putVersion :: IO ()
putVersion = putStrLn $ "brök " <> $(liftString $ showVersion Paths_brok.version)
brok :: IO ()
brok = do
config <- parse <$> getArgs
case config of
Right (Continue cnf) -> do
manager <- mkManager (C.checkCerts cnf)
runReaderT go (mkApp cnf manager)
Right Help -> putHelp
Right Version -> putVersion
Left _ -> do
hPutStrLn stderr "Invalid format"
putHelp
void exitFailure