arch-hs 0.6.1.0 → 0.6.2.0

raw patch · 9 files changed

+57/−47 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• app/Main.hs +15/−15
• arch-hs.cabal +1/−1
• diff/Diff.hs +2/−2
• diff/Main.hs +3/−4
• src/Distribution/ArchHs/Exception.hs +3/−4
• src/Distribution/ArchHs/PP.hs +17/−8
• submit/Main.hs +7/−10
• submit/Submit.hs +3/−3

@@ -3,6 +3,12 @@ `arch-hs` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.6.2.0++* Use `Doc` to print prompt messages++* Fix wrong line feeds in `arch-hs-diff`+ ## 0.6.1.0  * Show dependens and makedepends in `arch-hs-diff` even if there is no difference between two target versions

@@ -53,14 +53,14 @@    when inCommunity $     if force-      then printWarn "Target has been provided by [community], ignoring it"+      then printWarn $ "Target has been provided by" <+> ppCommunity <> comma <+> "but you passed --force"       else throw $ TargetExist target ByCommunity    when aurSupport $ do     inAur <- isInAur target     when inAur $       if force-        then printWarn "Target has been provided by [aur], ignoring it"+        then printWarn $ "Target has been provided by" <+> ppAur <> comma <+> "but you passed --force"         else throw $ TargetExist target ByAur    let removeSublibs pkgs =@@ -81,7 +81,7 @@    embed $     forM_ abnormalDependencies $ \(T.pack . unPackageName -> parent, childs) -> do-      printWarn $ "Package \"" <> parent <> "\" is provided without:"+      printWarn $ "Package" <+> dquotes (pretty parent) <+> "is provided without" <> colon       forM_ childs $ putStrLn . unPackageName    let fillProvidedPkgs provideList provider = map (\x -> if (x ^. pkgName) `elem` provideList then ProvidedPackage (x ^. pkgName) provider else x)@@ -92,7 +92,7 @@     when aurSupport $ printInfo "Start searching AUR..."     aurProvideList <-       if aurSupport-        then filterM (\n -> do printInfo ("Searching " <> T.pack (unPackageName n)); isInAur n) $ filter (\x -> not $ x == target && force) $ toBePacked1 ^.. each . pkgName+        then filterM (\n -> do printInfo ("Searching" <+> viaPretty n); isInAur n) $ filter (\x -> not $ x == target && force) $ toBePacked1 ^.. each . pkgName         else return []     let a = fillProvidedPkgs aurProvideList ByAur . fillProvidedDeps aurProvideList ByAur $ filledByCommunity         b = a ^.. each . filtered (not . isProvided)@@ -164,7 +164,7 @@           embed $ do             createDirectoryIfMissing True dir             writeFile fileName txt-            printInfo $ "Write file: " <> T.pack fileName+            printInfo $ "Write file" <> colon <+> pretty fileName       )       toBePacked2 @@ -192,7 +192,7 @@     embed $ do       createDirectoryIfMissing True dir       writeFile fileName (T.unpack txt)-      printInfo $ "Write file: " <> T.pack fileName+      printInfo $ "Write file" <> colon <+> pretty fileName  ----------------------------------------------------------------------------- data EmergedSysDep = Solved File ArchLinuxName | Unsolved File@@ -258,7 +258,7 @@     Options {..} <- runArgsParser      unless (null optFileTrace) $ do-      printInfo $ "Trace will be dumped to " <> T.pack optFileTrace <> "."+      printInfo $ "Trace will be dumped to" <+> pretty optFileTrace       writeFile optFileTrace ""      let isFlagEmpty = Map.null optFlags@@ -272,20 +272,20 @@       printInfo "You chose to skip:"       putDoc $ prettySkip optSkip <> line <> line -    when optAur $ printInfo "You passed -a, searching AUR may takes a long time."+    when optAur $ printInfo "You passed -a, searching AUR may takes a long time" -    when optUusi $ printInfo "You passed --uusi, uusi will become makedepends of each package."+    when optUusi $ printInfo "You passed --uusi, uusi will become makedepends of each package"      hackagePath <- if null optHackagePath then lookupHackagePath else return optHackagePath -    printInfo $ "Loading hackage from " <> T.pack hackagePath+    printInfo $ "Loading hackage from" <+> pretty hackagePath      hackage <- loadHackageDB hackagePath      let isExtraEmpty = null optExtraCabalPath      unless isExtraEmpty $-      printInfo $ "You added " <> (T.pack . intercalate ", " $ map takeFileName optExtraCabalPath) <> " as extra cabal file(s), starting parsing right now."+      printInfo $ "You added" <+> hsep (punctuate comma $ pretty . takeFileName <$> optExtraCabalPath) <+> "as extra cabal file(s), starting parsing right now"      parsedExtra <- mapM parseCabalFile optExtraCabalPath @@ -293,10 +293,10 @@  #ifdef ALPM     let src = T.pack $ if optAlpm then "libalpm" else defaultCommunityDBPath-    printInfo $ "Loading community.db from " <> src+    printInfo $ "Loading community.db from " <> pretty src     community <- if optAlpm then loadCommunityDBFFI else loadCommunityDB defaultCommunityDBPath #else-    printInfo $ "Loading community.db from " <> T.pack optCommunityDBPath+    printInfo $ "Loading community.db from" <+> pretty optCommunityDBPath     community <- loadCommunityDB optCommunityDBPath #endif @@ -306,10 +306,10 @@      let loadF db = do #ifdef ALPM-          printInfo $ "Loading " <> T.pack (show db) <>" files from libalpm..."+          printInfo $ "Loading" <+> ppDBKind db <+> "files from libalpm"           if optAlpm then loadFilesDBFFI db else loadFilesDB db defaultFilesDBDir #else-          printInfo $ "Loading " <> T.pack (show db) <>" files from " <> T.pack optFilesDBPath <> "..."+          printInfo $ "Loading" <+> ppDBKind db <+> "files from" <+> pretty optFilesDBPath           loadFilesDB db optFilesDBPath  #endif

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               arch-hs-version:            0.6.1.0+version:            0.6.2.0 synopsis:           Distribute hackage packages to archlinux description:   @arch-hs@ is a command-line program, which simplifies the process of producing

@@ -135,7 +135,7 @@   let urlPath = T.pack $ unPackageName name <> "-" <> prettyShow version       api = https "hackage.haskell.org" /: "package" /: urlPath /: "revision" /: "0.cabal"       r = req GET api NoReqBody bsResponse mempty-  printInfo $ "Downloading cabal file from " <> renderUrl api <> "..."+  printInfo $ "Downloading cabal file from" <+> pretty (renderUrl api)   response <- interceptHttpException (runReq defaultHttpConfig r)   case parseGenericPackageDescriptionMaybe $ responseBody response of     Just x -> return x@@ -244,7 +244,7 @@    new <- fmap (pp True) <$> mapM inRange diffNew   old <- fmap (pp False) <$> mapM inRange diffOld-  return $ hsep [hsep old, hsep new]+  return $ hsep [cat old, cat new]  dep :: Doc AnsiStyle -> VersionedList -> VersionedList -> Doc AnsiStyle dep s va vb =

@@ -6,7 +6,6 @@  import Control.Monad (unless) import qualified Data.Map as Map-import qualified Data.Text as T import Data.Text.Prettyprint.Doc.Render.Terminal import Diff import Distribution.ArchHs.CommunityDB@@ -26,11 +25,11 @@       putDoc $ prettyFlagAssignments optFlags <> line  #ifdef ALPM-    let src = T.pack $ if optAlpm then "libalpm" else defaultCommunityDBPath-    printInfo $ "Loading community.db from " <> src+    let src = if optAlpm then "libalpm" else defaultCommunityDBPath+    printInfo $ "Loading community.db from" <+> pretty src     community <- if optAlpm then loadCommunityDBFFI else loadCommunityDB defaultCommunityDBPath #else-    printInfo $ "Loading community.db from " <> T.pack optCommunityDBPath+    printInfo $ "Loading community.db from" <+> pretty optCommunityDBPath     community <- loadCommunityDB optCommunityDBPath #endif 

@@ -20,10 +20,9 @@ where  import qualified Control.Exception as CE-import qualified Data.Text as T import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.Name-import Distribution.ArchHs.PP (printError, printSuccess)+import Distribution.ArchHs.PP (colon, printError, printSuccess, viaShow, (<+>)) import Distribution.ArchHs.Types import Network.HTTP.Req (HttpException (..)) @@ -50,13 +49,13 @@  -- | Catch 'CE.IOException' and print it. printHandledIOException :: IO () -> IO ()-printHandledIOException = CE.handle @CE.IOException (\e -> printError $ "IOException: " <> (T.pack . show $ e))+printHandledIOException = CE.handle @CE.IOException (\e -> printError $ "IOException" <> colon <+> viaShow e)  -- | Print the result of 'errorToIOFinal'. printAppResult :: IO (Either MyException ()) -> IO () printAppResult io =   io >>= \case-    Left x -> printError $ "Runtime Exception: " <> (T.pack . show $ x)+    Left x -> printError $ "Runtime Exception" <> colon <+> viaShow x     _ -> printSuccess "Success!"  -- | Catch the 'HttpException' thrown in 'IO' monad, then re-throw it with 'NetworkException'.

@@ -20,6 +20,8 @@     dui,     cuo,     ppCommunity,+    ppAur,+    ppDBKind,     annYellow,     annGreen,     annMagneta,@@ -44,6 +46,7 @@ import Data.Algorithm.Diff import qualified Data.Map.Strict as Map import qualified Data.Text as T+import Distribution.ArchHs.FilesDB (DBKind) import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.Types import qualified Distribution.Pretty as DPretty@@ -159,17 +162,23 @@ ppFromTo :: Int -> Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle ppFromTo i a b = a <> hcat (replicate i space) <> "⇒" <> hcat (replicate i space) <> b -printInfo :: (MonadIO m) => T.Text -> m ()-printInfo msg = liftIO . putDoc . annBlue $ "ⓘ" <+> pretty msg <> line+printInfo :: (MonadIO m) => Doc AnsiStyle -> m ()+printInfo msg = liftIO . putDoc . annBlue $ "ⓘ" <+> msg <> line  ppCommunity :: Doc AnsiStyle ppCommunity = annCyan $ viaShow ByCommunity -printWarn :: (MonadIO m) => T.Text -> m ()-printWarn msg = liftIO . putDoc . annYellow $ "⚠" <+> pretty msg <> line+ppDBKind :: DBKind -> Doc AnsiStyle+ppDBKind x = annCyan . brackets $ viaShow x -printError :: (MonadIO m) => T.Text -> m ()-printError msg = liftIO . putDoc . annYellow $ "🛑" <+> pretty msg <> line+ppAur :: Doc AnsiStyle+ppAur = annCyan $ viaShow ByAur -printSuccess :: (MonadIO m) => T.Text -> m ()-printSuccess msg = liftIO . putDoc . annGreen $ dui <+> pretty msg <> line+printWarn :: (MonadIO m) => Doc AnsiStyle -> m ()+printWarn msg = liftIO . putDoc . annYellow $ "⚠" <+> msg <> line++printError :: (MonadIO m) => Doc AnsiStyle -> m ()+printError msg = liftIO . putDoc . annRed $ "🛑" <+> msg <> line++printSuccess :: (MonadIO m) => Doc AnsiStyle -> m ()+printSuccess msg = liftIO . putDoc . annGreen $ dui <+> msg <> line

@@ -5,7 +5,6 @@ module Main (main) where  import Control.Monad (unless)-import qualified Data.Text as T import Distribution.ArchHs.CommunityDB import Distribution.ArchHs.Exception import Distribution.ArchHs.Hackage@@ -28,28 +27,26 @@      let hasOutput = not $ null optOutput     when hasOutput $ do-      printInfo $ "Output will be dumped to " <> T.pack optOutput <> "."+      printInfo $ "Output will be dumped to" <+> pretty optOutput       exist <- doesFileExist optOutput       when exist $-        printWarn $ "File " <> T.pack optOutput <> " already existed, overwrite it."+        printWarn $ "File" <+> pretty optOutput <+> "already existed" <+> "overwrite it"     printInfo "Start running..."     unless (optUpload || hasOutput) $-      printWarn "Run diff and check only."+      printWarn "Run diff and check only"  #ifdef ALPM-    let src = T.pack $ if optAlpm then "libalpm" else defaultCommunityDBPath-    printInfo $ "Loading community.db from " <> src+    let src = if optAlpm then "libalpm" else defaultCommunityDBPath+    printInfo $ "Loading community.db from" <+> pretty src     community <- if optAlpm then loadCommunityDBFFI else loadCommunityDB defaultCommunityDBPath #else-    printInfo $ "Loading community.db from " <> T.pack optCommunityDBPath+    printInfo $ "Loading community.db from" <+> pretty optCommunityDBPath     community <- loadCommunityDB optCommunityDBPath #endif -    printInfo "Loading community.db..."-     hackagePath <- if null optHackagePath then lookupHackagePath else return optHackagePath -    printInfo $ "Loading hackage from " <> T.pack hackagePath+    printInfo $ "Loading hackage from" <+> pretty hackagePath      hackage <- loadHackageDB hackagePath 

@@ -144,7 +144,7 @@   let v = renderDistroCSV csv   embed $     unless (null output) $ do-      printInfo $ "Write file: " <> T.pack output+      printInfo $ "Write file" <> colon <+> pretty output       writeFile output v   check csv   interceptHttpException $@@ -155,8 +155,8 @@             req PUT api (ReqBodyBs . BS.pack $ v) bsResponse $               header "Authorization" (BS.pack $ "X-ApiKey " <> fromJust token) <> header "Content-Type" "text/csv"       result <- runReq defaultHttpConfig r-      printInfo $ "StatusCode: " <> (T.pack . show $ responseStatusCode result)-      printInfo $ "ResponseMessage: " <> decodeUtf8 (responseStatusMessage result)+      printInfo $ "StatusCode" <> colon <+> pretty (responseStatusCode result)+      printInfo $ "ResponseMessage" <> colon <+> pretty (decodeUtf8 (responseStatusMessage result))       printInfo "ResponseBody:"       putStrLn . BS.unpack $ responseBody result