diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +## 0.3.0.3 + +* Diffs against previous versions + ## 0.3.0.2 * Switch to optparse-simple diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/mega-sdist.cabal b/mega-sdist.cabal --- a/mega-sdist.cabal +++ b/mega-sdist.cabal @@ -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 diff --git a/mega-sdist.hs b/mega-sdist.hs --- a/mega-sdist.hs +++ b/mega-sdist.hs @@ -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)