mega-sdist 0.3.0.2 → 0.3.0.3
raw patch · 4 files changed
+329/−34 lines, 4 filesdep +text
Dependencies added: text
Files
- ChangeLog.md +4/−0
- README.md +218/−6
- mega-sdist.cabal +2/−1
- mega-sdist.hs +105/−27
ChangeLog.md view
@@ -1,3 +1,7 @@+## 0.3.0.3++* Diffs against previous versions+ ## 0.3.0.2 * Switch to optparse-simple
README.md view
@@ -1,11 +1,223 @@ # mega-sdist -Handles uploading to Hackage from Stack mega repos.+This is a utility written to address the specific needs in maintaining+Haskell "mega-repos," or Git repositories containing multiple Cabal+projects. It is intended to ease the process of deciding which+packages need to be released and tagging those releases appropriately. -Compares local code against version on Hackage. Accepts the following options:+It provides the following functionality: -* __--gittag__: Automatically tag as well.+* Detect when local code has changed from what's on Hackage+ * Note that, due to Hackage revisions, sometimes this logic isn't+ perfect+* Detect when a version number needs to be updated+* Dump the difference between the Hackage version of your package and+ the local version -Uses `stack.yaml` if present to determine which packages to-build. Only takes directories which are a subdirectory of the current-directory.+To install it... well, listen. This tool is intended for people+authoring Haskell packages. Odds are, you already know how to do+this. And if you don't know, this probably isn't a tool that will help+you. Anyway, in order to install it, first+[install Stack](https://haskell-lang.org/get-started) and then run+`stack install mega-sdist`, or just `stack install` inside this+repository.++## Opinionated tool++This utility is highly opinionated in some ways, e.g.:++* It only supports one style of Git tag name:+ `packagename/version`. This may look weird in non-mega-repos, where+ `v1.2.3` looks better than `foo/1.2.3`, but for mega-repos the+ former doesn't make sense.+* It depends on Stack for both discovering all of your local packages,+ and for uploading to Hackage.++If you're OK with these opinions, keep reading for usage.++## Have I changed anything?++Let's say I'm working on the+[monad-unlift megarepo](https://github.com/fpco/monad-unlift) (chosen+as an example of a relatively small repo). I've merged some PRs+recently, or at least think I have. But I don't remember which of the+individual packages within the repo this affected. Instead of looking+at the commit history like some caveman, I'll typically do:++```+$ git pull # make sure I have all latest changes+$ mega-sdist+```++The `mega-sdist` command will:++* Build tarballs for all local packages+* Check what the latest versions of my packages on Hackage are+* Do a full `diff` on these two things and see if anything's changed++At the time of writing, here's the output from this repo:++```+The following packages from Hackage have not changed:+monad-unlift-0.2.0++The following packages require a version bump:+monad-unlift-ref-0.2.1+```++What this means is:++* The `monad-unlift` package I have locally is at version `0.2.0`. And+ it perfectly matches that version on Hackage. No actions necessary.+* The `monad-unlift-ref` package I have locally is at version+ `0.2.1`. And it doesn't match the code on Hackage. Therefore, if I+ wanted to run `stack upload monad-unlift-ref` successfully, I'd need+ to bump the version number.++## What did I change?++Well, again, if I wanted to see what changed, I could run (again, like+a caveman):++```+$ git diff monad-unlift-ref/0.2.1 -- monad-unlift-ref+```++But that's long! `mega-sidst`'s got your back. Just run:++```+$ mega-sdist monad-unlift-ref --get-diffs+```++This will print out the difference between the tarball uploaded to+Hackage and what you have locally. Besides my tongue-in-cheek comment+above, this is also useful if, for some reason, you either don't have+or don't trust the tags in your Git repo.++One other thing: this diff is currently based on the pristine tarball+from Hackage, ignoring cabal file revisions. So the difference may be+slightly different from what you'd get from `stack unpack+monad-unlift-ref-0.2.1`. But `¯\_(ツ)_/¯` that's revisions for you.++The default behavior of `mega-sdist` is to look at all packages+specified in your `stack.yaml`. Targets can be any directory. And+`mega-sdist` will automatically look at packages in any+_subdirectory_, so that `mega-sdist .` is the same as `mega-sdist` at+the root of your repo\*.++\* Assuming all of your packages are actually _in_ your repo, but only+crazy people would do otherwise.++## Preparing a new release++OK, now I continue working on my project, and I've:++* Made some changes to `monad-unlift`+* Updated the cabal file's version number+ * And of course I also updated the `ChangeLog.md`, I'm not some+ monster++From the root of my repo, I run:++```+$ mega-sdist monad-unlift+```++Or, equivalently, from inside the `monad-unlift` subdirectory I run:++```+$ mega-sdist .+```++Either way, I get:++```+The following new packages exist locally:+monad-unlift-0.2.1++No version bumps required, good to go!+```++This tells me that my package has local changes, _and_ the version+number has been updated, so that `stack upload monad-unlift` will+work. Neato! Now, you _could_ just run `stack upload ...`, but here's+what I usually do. First, I'll review the changes I'm about to upload+and make sure there are no surprises:++```+$ mega-sdist --get-diffs .++The following new packages exist locally:+monad-unlift-0.2.1+diff -r old/monad-unlift-0.2.0/ChangeLog.md new/monad-unlift-0.2.1/ChangeLog.md+0a1,4+> ## 0.2.1+>+> * Silly changes+>+diff -r old/monad-unlift-0.2.0/Control/Monad/Trans/Unlift.hs new/monad-unlift-0.2.1/Control/Monad/Trans/Unlift.hs+51a52,54+>+> -- I just need some space+>+diff -r old/monad-unlift-0.2.0/monad-unlift.cabal new/monad-unlift-0.2.1/monad-unlift.cabal+2c2+< version: 0.2.0+---+> version: 0.2.1++No version bumps required, good to go!+```++OK, that's what I wanted. Time to release. Next, I'm going to use+`mega-sdist` to tag the release:++```+$ mega-sdist --gittag .+```++From the root of my repo, this would notice that `monad-unlift-ref`+still requires a version bump, and refuse to proceed. But inside the+`monad-unlift` directory, it notices that all necessary version bumps+are done, and happily tags:++```+$ mega-sdist --gittag .+The following new packages exist locally:+monad-unlift-0.2.1++No version bumps required, good to go!+Raw command: git tag monad-unlift/0.2.1+```++And suddenly I notice something new:++```+$ ls tarballs/+monad-unlift-0.2.1.tar.gz+```++Neat, `mega-sdist` left behind tarballs I can upload! To do so, I run:++```+$ stack upload tarballs/*+```++Note that this will work whether I'm trying to upload just one+package, or all of the updated packages in my repo. Finally, I need to+push the new tags to Github (or wherever):++```+$ git push --tags+```++And in fact, this upload sequence is so common that I have a shell+alias set up:++```+$ alias upload+alias upload='mega-sdist --gittag . && stack upload tarballs/* && git push --tags'+```++So there you have it: convenient little utility to help manage repos+with lots of packages in them.
mega-sdist.cabal view
@@ -1,5 +1,5 @@ Name: mega-sdist-Version: 0.3.0.2+Version: 0.3.0.3 Synopsis: Handles uploading to Hackage from mega repos Description: See README.md Homepage: https://github.com/snoyberg/mega-sdist@@ -27,6 +27,7 @@ , optparse-simple , temporary , bytestring+ , text source-repository head type: git
mega-sdist.hs view
@@ -16,6 +16,10 @@ import Paths_mega_sdist (version) import System.IO.Temp (withSystemTempDirectory) import qualified Data.ByteString.Lazy as L+import Data.Semigroup (Max (..), Option (..))+import qualified Data.Version+import Text.ParserCombinators.ReadP (readP_to_S)+import qualified Data.Text as T getUrlHackage :: Package -> IO Request getUrlHackage (Package _fp (PackageName a) (Version b)) =@@ -101,7 +105,9 @@ Nothing -> return () Just s -> do say "\nThe following new packages exist locally:"- mapM_ sayPackage $ keys s+ forM_ (mapToList s) $ \(name, mdiff) -> do+ sayPackage name+ forM_ mdiff (L.hPut stdout) case lookup NeedsVersionBump m of Nothing -> do@@ -130,39 +136,93 @@ go getDiffs fp = do package <- parsePackage fp localFileHackage <- liftIO $ getHackageFile package- fh <- liftIO $ doesFileExist localFileHackage- let handleFile localFile noChanges = do- (isDiff, mdiff) <- compareTGZ getDiffs localFile fp- return $ if isDiff then (NeedsVersionBump, mdiff) else (noChanges, Nothing)+ localFileExists <- liftIO $ doesFileExist localFileHackage+ let handleFile = do+ let v = packageVersion package+ (isDiff, mdiff) <- compareTGZ getDiffs (packageName package) localFileHackage v fp v+ return $ if isDiff then (NeedsVersionBump, mdiff) else (NoChanges, Nothing) (status, mdiff) <-- case () of- ()- | fh -> handleFile localFileHackage NoChanges- | otherwise -> do- reqH <- getUrlHackage package- runResourceT $ httpSink reqH $ \resH -> do- case () of- ()- | getResponseStatusCode resH == 404 -> return (DoesNotExist, Nothing)- | getResponseStatusCode resH == 403 -> return (DoesNotExist, Nothing)- | getResponseStatusCode resH == 200 -> do- liftIO $ createDirectoryIfMissing True $ takeDirectory localFileHackage- sinkFileCautious localFileHackage- liftIO $ handleFile localFileHackage NoChanges- | otherwise -> error $ "Invalid status code: " ++ show (getResponseStatus resH)+ if localFileExists+ then handleFile+ else do+ reqH <- getUrlHackage package+ runResourceT $ httpSink reqH $ \resH -> do+ case () of+ ()+ | getResponseStatusCode resH `elem` [403, 404] -> do+ mdiff <-+ if getDiffs+ then do+ mlatest <- getLatestVersion (packageName package)+ case mlatest of+ Nothing -> return Nothing+ Just (latest, latestv) -> do+ (isDiff, mdiff) <- liftIO $ compareTGZ getDiffs (packageName package) latest latestv fp (packageVersion package)+ return $ if isDiff then mdiff else Nothing+ else return Nothing+ return (DoesNotExist, mdiff)+ | getResponseStatusCode resH == 403 -> return (DoesNotExist, Nothing)+ | getResponseStatusCode resH == 200 -> do+ liftIO $ createDirectoryIfMissing True $ takeDirectory localFileHackage+ sinkFileCautious localFileHackage+ liftIO handleFile+ | otherwise -> error $ "Invalid status code: " ++ show (getResponseStatus resH) return $ singletonMap status $ singletonMap package mdiff -newtype PackageName = PackageName Text+-- | Get the filepath for the latest version of a package from+-- Hackage, if it exists at all.+getLatestVersion :: MonadIO m => PackageName -> m (Maybe (FilePath, Version))+getLatestVersion name = liftIO $ do+ stack <- getAppUserDataDirectory "stack"+ let index = stack </> "indices" </> "Hackage" </> "00-index.tar"+ mversion <- runConduitRes+ $ sourceFile index+ .| untar+ .| withEntries yield+ .| foldMapC (parseVersionNumber name)+ case mversion of+ Option Nothing -> return Nothing+ Option (Just (Max version)) -> do+ let p = Package "" name $ toTextVersion version+ fp <- liftIO $ getHackageFile p+ req <- liftIO $ getUrlHackage p+ runResourceT $ httpSink req $ \res ->+ if getResponseStatusCode res == 200+ then do+ liftIO $ createDirectoryIfMissing True $ takeDirectory fp+ sinkFileCautious fp+ return $ Just (fp, toTextVersion version)+ else error $ "Could not download from Hackage: " ++ show p++newtype PackageName = PackageName { unPackageName :: Text } deriving (Show, Eq, Ord)-newtype Version = Version Text+newtype Version = Version { unVersion :: Text } deriving (Show, Eq, Ord) data Package = Package { packageFile :: !FilePath- , _packageName :: !PackageName- , _packageVersion :: !Version+ , packageName :: !PackageName+ , packageVersion :: !Version } deriving (Show, Eq, Ord) +toTextVersion :: Data.Version.Version -> Version+toTextVersion = Version . pack . Data.Version.showVersion++parseVersionNumber :: PackageName+ -- ^ target package we care about+ -> Header+ -> Option (Max Data.Version.Version)+parseVersionNumber pn header = Option $ fmap Max $ do+ [name, version, dotcabal] <- Just $ T.splitOn "/" $ pack fp+ guard $ PackageName name == pn+ guard $ name ++ ".cabal" == dotcabal+ listToMaybe $ map fst+ $ filter (null . snd)+ $ readP_to_S Data.Version.parseVersion+ $ unpack version+ where+ fp = headerFilePath header+ parsePackage :: MonadThrow m => FilePath -> m Package parsePackage fp = case stripSuffix ".tar.gz" $ pack $ takeFileName fp of@@ -187,8 +247,17 @@ b = unpack b' compareTGZ :: Bool -- ^ get diffs?- -> FilePath -> FilePath -> IO (Bool, Maybe Diff)-compareTGZ getDiffs a b = do+ -> PackageName+ -> FilePath+ -- ^ old tarball+ -> Version+ -- ^ old version+ -> FilePath+ -- ^ new tarball+ -> Version+ -- ^ new version+ -> IO (Bool, Maybe Diff)+compareTGZ getDiffs pn a av b bv = do a' <- getContents a b' <- getContents b let isDiff = a' /= b'@@ -201,7 +270,16 @@ L.writeFile fp' bs fill (diff </> "old") a' fill (diff </> "new") b'- (_, out, _) <- readProcess $ setWorkingDir diff $ proc "diff" ["-r", "old", "new"]+ let toNV v = concat+ [ unpack (unPackageName pn)+ , "-"+ , unpack (unVersion v)+ ]+ (_, out, _) <- readProcess $ setWorkingDir diff $ proc "diff"+ [ "-r"+ , "old" </> toNV av+ , "new" </> toNV bv+ ] return $ Just out else return Nothing return (a' /= b', mdiff)