arch-hs 0.9.1.0 → 0.10.0.0

raw patch · 17 files changed

+151/−87 lines, 17 filesdep ~algebraic-graphsdep ~megaparsecPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: algebraic-graphs, megaparsec

API changes (from Hackage documentation)

Files

• CHANGELOG.md +16/−0
• README.md +9/−1
• app/Args.hs +9/−6
• app/Main.hs +44/−33
• arch-hs.cabal +4/−4
• data/NAME_PRESET.json +2/−0
• src/Distribution/ArchHs/FilesDB.hs +2/−1
• src/Distribution/ArchHs/Local.hs +0/−1
• src/Distribution/ArchHs/Name.hs +1/−2
• src/Distribution/ArchHs/PP.hs +14/−2
• src/Distribution/ArchHs/PkgBuild.hs +0/−19
• src/Distribution/ArchHs/Utils.hs +2/−2
• sync/Args.hs +21/−1
• sync/Check.hs +14/−12
• sync/Main.hs +11/−1
• sync/Submit.hs +1/−1
• sync/Utils.hs +1/−1

@@ -3,6 +3,22 @@ `arch-hs` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.10.0.0++* Add `arch-hs-sync list` to list Haskell packages in [community]++* Remove generating meta package++* Add `--install-deps` to call pacman to install all dependencies of a target++* Fix the list of packages to be packed is not consistent++* Add `--no-skip-missing` to consider abnormal dependencies in packaging++* Update dependency versions++* Update name preset+ ## 0.9.1.0  * Support Cabal 3.4

@@ -285,7 +285,7 @@ including renaming, matching license, and filling out dependencies etc. However, packaging haven't been done so far. `arch-hs` can't guarantee that this package can be built by ghc with the latest dependencies;-hence some patchs may be required in `prepare()`, such as [uusi](#Uusi).+hence some patches may be required in `prepare()`, such as [uusi](#Uusi).   ## Options@@ -388,6 +388,14 @@   * recommended package order   * system dependencies   * flags++### No skip missing++```+$ arch-hs --no-skip-missing TARGET+```++With `--no-skip-missing`, `arch-hs` will try to package if the dependent of this package exist whereas this package does not.  ## [Name preset](https://github.com/berberman/arch-hs/blob/master/data/NAME_PRESET.json) 

@@ -25,8 +25,9 @@     optFileTrace :: FilePath,     optUusi :: Bool,     optForce :: Bool,-    optMetaDir :: FilePath,+    optInstallDeps :: Bool,     optJson :: FilePath,+    optNoSkipMissing :: Bool,     optTarget :: PackageName   } @@ -83,17 +84,19 @@         ( long "force"             <> help "Try to package even if target is provided"         )-      <*> strOption-        ( long "meta"-            <> metavar "PATH"-            <> help "Path to target meta package"-            <> value ""+      <*> switch+        ( long "install-deps"+            <> help "Call pacman to install existing dependencies of the target"         )       <*> strOption         ( long "json"             <> metavar "PATH"             <> help "Path to json output (empty means do not write output as json to file)"             <> value ""+        )+      <*> switch+        ( long "no-skip-missing"+            <> help "Try to package if the dependent of this package exist whereas this package does not"         )       <*> argument optPackageNameReader (metavar "TARGET") 

@@ -12,6 +12,7 @@ import Control.Monad (filterM, forM_, unless) import qualified Data.Aeson as A import qualified Data.ByteString.Lazy as LBS+import Data.Conduit.Process (system) import Data.Containers.ListUtils (nubOrd) import Data.IORef (IORef, modifyIORef', newIORef, readIORef) import Data.List.NonEmpty (toList)@@ -39,6 +40,7 @@ import Network.HTTP.Client (Manager) import Network.HTTP.Client.TLS (newTlsManager) import System.Directory (createDirectoryIfMissing)+import System.Exit (ExitCode (ExitFailure, ExitSuccess)) import System.FilePath (takeFileName)  app ::@@ -49,25 +51,26 @@   [String] ->   Bool ->   Bool ->-  FilePath ->+  Bool ->   FilePath ->+  Bool ->   (DBKind -> IO FilesDB) ->   Sem r ()-app target path aurSupport skip uusi force metaPath jsonPath loadFilesDB' = do+app target path aurSupport skip uusi force installDeps jsonPath noSkipMissing loadFilesDB' = do   (deps, sublibs, sysDeps) <- getDependencies (fmap mkUnqualComponentName skip) Nothing target    inCommunity <- isInCommunity target    when inCommunity $     if force-      then printWarn $ "Target has been provided by" <+> ppCommunity <> comma <+> "but you passed --force"+      then printWarn $ "Target has been provided by" <+> ppCommunity <> comma <+> "but you specified --force"       else throw $ TargetExist target ByCommunity    when aurSupport $ do     inAur <- isInAur target     when inAur $       if force-        then printWarn $ "Target has been provided by" <+> ppAur <> comma <+> "but you passed --force"+        then printWarn $ "Target has been provided by" <+> ppAur <> comma <+> "but you specified --force"         else throw $ TargetExist target ByAur    let removeSublibs pkgs =@@ -93,15 +96,21 @@       printWarn $ "Package" <+> dquotes (pretty parent) <+> "is provided without" <> colon       forM_ children $ putStrLn . unPackageName +  unless (null abnormalDependencies || noSkipMissing) $+    printWarn "Those package(s) are ignored unless you specify --no-skip-missing"+   let fillProvidedPkgs provideList provider = map (\x -> if (x ^. pkgName) `elem` provideList then ProvidedPackage (x ^. pkgName) provider else x)       fillProvidedDeps provideList provider = map (pkgDeps %~ each %~ (\y -> if y ^. depName `elem` provideList then y & depProvider ?~ provider else y))       filledByCommunity = fillProvidedPkgs communityProvideList ByCommunity . fillProvidedDeps communityProvideList ByCommunity $ grouped+      -- after filling community       toBePacked1 = filledByCommunity ^.. each . filtered (not . isProvided)+   (filledByBoth, toBePacked2) <- do     when aurSupport $ printInfo "Start searching AUR..."     aurProvideList <-       if aurSupport-        then filterM (\n -> do printInfo ("Searching" <+> viaPretty n); isInAur n) $ filter (\x -> not $ x == target && force) $ toBePacked1 ^.. each . pkgName+        then -- after filling aur. toBePacked1 should not appear after the next line+          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)@@ -114,16 +123,24 @@   embed $ T.putStrLn . prettySolvedPkgs $ filledByBoth    printInfo "Recommended package order:"-  -- remove missingChildren from the graph, so that we don't need package them if they are not our target-  let vertexesToBeRemoved = missingChildren <> filledByBoth ^.. each . filtered isProvided ^.. each . pkgName+  -- remove missingChildren from the graph iff noSkipMissing is not enabled+  let vertexesToBeRemoved = (if noSkipMissing then [] else missingChildren) <> filledByBoth ^.. each . filtered isProvided ^.. each . pkgName       removeSelfCycle g = foldr (\n acc -> GL.removeEdge n n acc) g $ toBePacked2 ^.. each . pkgName       newGraph = GL.induce (`notElem` vertexesToBeRemoved) deps   flattened <- case G.topSort . GL.skeleton $ removeSelfCycle newGraph of     Left c -> throw . CyclicExist $ toList c     Right x -> return $ filter (`notElem` sublibs) x -  embed . putDoc $ (prettyDeps . reverse $ flattened) <> line <> line+  -- after removing missing children+  -- toBePacked1 and toBePacked2 should appear after the next line+  let toBePacked3 = filter (\x -> x ^. pkgName `elem` flattened) toBePacked2 +  -- add sign for missing children if we have+  embed . putDoc $ (prettyDeps . reverse $ map (\x -> (x, x `elem` missingChildren)) flattened) <> line <> line++  unless (null missingChildren) $+    embed . putDoc $ annotate italicized $ yellowStarInParens <+> "indicates a missing package" <> line <> line+   let sysDepsToBePacked = Map.filterWithKey (\k _ -> k `elem` flattened) sysDeps    unless (null sysDepsToBePacked) $ do@@ -189,33 +206,27 @@             writeFile fileName txt             printInfo $ "Write file" <> colon <+> pretty fileName       )-      toBePacked2+      toBePacked3 -  unless (null metaPath) $ do-    cabal <- getLatestCabal target-    let url = getUrl $ packageDescription cabal-        name = unPackageName target-        template = N.metaTemplate (T.pack url) (T.pack name)-        providedDepends pkg =+  when installDeps $ do+    let providedDepends pkg =           pkg ^. pkgDeps             ^.. each               . filtered (\x -> depNotMyself (pkg ^. pkgName) x && depNotInGHCLib x && x ^. depProvider == Just ByCommunity)-        toStr x = "'" <> (unArchLinuxName . toArchLinuxName . _depName) x <> "'"-        depends = case unwords . nubOrd . fmap toStr . mconcat $ providedDepends <$> toBePacked2 of-          [] -> ""-          xs -> " " <> xs+        toStr = unArchLinuxName . toArchLinuxName . _depName+        depends = unwords . nubOrd . fmap toStr . mconcat $ providedDepends <$> toBePacked3         flattened' = filter (/= target) flattened-        comment = case flattened' of-          [] -> "\n"-          [x] -> "# The following dependency is missing in community: " <> unPackageName x-          _ -> "# Following dependencies are missing in community:" <> intercalate ", " (unPackageName <$> flattened')-        txt = template (T.pack comment) (T.pack depends)-        dir = metaPath </> "haskell-" <> name <> "-meta"-        fileName = dir </> "PKGBUILD"-    embed $ do-      createDirectoryIfMissing True dir-      writeFile fileName (T.unpack txt)-      printInfo $ "Write file" <> colon <+> pretty fileName+    case flattened' of+      [] -> pure ()+      [x] -> printWarn $ "The following dependency is missing in" <+> ppCommunity <> colon <+> pretty (unPackageName x)+      xs -> printWarn $ "Following dependencies are missing in" <+> ppCommunity <> colon <+> hsep (punctuate comma (pretty . unPackageName <$> xs))+    embed $ putDoc line+    case depends of+      [] -> printInfo "No extra dependency to install"+      xs ->+        embed (system $ "sudo pacman --needed -S " <> xs) >>= \case+          ExitSuccess -> printSuccess "Installed successfully"+          ExitFailure c -> printError $ "pacman exited with" <+> pretty c  ----------------------------------------------------------------------------- data EmergedSysDep = Solved File ArchLinuxName | Unsolved File@@ -305,9 +316,9 @@       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 specified -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 specified --uusi, uusi will become makedepends of each package"      hackage <- loadHackageDBFromOptions optHackage @@ -337,7 +348,7 @@       optFileTrace       ref       manager-      (subsumeGHCVersion $ app optTarget optOutputDir optAur optSkip optUusi optForce optMetaDir optJson (loadFilesDBFromOptions optFilesDB))+      (subsumeGHCVersion $ app optTarget optOutputDir optAur optSkip optUusi optForce optInstallDeps optJson optNoSkipMissing (loadFilesDBFromOptions optFilesDB))       & printAppResult  -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               arch-hs-version:            0.9.1.0+version:            0.10.0.0 synopsis:           Distribute hackage packages to archlinux description:   @arch-hs@ is a command-line program, which simplifies the process of producing@@ -23,7 +23,7 @@   CHANGELOG.md   README.md -tested-with:        GHC ==8.10.5 || ==9.0.1+tested-with:        GHC ==8.10.7 || ==9.0.2  source-repository head   type:     git@@ -37,7 +37,7 @@ common common-options   build-depends:     , aeson                        ^>=1.5.4-    , algebraic-graphs             ^>=0.5+    , algebraic-graphs             >=0.5     && <0.7     , arch-web                     ^>=0.1.0     , base                         >=4.12    && <5     , bytestring@@ -52,7 +52,7 @@     , hackage-db                   ^>=2.1.0     , http-client     , http-client-tls-    , megaparsec                   ^>=9.0.0 || ^>=9.1.0+    , megaparsec                   ^>=9.0.0 || ^>=9.1.0 || ^>=9.2.0     , microlens                    ^>=0.4.11     , microlens-th                 ^>=0.4.3     , neat-interpolation           ^>=0.5.1

@@ -39,6 +39,7 @@   "haskell-gtk": "gtk3",   "haskell-graphscc": "GraphSCC",   "haskell-hopenpgp": "hOpenPGP",+  "haskell-htf": "HTF",   "haskell-http": "HTTP",   "haskell-hunit": "HUnit",   "haskell-ifelse": "IfElse",@@ -51,6 +52,7 @@   "haskell-missingh": "MissingH",   "haskell-monadlib": "monadLib",   "haskell-monadrandom": "MonadRandom",+  "haskell-onetuple": "OneTuple",   "haskell-only": "Only",   "haskell-hsopenssl": "HsOpenSSL",   "haskell-hsyaml": "HsYAML",

@@ -2,6 +2,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-}+ -- | Copyright: (c) 2020-2021 berberman -- SPDX-License-Identifier: MIT -- Maintainer: berberman <berberman@yandex.com>@@ -111,7 +112,7 @@ loadFilesDB db dir = Map.fromList <$> runConduitRes (loadFilesDBC db dir .| mergeResult .| sinkList)  -- | Lookup which Arch Linux package contains this @file@ from given files db.--- This query is bad in performance, since it traverses the entire db. +-- This query is bad in performance, since it traverses the entire db. lookupPkg :: File -> FilesDB -> [ArchLinuxName] lookupPkg file = Map.foldrWithKey (\k v acc -> if file `elem` v then k : acc else acc) [] 

@@ -24,7 +24,6 @@           "integer-simple",           "bytestring-builder",           "nats",-          "old-time",           "integer",           "unsupported-ghc-version",           "rts",

@@ -159,8 +159,7 @@ -- i.e. it is in @preset@ or has @haskell-@ prefix. -- Attention: There is no guarantee that the package exists in hackage. isHaskellPackage :: ArchLinuxName -> Bool-isHaskellPackage (toArchLinuxRep -> rep) =-  (rep `elem` communityListP || "haskell-" `isPrefixOf` unsafeUnMyName rep)+isHaskellPackage (toArchLinuxRep -> rep) = rep `elem` communityListP || "haskell-" `isPrefixOf` unsafeUnMyName rep  -- | Check if a package is GHC or GHC Libs 

@@ -19,6 +19,7 @@     align2col,     dui,     cuo,+    yellowStarInParens,     ppCommunity,     ppAur,     ppDBKind,@@ -80,6 +81,9 @@ dui :: Doc AnsiStyle dui = annGreen "✔" +yellowStarInParens :: Doc AnsiStyle+yellowStarInParens = annYellow $ parens (pretty '*')+ prettySkip :: [String] -> Doc AnsiStyle prettySkip = hsep . punctuate comma . fmap (annotate (color Magenta) . pretty) @@ -91,10 +95,18 @@ prettyFlagAssignment :: FlagAssignment -> Doc AnsiStyle prettyFlagAssignment = vsep . fmap (\(n, v) -> "⚐" <+> annotate (color Yellow) (viaPretty n) <> colon <+> annotate (color Cyan) (pretty v)) . unFlagAssignment -prettyDeps :: [PackageName] -> Doc AnsiStyle+prettyDeps :: [(PackageName, Bool)] -> Doc AnsiStyle prettyDeps =   vsep-    . fmap (\(i :: Int, n) -> pretty i <> dot <+> viaPretty n)+    . fmap+      ( \(i :: Int, (pkg, star)) ->+          pretty i+            <> dot <+> viaPretty pkg+            <> ( if star+                   then space <> yellowStarInParens+                   else mempty+               )+      )     . zip [1 ..]  prettyFlags :: [(PackageName, [PkgFlag])] -> Doc AnsiStyle

@@ -14,7 +14,6 @@     showArchLicense,     applyTemplate,     felixTemplate,-    metaTemplate,   ) where @@ -177,21 +176,3 @@     runhaskell Setup copy --destdir="$$pkgdir"$licenseF   } |]---- | A fixed template of a haskell meta package.-metaTemplate :: Text -> Text -> Text -> Text -> Text-metaTemplate url pkgname comment depends =-  [text|-  # This file was generated by https://github.com/berberman/arch-hs, please check it manually.-  # This is a meta package, containing only dependencies of the target.-  # Maintainer: Your Name <youremail@domain.com>--  pkgname=haskell-$pkgname-meta-  pkgver=1-  pkgrel=1-  pkgdesc="Dependencies of $pkgname"-  url="$url"-  arch=('x86_64')-  $comment-  depends=('ghc-libs'$depends)-  |]

@@ -162,11 +162,11 @@   | otherwise = def  -- | Trace with prefix @[TRACE]@.-trace' :: MemberWithError Trace r => String -> Sem r ()+trace' :: Member Trace r => String -> Sem r () trace' s = trace $ "[TRACE]  " <> s  -- | Trace 'GHC.Stack.CallStack'.-traceCallStack :: (HasCallStack, MemberWithError Trace r) => Sem r ()+traceCallStack :: (HasCallStack, Member Trace r) => Sem r () traceCallStack = do   trace . prefix $ prettyCallStack callStack   where

@@ -2,6 +2,7 @@   ( CommonOptions (..),     SubmitOptions (..),     CheckOptions (..),+    ListOptions (..),     Mode (..),     runArgsParser,   )@@ -58,8 +59,22 @@  ----------------------------------------------------------------------------- -data Mode = Submit CommonOptions SubmitOptions | Check CommonOptions CheckOptions+newtype ListOptions = ListOptions+  { optWithVersion :: Bool+  } +listOptionsParser :: Parser ListOptions+listOptionsParser =+  ListOptions+    <$> switch (short 'v' <> long "with-version" <> help "Show package version")++-----------------------------------------------------------------------------++data Mode+  = Submit CommonOptions SubmitOptions+  | Check CommonOptions CheckOptions+  | List CommunityDBOptions ListOptions+ runArgsParser :: IO Mode runArgsParser =   snd <$> do@@ -79,3 +94,8 @@           "check inconsistencies of Haskell packages version"           id           (Check <$> commonOptionsParser <*> checkOptionsParser)+        addCommand+          "list"+          "list all Haskell packages in [community]"+          id+          (List <$> communityDBOptionsParser <*> listOptionsParser)

@@ -19,26 +19,28 @@             <+> "in"             <+> ppCommunity             <+> "has version"-            <+> (if isHackageNewer then annRed else annGreen) (viaPretty archVersion)+            <+> (if isHackageNewer then annRed else annGreen)+              (viaPretty archVersion)             <> comma-            <+> "but linked"-            <+> annMagneta (pretty (unPackageName hackageName))-            <+> "in"-            <+> annCyan "Hackage"-            <+> "has"-            <+> (if isHackageNewer then "a newer" else "an older")-            <+> "version"-            <+> (if isHackageNewer then annGreen else annRed) (viaPretty hackageVersion)+              <+> "but linked"+              <+> annMagneta (pretty (unPackageName hackageName))+              <+> "in"+              <+> annCyan "Hackage"+              <+> "has"+              <+> (if isHackageNewer then "a newer" else "an older")+              <+> "version"+              <+> (if isHackageNewer then annGreen else annRed)+                (viaPretty hackageVersion)           | (archName, rawArchVersion, cabal) <- linked,             let hackageName = packageName cabal                 hackageVersion = packageVersion cabal,-            archVersion <- maybeToList $ simpleParsec rawArchVersion,             includeGHC || not (isGHCLibs hackageName),+            archVersion <- maybeToList $ simpleParsec rawArchVersion,             archVersion /= hackageVersion,             let isHackageNewer = hackageVersion > archVersion         ]-  if (null result)+  if null result     then printSuccess "Finished checking"     else do-      printWarn $ "Finished checking with inconsistenc(ies):"+      printWarn "Finished checking with inconsistenc(ies):"       embed $ putDoc $ vcat result <> line

@@ -7,9 +7,11 @@ import Args import Check import Control.Monad (unless)+import qualified Data.Map.Strict as Map import Distribution.ArchHs.Exception import Distribution.ArchHs.Hackage import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Name (isHaskellPackage) import Distribution.ArchHs.Options import Distribution.ArchHs.PP import Distribution.ArchHs.Types@@ -27,7 +29,7 @@   HackageDB ->   Bool ->   IO (Either MyException ())-runCheck community hackage includeGHC=+runCheck community hackage includeGHC =   ( runFinal       . embedToFinal @IO       . errorToIOFinal@@ -82,3 +84,11 @@     community <- loadCommunityDBFromOptions optCommunityDB     hackage <- loadHackageDBFromOptions optHackage     runCheck community hackage optShowGHCLibs & printAppResult+  List CommunityDBOptions {..} ListOptions {..} -> do+    community <- loadCommunityDBFromOptions+    putStrLn $+      unlines+        [ unArchLinuxName name <> (if optWithVersion then ": " <> version else "")+          | (name, version) <- Map.toList community,+            isHaskellPackage name+        ]

@@ -27,7 +27,7 @@   linked <- linkedHaskellPackages   pure $     sortOn-      (\x -> x ^. _1)+      (^. _1)       [ (unPackageName hackageName, version, prefix <> tweakedName)         | (archLinuxName, version, packageName -> hackageName) <- linked,           let tweakedName =

@@ -17,7 +17,7 @@  linkedHaskellPackages ::   Members [CommunityEnv, HackageEnv, WithMyErr, Embed IO] r =>-  Sem r ([(ArchLinuxName, ArchLinuxVersion, GenericPackageDescription)])+  Sem r [(ArchLinuxName, ArchLinuxVersion, GenericPackageDescription)] linkedHaskellPackages = do   communityHaskellPackages <- filter (isHaskellPackage . fst) . Map.toList <$> ask @CommunityDB   hackagePackages <- Map.keys <$> ask @HackageDB