{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
module MBug.Main (main) where
import Control.Monad (mapM, mapM_, (>=>))
import Control.Monad.Extra (whenM)
import qualified Data.ByteString.Lazy as BL
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import MBug.Cache (cachedIO, cachedIO_)
import MBug.Data.Bug (Bug (..))
import qualified MBug.MH as MH
import MBug.Options (Options (..), options, showFolderMH)
import MBug.Scrape (parseBugs)
import Network.HTTP.Client
( Manager
, Request
, httpLbs
, parseRequest_
, path
, queryString
, responseBody
)
import Network.HTTP.Client.TLS (newTlsManager)
import System.Directory
( doesDirectoryExist
, removeDirectoryRecursive
)
import System.Process (callProcess)
import Text.Printf.TH (s, sb)
debbugsRequest :: Request
debbugsRequest = parseRequest_ "https://bugs.debian.org"
mboxRequest :: Int -> Request
mboxRequest n = debbugsRequest
{ path = "cgi-bin/bugreport.cgi"
, queryString = [sb|bug=%d;mbox=yes|] n
}
cachedResponse :: Manager -> Text -> IO BL.ByteString
cachedResponse manager query = cachedIO_ query $ do
let request = debbugsRequest { path = encodeUtf8 query }
fmap responseBody $ httpLbs request manager
downloadMBox :: Manager -> Bug -> IO FilePath
downloadMBox manager (Bug {..}) = fmap fst $ cachedIO label requested
where
label = T.pack . show $ _number
requested = fmap responseBody $ httpLbs (mboxRequest _number) manager
main :: IO ()
main = do
Options {..} <- options
manager <- newTlsManager
response <- cachedResponse manager _query
case parseBugs response of
Nothing -> putStrLn "error! please report to maintainer how to reproduce it."
Just [] -> putStrLn "no bugs found. Nothing to do."
Just bugs -> do
let download bug = do mbox <- downloadMBox manager bug
pure (bug, mbox)
incorporate (Bug {..}, mbox) =
let destination = [s|%s/bug%d|] (showFolderMH _folder) _number
in callProcess "/usr/bin/mh/inc"
["-silent", "-file", mbox, destination]
MH.resolve _folder >>= \path -> whenM (doesDirectoryExist path)
(removeDirectoryRecursive path)
(mapM download >=> mapM_ incorporate) bugs