{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module MBug.Main (main) where
import Control.Monad (mapM, mapM_, (>=>))
import Control.Monad.Reader (ReaderT, runReaderT, ask)
import Control.Monad.IO.Class (MonadIO, liftIO)
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 MBug.Data.FolderMH (FolderMH(..))
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.Read (readMaybe)
import Formatting (fprint, sformat, formatToString, (%))
import Formatting.Formatters (int, string, stext)
debbugsRequest :: Request
debbugsRequest = parseRequest_ "https://bugs.debian.org"
mboxRequest :: Int -> Request
mboxRequest n = debbugsRequest
{ path = "cgi-bin/bugreport.cgi"
, queryString = encodeUtf8 $ sformat ("bug="%int%";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 -> Int -> IO FilePath
downloadMBox manager nnn = fmap fst $ cachedIO label requested
where
label = T.pack . show $ nnn
requested = fmap responseBody $ httpLbs (mboxRequest nnn) manager
incorporate :: FolderMH -> Int -> ReaderT Manager IO ()
incorporate folder nnn = do
manager <- ask
liftIO $ do
let fmt = string % "/bug" % int
folder' = showFolderMH folder
destination = formatToString fmt folder' nnn
mbox <- downloadMBox manager nnn
let args = ["-silent", "-file", mbox, destination]
callProcess "/usr/bin/mh/inc" args
listBugs :: Text -> ReaderT Manager IO [Bug]
listBugs q = do
manager <- ask
liftIO $ act =<< (parseBugs <$> cachedResponse manager q)
where
act = \case
Nothing -> error "please report to maintainer how to reproduce it."
Just x -> pure x
cleanFolderMH :: (MonadIO m) => FolderMH -> m ()
cleanFolderMH folder = liftIO $ do
path <- MH.resolve folder
whenM (doesDirectoryExist path) $
removeDirectoryRecursive path
incorporateBug :: FolderMH -> Bug -> ReaderT Manager IO ()
incorporateBug folder Bug{..} = do
let fmt = "[#" % int % "] " % stext % "... "
before = fprint fmt _number _subject
after = fprint "ok\n"
liftIO before
incorporate folder _number
liftIO after
main :: IO ()
main = do
Options {..} <- options
manager <- newTlsManager
flip runReaderT manager $
case readMaybe (T.unpack _query) of
Just nnn -> do
liftIO $ fprint ("Incorporating #" % int % "... ") nnn
cleanFolderMH _folder
incorporate _folder nnn
liftIO $ fprint "ok\n"
Nothing ->
listBugs _query >>= \case
[] -> liftIO $ putStrLn "no bugs found. Nothing to do."
bugs -> do
cleanFolderMH _folder
mapM_ (incorporateBug _folder) bugs