packdeps 0.4.2.1 → 0.4.3
raw patch · 3 files changed
+85/−42 lines, 3 filesdep ~Cabaldep ~base
Dependency ranges changed: Cabal, base
Files
- ChangeLog.md +4/−0
- Distribution/PackDeps.hs +78/−39
- packdeps.cabal +3/−3
ChangeLog.md view
@@ -1,3 +1,7 @@+## 0.4.3++* Updates (better cabal config parsing) [#30](https://github.com/snoyberg/packdeps/pull/30)+ ## 0.4.2 * Added --quiet flag to suppress output for up to date cabal files [#29](https://github.com/snoyberg/packdeps/pull/29)
Distribution/PackDeps.hs view
@@ -25,15 +25,17 @@ , diName -- * Internal , PackInfo (..)+ , piRevision , DescInfo (..) ) where -import System.Directory (getAppUserDataDirectory)+import Control.Applicative as A ((<$>))+import System.Directory (getAppUserDataDirectory, doesFileExist) import System.FilePath ((</>)) import qualified Data.Map as Map-import Data.List (foldl', group, sort, isInfixOf, isPrefixOf)+import Data.List (foldl', group, sort, isInfixOf) import Data.Time (UTCTime (UTCTime), addUTCTime)-import Data.Maybe (mapMaybe, catMaybes)+import Data.Maybe (mapMaybe, fromMaybe) import Control.Exception (throw) import Distribution.Package@@ -41,8 +43,9 @@ import Distribution.PackageDescription.Parse import Distribution.Version import Distribution.Text+import qualified Distribution.ParseUtils as PU -import Data.Char (toLower, isSpace)+import Data.Char (toLower) import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.Encoding as T import qualified Data.Text.Encoding.Error as T@@ -57,39 +60,30 @@ import Data.List (groupBy, sortBy) import Data.Ord (comparing) import qualified Data.Set as Set+import Text.Read (readMaybe)+-- import Data.Monoid ((<>)) loadNewest :: IO Newest loadNewest = do c <- getAppUserDataDirectory "cabal"- cfg <- readFile (c </> "config")+ cfg' <- readFile (c </> "config")+ cfg <- parseResult (fail . show) return $ PU.readFields cfg' let repos = reposFromConfig cfg repoCache = case lookupInConfig "remote-repo-cache" cfg of [] -> c </> "packages" -- Default (rrc : _) -> rrc -- User-specified- tarName repo = repoCache </> repo </> "00-index.tar"- fmap (Map.unionsWith maxVersion) . mapM (loadNewestFrom . tarName) $ repos--reposFromConfig :: String -> [String]-reposFromConfig = map (takeWhile (/= ':')) . lookupInConfig "remote-repo"---- | Looks up the given key in the cabal configuration file-lookupInConfig :: String -> String -> [String]-lookupInConfig key = map trim . catMaybes . map (dropPrefix prefix) . lines- where- prefix = key ++ ":"---- | Utility: drop leading and trailing spaces from a string-trim :: String -> String-trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace--dropPrefix :: (Eq a) => [a] -> [a] -> Maybe [a]-dropPrefix prefix s =- if prefix `isPrefixOf` s- then Just . drop (length prefix) $ s- else Nothing+ tarNames repo = [ pfx </> "01-index.tar", pfx </> "00-index.tar" ]+ where pfx = repoCache </> repo+ fmap (Map.unionsWith maxVersion) . mapM (loadNewestFrom . tarNames) $ repos -loadNewestFrom :: FilePath -> IO Newest-loadNewestFrom = fmap parseNewest . L.readFile+-- | Takes a list of possible pathes, tries them in order until one exists.+loadNewestFrom :: [FilePath] -> IO Newest+loadNewestFrom [] = fail "loadNewestFrom: no index tarball"+loadNewestFrom (fp : fps) = do+ e <- doesFileExist fp+ if e+ then fmap parseNewest (L.readFile fp)+ else loadNewestFrom fps parseNewest :: L.ByteString -> Newest parseNewest = foldl' addPackage Map.empty . entriesToList . Tar.read@@ -108,7 +102,8 @@ case Map.lookup package' m of Nothing -> go package' version Just PackInfo { piVersion = oldv } ->- if version > oldv+ -- in 01-index.tar there are entries with the same versions+ if version >= oldv then go package' version else m Nothing -> m@@ -117,7 +112,7 @@ go package' version = case Tar.entryContent entry of Tar.NormalFile bs _ ->- Map.insert package' PackInfo+ Map.insertWith maxVersion package' PackInfo { piVersion = version , piDesc = parsePackage bs , piEpoch = Tar.entryTime entry@@ -125,12 +120,21 @@ _ -> m data PackInfo = PackInfo- { piVersion :: Version- , piDesc :: Maybe DescInfo- , piEpoch :: Tar.EpochTime+ { piVersion :: Version+ , piDesc :: Maybe DescInfo+ , piEpoch :: Tar.EpochTime } deriving (Show, Read) +-- Extract revision from PackInfo, default to 0+piRevision :: PackInfo -> Int+piRevision = fromMaybe 0 . fmap diRevision . piDesc++-- We should compare revisions as well,+-- but we don't do that, as it would force `piDesc` and make `packdeps`+-- executable increadibly slow (parse all cabal files on Hackage)+-- Instead we rely on the fact that newer revisions are always later in+-- 01-index.tar maxVersion :: PackInfo -> PackInfo -> PackInfo maxVersion pi1 pi2 = if piVersion pi1 <= piVersion pi2 then pi2 else pi1 @@ -162,24 +166,30 @@ -- | Information on a single package. data DescInfo = DescInfo { diHaystack :: String- , diDeps :: [Dependency]- , diLibDeps :: [Dependency]- , diPackage :: PackageIdentifier+ , diDeps :: [Dependency]+ , diLibDeps :: [Dependency]+ , diPackage :: PackageIdentifier+ , diRevision :: Int , diSynopsis :: String } deriving (Show, Read) +-- | Return revision and DescInfo getDescInfo :: GenericPackageDescription -> DescInfo getDescInfo gpd = DescInfo { diHaystack = map toLower $ author p ++ maintainer p ++ name- , diDeps = getDeps gpd- , diLibDeps = getLibDeps gpd- , diPackage = pi'+ , diDeps = getDeps gpd+ , diLibDeps = getLibDeps gpd+ , diPackage = pi'+ , diRevision = rev , diSynopsis = synopsis p } where p = packageDescription gpd pi'@(PackageIdentifier (PackageName name) _) = package p+ rev = fromMaybe 0 $ do+ r <- lookup "x-revision" (customFieldsPD p)+ readMaybe r getDeps :: GenericPackageDescription -> [Dependency] getDeps x = getLibDeps x ++ concat@@ -290,3 +300,32 @@ unPN . pkgName . diPackage where unPN (PackageName pn) = pn++-------------------------------------------------------------------------------+-- ~/.cabal/config parsing+-------------------------------------------------------------------------------++reposFromConfig :: [PU.Field] -> [String]+reposFromConfig fields = takeWhile (/= ':') A.<$> mapMaybe f fields+ where+ f (PU.F _lineNo name value)+ | name == "remote-repo"+ = Just value+ f (PU.Section _lineNo secName arg _fields)+ | secName == "repository"+ = Just arg+ f _ = Nothing++-- | Looks up the given key in the cabal configuration file+lookupInConfig :: String -> [PU.Field] -> [String]+lookupInConfig key = mapMaybe f+ where+ f (PU.F _lineNo name value)+ | name == key+ = Just value+ f _ = Nothing++-- | Like 'either', but for 'ParseResult'+parseResult :: (PU.PError -> r) -> (a -> r) -> ParseResult a -> r+parseResult l _ (PU.ParseFailed e) = l e+parseResult _ r (PU.ParseOk _warns x) = r x
packdeps.cabal view
@@ -1,5 +1,5 @@ name: packdeps-version: 0.4.2.1+version: 0.4.3 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -17,12 +17,12 @@ extra-source-files: README.md ChangeLog.md library- build-depends: base >= 4 && < 5+ build-depends: base >= 4.6 && < 5 , tar >= 0.4 && < 0.6 , split >= 0.1.2.3 , bytestring >= 0.9 , text >= 0.7- , Cabal >= 1.8+ , Cabal >= 1.14 && <1.25 , time >= 1.1.4 , containers >= 0.2 , directory >= 1.0