packdeps 0.4.5 → 0.5.0.0
raw patch · 4 files changed
+100/−40 lines, 4 filesdep ~Cabaldep ~optparse-applicativePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: Cabal, optparse-applicative
API changes (from Hackage documentation)
Files
- ChangeLog.md +6/−0
- packdeps.cabal +6/−4
- src/Distribution/PackDeps.hs +59/−23
- tools/packdeps-cli.hs +29/−13
ChangeLog.md view
@@ -1,3 +1,9 @@+# ChangeLog for packdeps++## 0.5.0.0++* Switch to Cabal 3.0+ ## 0.4.5 * Switch to Cabal 2.2
packdeps.cabal view
@@ -1,5 +1,5 @@ name: packdeps-version: 0.4.5+version: 0.5.0.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -11,19 +11,20 @@ The command line tool has an incredibly simple interface: simply pass it a list of cabal files, and it will tell you what dependencies- if any- are restricted. category: Distribution stability: Stable-cabal-version: >= 1.8+cabal-version: >= 1.10 build-type: Simple homepage: http://packdeps.haskellers.com/ extra-source-files: README.md ChangeLog.md library+ default-language: Haskell2010 hs-source-dirs: src build-depends: base >= 4.6 && < 5 , tar >= 0.4 && < 0.6 , split >= 0.1.2.3 , bytestring >= 0.9 , text >= 0.7- , Cabal >= 2.2 && < 2.3+ , Cabal >= 3.0 && < 3.1 , time >= 1.1.4 , containers >= 0.2 , directory >= 1.0@@ -32,6 +33,7 @@ ghc-options: -Wall executable packdeps+ default-language: Haskell2010 main-is: packdeps-cli.hs hs-source-dirs: tools @@ -39,7 +41,7 @@ build-depends: base >= 4 && < 5 , Cabal- , optparse-applicative >=0.14 && <0.15+ , optparse-applicative >=0.14 && <0.16 , containers , semigroups , process
src/Distribution/PackDeps.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE OverloadedStrings #-} module Distribution.PackDeps ( -- * Data types Newest@@ -43,10 +44,13 @@ import Distribution.Package import Distribution.PackageDescription import Distribution.PackageDescription.Parsec-import Distribution.Parsec.Class (Parsec, lexemeParsec, runParsecParser, simpleParsec)+import Distribution.Parsec (Parsec, lexemeParsec, runParsecParser, simpleParsec) import Distribution.Parsec.FieldLineStream (fieldLineStreamFromBS)+import Distribution.Types.CondTree import Distribution.Version-import qualified Distribution.ParseUtils as PU+import qualified Distribution.Fields as F+import qualified Distribution.Fields.Field as F+import qualified Distribution.Simple.Utils as U import Data.Char (toLower) import qualified Data.ByteString as S@@ -62,13 +66,16 @@ import Data.Ord (comparing) import qualified Data.Set as Set import Text.Read (readMaybe)+import System.Environment (lookupEnv) -- import Data.Monoid ((<>)) loadNewest :: Bool -> IO Newest loadNewest preferred = do c <- getAppUserDataDirectory "cabal"- cfg' <- readFile (c </> "config")- cfg <- parseResult (fail . show) return $ PU.readFields cfg'+ location <- fmap (fromMaybe (c </> "config")) (lookupEnv "CABAL_CONFIG")++ cfg' <- S.readFile location+ cfg <- either (fail . show) return $ F.readFields cfg' let repos = reposFromConfig cfg repoCache = case lookupInConfig "remote-repo-cache" cfg of [] -> c </> "packages" -- Default@@ -136,7 +143,7 @@ [_packageS, "preferred-versions"] -> case Tar.entryContent entry of Tar.NormalFile bs _ -> case simpleParsecLBS bs of- Just (Dependency dep range) -> Map.insert dep range m+ Just (Dependency dep range _) -> Map.insert dep range m Nothing -> m _ -> m _ -> m@@ -183,7 +190,7 @@ toTuples (_, PackInfo { piDesc = Nothing }) = [] toTuples (rel, PackInfo { piDesc = Just DescInfo { diDeps = deps } }) = map (toTuple rel) deps- toTuple rel (Dependency dep range) = (dep, (rel, range))+ toTuple rel (Dependency dep range _) = (dep, (rel, range)) hoist :: Ord a => [(a, b)] -> [(a, [b])] hoist = map ((fst . head) &&& map snd) . groupBy ((==) `on` fst)@@ -225,14 +232,41 @@ getDeps :: GenericPackageDescription -> [Dependency] getDeps x = getLibDeps x ++ concat- [ concatMap (condTreeConstraints . snd) (condExecutables x)- , concatMap (condTreeConstraints . snd) (condTestSuites x)- , concatMap (condTreeConstraints . snd) (condBenchmarks x)+ [ concatMap (condTreeConstraints' . snd) (condExecutables x)+ , concatMap (condTreeConstraints' . snd) (condTestSuites x)+ , concatMap (condTreeConstraints' . snd) (condBenchmarks x) ] getLibDeps :: GenericPackageDescription -> [Dependency]-getLibDeps gpd = maybe [] condTreeConstraints (condLibrary gpd)+getLibDeps gpd = maybe [] condTreeConstraints' (condLibrary gpd) ++ customDeps+ where+ pd = packageDescription gpd+ customDeps+ | buildType pd == Custom = maybe defSetupDeps setupDepends (setupBuildInfo pd)+ | otherwise = [] + -- we only interested in Cabal default upper bound+ -- See cabal-install Distribution.Client.ProjectPlanning defaultSetupDeps+ defSetupDeps = [Dependency (mkPackageName "Cabal") (earlierVersion $ mkVersion [1,25]) mempty]++condTreeConstraints' :: Monoid c => CondTree ConfVar c a -> c+condTreeConstraints' = go where+ go (CondNode _ c bs) = mappend c (foldMap branch bs)++ branch (CondBranch c' x y)+ | notFlagCondition c' = mappend (go x) (foldMap go y)+ | otherwise = mempty++notFlagCondition :: Condition ConfVar -> Bool+notFlagCondition (Var (OS _)) = True+notFlagCondition (Var (Arch _)) = True+notFlagCondition (Var (Flag _)) = False+notFlagCondition (Var (Impl _ _)) = True+notFlagCondition (Lit _) = True+notFlagCondition (CNot a) = notFlagCondition a+notFlagCondition (COr a b) = notFlagCondition a && notFlagCondition b+notFlagCondition (CAnd a b) = notFlagCondition a && notFlagCondition b+ checkDeps :: Newest -> DescInfo -> (PackageName, Version, CheckDepsRes) checkDeps = checkDepsImpl diDeps@@ -263,7 +297,7 @@ epochToTime e = addUTCTime (fromIntegral e) $ UTCTime (read "1970-01-01") 0 notNewest :: Newest -> Dependency -> Maybe ((PackageName, Version), Tar.EpochTime)-notNewest newest (Dependency s range) =+notNewest newest (Dependency s range _public) = case Map.lookup s newest of --Nothing -> Just ((s, " no version found"), 0) Nothing -> Nothing@@ -322,7 +356,7 @@ viewed' = Set.insert name viewed newDis = mapMaybe getDI $ deps di getDI :: Dependency -> Maybe DescInfo- getDI (Dependency name' _) = do+ getDI (Dependency name' _ _) = do pi' <- Map.lookup name' newest piDesc pi' @@ -333,27 +367,29 @@ -- ~/.cabal/config parsing ------------------------------------------------------------------------------- -reposFromConfig :: [PU.Field] -> [String]+reposFromConfig :: [F.Field ann] -> [String] reposFromConfig fields = takeWhile (/= ':') A.<$> mapMaybe f fields where- f (PU.F _lineNo name value)+ f (F.Field (F.Name _pos name) fls) | name == "remote-repo"- = Just value- f (PU.Section _lineNo secName arg _fields)+ = Just $ U.fromUTF8BS $ S.intercalate "\n" (map F.fieldLineBS fls)+ f (F.Section (F.Name _pos secName) (F.SecArgName _ arg : _) _fields) | secName == "repository"- = Just arg+ = Just $ U.fromUTF8BS arg f _ = Nothing -- | Looks up the given key in the cabal configuration file-lookupInConfig :: String -> [PU.Field] -> [String]+lookupInConfig :: S.ByteString -> [F.Field ann] -> [String] lookupInConfig key = mapMaybe f where- f (PU.F _lineNo name value)+ f (F.Field (F.Name _pos name) fls) | name == key- = Just value+ = Just $ U.fromUTF8BS $ S.intercalate "\n" (map F.fieldLineBS fls) f _ = Nothing +{- -- | Like 'either', but for 'ParseResult'-parseResult :: (PU.PError -> r) -> (a -> r) -> PU.ParseResult a -> r-parseResult l _ (PU.ParseFailed e) = l e-parseResult _ r (PU.ParseOk _warns x) = r x+parseResult :: (F.PError -> r) -> (a -> r) -> F.ParseResult a -> r+parseResult l _ (F.ParseFailed e) = l e+parseResult _ r (F.ParseOk _warns x) = r x+-}
tools/packdeps-cli.hs view
@@ -2,14 +2,14 @@ import Control.Applicative (many, some) import Control.Monad (forM_, foldM, when) import Control.Monad (liftM)+import Data.Char (isSpace) import Data.List (foldl')-import Data.Maybe (mapMaybe) import Data.Semigroup ((<>))-import Distribution.Compat.ReadP (readP_to_S) import Distribution.PackDeps-import Distribution.Package (PackageIdentifier (PackageIdentifier), PackageName, unPackageName)-import Distribution.Text (display, parse)+import Distribution.Package (PackageIdentifier (pkgName, pkgVersion), PackageName, unPackageName)+import Distribution.Text (display) import Distribution.Version (Version)+import qualified Distribution.InstalledPackageInfo as IPI import System.Exit (exitFailure, exitSuccess) import System.Process (readProcess) @@ -75,19 +75,35 @@ -- TODO updateWithGhcPkg :: Newest -> IO Newest updateWithGhcPkg newest = do- output <- readProcess "ghc-pkg" ["list", "--simple-output"] ""- let pkgs = mapMaybe parseSimplePackInfo (words output)- return $ foldl' apply newest pkgs+ output <- readProcess "ghc-pkg" ["dump"] ""+ ipis <- either (fail . show) (return . map snd) $+ traverse IPI.parseInstalledPackageInfo $ splitPkgs output+ return $ foldl' apply newest $ map toPackInfo ipis where apply :: Newest -> (PackageName, PackInfo) -> Newest apply m (k, v) = Map.insert k v m - parseSimplePackInfo :: String -> Maybe (PackageName, PackInfo)- parseSimplePackInfo str =- case filter ((== "") . snd) $ readP_to_S parse str of- ((PackageIdentifier name ver, _) : _) ->- Just (name, PackInfo ver Nothing 0)- _ -> Nothing+ toPackInfo :: IPI.InstalledPackageInfo -> (PackageName, PackInfo)+ toPackInfo ipi = (pkgName $ IPI.sourcePackageId ipi, pinfo) where+ pinfo = PackInfo+ { piVersion = pkgVersion $ IPI.sourcePackageId ipi+ , piEpoch = 0+ , piDesc = Nothing+ }++ -- copied from from Cabal+ splitPkgs :: String -> [String]+ splitPkgs = checkEmpty . map unlines . splitWith ("---" ==) . lines+ where+ -- Handle the case of there being no packages at all.+ checkEmpty [s] | all isSpace s = []+ checkEmpty ss = ss++ splitWith :: (a -> Bool) -> [a] -> [[a]]+ splitWith p xs = ys : case zs of+ [] -> []+ _:ws -> splitWith p ws+ where (ys,zs) = break p xs run :: Bool -- ^ Check transitive dependencies -> Bool -- ^ Quiet -- only report packages that are not up to date