mbug 1.2 → 1.3
raw patch · 2 files changed
+146/−100 lines, 2 filesdep +mtlPVP ok
version bump matches the API change (PVP)
Dependencies added: mtl
API changes (from Hackage documentation)
Files
- mbug.cabal +80/−80
- src/MBug/Main.hs +66/−20
mbug.cabal view
@@ -1,88 +1,88 @@--- This file has been generated from package.yaml by hpack version 0.28.2.------ see: https://github.com/sol/hpack------ hash: b33e31546f0bfe98b914770fbdde88baf6e998a04048d923660069706267a9ea--name: mbug-version: 1.2-synopsis: download bugs mailboxes-description: See readme at https://gitlab.com/iu-guest/mbug-category: Debian-homepage: https://gitlab.com/iu-guest/mbug-author: Dmitry Bogatov-maintainer: KAction@gnu.org-copyright: 2018 Dmitry Bogatov-license: GPL-3-license-file: LICENSE-build-type: Simple-cabal-version: >= 1.10+cabal-version: >=1.10+name: mbug+version: 1.3+license: GPL-3+license-file: LICENSE+copyright: 2018 Dmitry Bogatov+maintainer: KAction@gnu.org+author: Dmitry Bogatov+homepage: https://gitlab.com/iu-guest/mbug+synopsis: download bugs mailboxes+description:+ See readme at https://gitlab.com/iu-guest/mbug+category: Debian+build-type: Simple extra-source-files: README.md flag devel- description: Enable -Werror GHC flag. Use only during development!- manual: True- default: False+ description:+ Enable -Werror GHC flag. Use only during development!+ default: False+ manual: True library- exposed-modules:- MBug.Main- MBug.Data.Bug- MBug.Data.FolderMH- MBug.Options- MBug.Scrape- MBug.Cache- MBug.MH- Data.Maybe.Extended- Text.HTML.Scalpel.Core.Extended- other-modules:- Data.Text.Compat- Options.Applicative.Compat- Paths_mbug- hs-source-dirs:- src- build-depends:- base >=4.9 && <5- , bytestring ==0.10.*- , directory ==1.3.*- , extra >=1.5 && <1.7- , formatting >=6.0 && <6.4- , http-client ==0.5.*- , http-client-tls ==0.3.*- , optparse-applicative >=0.13 && <0.15- , process >=1.4 && <1.7- , scalpel-core ==0.5.*- , tagsoup ==0.14.*- , text ==1.2.*- , time >=1.6 && <1.9- , xdg-basedir ==0.2.*- if flag(devel)- ghc-options: -Wall -Wextra -Werror -Wincomplete-patterns -Wunused-imports- default-language: Haskell2010+ exposed-modules:+ MBug.Main+ MBug.Data.Bug+ MBug.Data.FolderMH+ MBug.Options+ MBug.Scrape+ MBug.Cache+ MBug.MH+ Data.Maybe.Extended+ Text.HTML.Scalpel.Core.Extended+ hs-source-dirs: src+ other-modules:+ Data.Text.Compat+ Options.Applicative.Compat+ Paths_mbug+ default-language: Haskell2010+ build-depends:+ base >=4.9 && <5,+ bytestring ==0.10.*,+ directory ==1.3.*,+ extra >=1.5 && <1.7,+ formatting >=6.0 && <6.4,+ http-client ==0.5.*,+ http-client-tls ==0.3.*,+ mtl >=2.2.2 && <2.3,+ optparse-applicative >=0.13 && <0.15,+ process >=1.4 && <1.7,+ scalpel-core ==0.5.*,+ tagsoup ==0.14.*,+ text ==1.2.*,+ time >=1.6 && <1.9,+ xdg-basedir ==0.2.*+ + if flag(devel)+ ghc-options: -Wall -Wextra -Werror -Wincomplete-patterns+ -Wunused-imports executable mbug- main-is: mbug.hs- other-modules:- Paths_mbug- hs-source-dirs:- bin- build-depends:- base >=4.9 && <5- , bytestring ==0.10.*- , directory ==1.3.*- , extra >=1.5 && <1.7- , formatting >=6.0 && <6.4- , http-client ==0.5.*- , http-client-tls ==0.3.*- , mbug- , optparse-applicative >=0.13 && <0.15- , process >=1.4 && <1.7- , scalpel-core ==0.5.*- , tagsoup ==0.14.*- , text ==1.2.*- , time >=1.6 && <1.9- , xdg-basedir ==0.2.*- if flag(devel)- ghc-options: -Wall -Wextra -Werror -Wincomplete-patterns -Wunused-imports- default-language: Haskell2010+ main-is: mbug.hs+ hs-source-dirs: bin+ other-modules:+ Paths_mbug+ default-language: Haskell2010+ build-depends:+ base >=4.9 && <5,+ bytestring ==0.10.*,+ directory ==1.3.*,+ extra >=1.5 && <1.7,+ formatting >=6.0 && <6.4,+ http-client ==0.5.*,+ http-client-tls ==0.3.*,+ mbug -any,+ mtl >=2.2.2 && <2.3,+ optparse-applicative >=0.13 && <0.15,+ process >=1.4 && <1.7,+ scalpel-core ==0.5.*,+ tagsoup ==0.14.*,+ text ==1.2.*,+ time >=1.6 && <1.9,+ xdg-basedir ==0.2.*+ + if flag(devel)+ ghc-options: -Wall -Wextra -Werror -Wincomplete-patterns+ -Wunused-imports
src/MBug/Main.hs view
@@ -4,6 +4,8 @@ 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)@@ -11,6 +13,7 @@ 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)@@ -29,8 +32,9 @@ , removeDirectoryRecursive ) import System.Process (callProcess)-import Formatting (sformat, formatToString, (%))-import Formatting.Formatters (int, string)+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.@@ -58,27 +62,69 @@ -- | 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+downloadMBox :: Manager -> Int -> IO FilePath+downloadMBox manager nnn = fmap fst $ cachedIO label requested where- label = T.pack . show $ _number- requested = fmap responseBody $ httpLbs (mboxRequest _number) manager+ 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- 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 = formatToString (string%"/bug"%int) (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+ 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