{-# 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)

-- | 'Request' value, representing Debian Bugs System. Adjust 'path' and
-- 'query' as needed.
debbugsRequest :: Request
debbugsRequest = parseRequest_ "https://bugs.debian.org"

-- | Request to download mbox of bug with given number.
mboxRequest :: Int -> Request
mboxRequest n = debbugsRequest
  { path        = "cgi-bin/bugreport.cgi"
  , queryString = [sb|bug=%d;mbox=yes|] n
  }

-- | Get cached response from @https://bugs.debian.org/<query>@. Cache
-- is assumed to stale 15 minutes after.
--
-- This could result to missing bugs, but greatly improve user
-- experience, eliminating the slowest code path -- network. Even if
-- user's network connection is very fast, BTS still takes seconds to
-- respond.
cachedResponse :: Manager -> Text -> IO BL.ByteString
cachedResponse manager query = cachedIO_ query $ do
  let request = debbugsRequest { path = encodeUtf8 query }
  fmap responseBody $ httpLbs request manager

-- | Download mbox of given bug, store it in file and return path to
-- that file.
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