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

-- | '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 = encodeUtf8 $ sformat ("bug="%int%";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 -> Int -> IO FilePath
downloadMBox manager nnn = fmap fst $ cachedIO label requested
  where
    label = T.pack . show $ nnn
    requested = fmap responseBody $ httpLbs (mboxRequest nnn) manager

-- | Dowload mailbox, corresponding to bug of given name and
-- incorporate it into specified folder in MH storage.
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

-- | Return list of 'Bug's, matching specified search query.
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

-- | Remove MH folder and all its subfolders. Unfortunately, rmf(1)
-- utility is not designed to handle this case, so this function is
-- implemented by manipulating file system directory directly, beyond
-- mh(7) toolkit.
cleanFolderMH :: (MonadIO m) => FolderMH -> m ()
cleanFolderMH folder = liftIO $ do
  path <- MH.resolve folder
  whenM (doesDirectoryExist path) $
    removeDirectoryRecursive path

-- | Incorporate specified 'Bug' with fancy visual clues on stdout.
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