From 59de313e7a301069bda14be4c530337ed58443f8 Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Tue, 6 Jul 2021 16:07:56 -0400 Subject: [PATCH 1/2] Move unreleased changelog entries to CHANGELOG.d --- .github/PULL_REQUEST_TEMPLATE.md | 2 +- CHANGELOG.d/README.md | 50 +++++++ CHANGELOG.d/internal_changelog-dir.md | 3 + CHANGELOG.md | 10 -- RELEASE_GUIDE.md | 3 + update-changelog.hs | 196 ++++++++++++++++++++++++++ 6 files changed, 253 insertions(+), 11 deletions(-) create mode 100644 CHANGELOG.d/README.md create mode 100644 CHANGELOG.d/internal_changelog-dir.md create mode 100755 update-changelog.hs diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index 711103ccba..501ee01403 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -6,7 +6,7 @@ Clearly and concisely describe the purpose of the pull request. If this PR relat **Checklist:** -- [ ] Added the change to the changelog's "Unreleased" section with a reference to this PR (e.g. "- Made a change (#0000)") +- [ ] Added a file to CHANGELOG.d for this PR (see CHANGELOG.d/README.md) - [ ] Added myself to CONTRIBUTORS.md (if this is my first contribution) - [ ] Linked any existing issues or proposals that this pull request should close - [ ] Updated or added relevant documentation diff --git a/CHANGELOG.d/README.md b/CHANGELOG.d/README.md new file mode 100644 index 0000000000..2d9698909c --- /dev/null +++ b/CHANGELOG.d/README.md @@ -0,0 +1,50 @@ +This directory contains changelog entries for work that has not yet been +released. When a release goes out, these files will be concatenated and +prepended to CHANGELOG.md in a new section for that release. + +Maintainers: see update-changelog.hs for details of this process. + +Contributors: read on! + +When you are preparing a new PR, add a new file to this directory. The file +should be named `{PREFIX}_{SLUG}.md`, where `{PREFIX}` is one of the following: +* `breaking`: for breaking changes +* `feature`: for new features +* `fix`: for bug fixes +* `internal`: for work that will not directly affect users of PureScript +* `misc`: for anything else that needs to be logged + +`{SLUG}` should be a short description of the work you've done. The name has no +impact on the final CHANGELOG.md. + +Some example names: +* `fix_issue-9876.md` +* `breaking_deprecate-classes.md` +* `misc_add-forum-to-readme.md` + +The contents of the file can be as brief as: + +```markdown +* A short message, like the title of your commit +``` + +Please remember the initial `*`! These files will all be concatenated into +lists. + +If you have more to say about your work, indent additional lines like so: + +``````markdown +* A short message, like the title of your commit + + Here is a longer explanation of what this is all about. Of course, this file + is Markdown, so feel free to use *formatting* + + ``` + and code blocks + ``` + + if it makes your work more understandable. +`````` + +You do not have to edit your changelog file to include a reference to your PR. +The CHANGELOG.md updating script will do this automatically and credit you. diff --git a/CHANGELOG.d/internal_changelog-dir.md b/CHANGELOG.d/internal_changelog-dir.md new file mode 100644 index 0000000000..07d5deea04 --- /dev/null +++ b/CHANGELOG.d/internal_changelog-dir.md @@ -0,0 +1,3 @@ +* Move unreleased changelog entries to CHANGELOG.d + + See CHANGELOG.d/README.md for details. diff --git a/CHANGELOG.md b/CHANGELOG.md index cf4fa206e3..614f18ea3b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,16 +2,6 @@ Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). -## [Unreleased] - -Breaking changes: - -New features: - -Bugfixes: - -Internal: - ## v0.14.3 New features: diff --git a/RELEASE_GUIDE.md b/RELEASE_GUIDE.md index bec12e8d0d..50e6ad8b1f 100644 --- a/RELEASE_GUIDE.md +++ b/RELEASE_GUIDE.md @@ -96,6 +96,9 @@ considering what effects this may have: - The version bounds for `purescript-cst` in `purescript.cabal` +- Run `stack update-changelog.hs`, which will move the entries in `CHANGELOG.d` + to a new section in `CHANGELOG.md` labeled with the new version. + - Create a release from the releases tab in GitHub and copy in the release notes. This will also create a tag, which will kick off a CI build, which will upload prebuilt compiler binaries to the release on GitHub when it diff --git a/update-changelog.hs b/update-changelog.hs new file mode 100755 index 0000000000..35f3404d6d --- /dev/null +++ b/update-changelog.hs @@ -0,0 +1,196 @@ +#!/usr/bin/env stack +-- stack --resolver lts-17.6 script +{-# LANGUAGE + DeriveFoldable + , DeriveFunctor + , DeriveTraversable + , FlexibleContexts + , LambdaCase + , NoImplicitPrelude + , OverloadedStrings + , PackageImports + , RecordWildCards + , TupleSections + , ViewPatterns +#-} +-- | +-- This script updates CHANGELOG.md with the contents of CHANGELOG.d, and +-- empties CHANGELOG.d. It takes care of: +-- +-- * Sorting entries by the order in which their PRs were merged +-- * Appending (#1234 by @author) to the first line of each fragment, +-- optionally adding multiple PR numbers and/or authors as applicable +-- * Grouping entries by type and adding non-empty group headings to the +-- changelog +-- * Syncing any affected files to the Git index, preparing for you to make +-- your release commit +-- +-- Be sure to run this *after* updating the version number in +-- npm-package/package.json, as that's where this script gets the new section +-- header from. +-- + +module Main (main) where + +import Protolude hiding (intercalate, readFile, writeFile) +import qualified Protolude + +import Control.Monad.Fail (fail) +import qualified Data.Aeson as JSON +import Data.Attoparsec.ByteString (maybeResult, parse) +import "bifunctors" + Data.Bifunctor.Flip (Flip(..)) +import qualified Data.ByteString as BS +import qualified Data.HashMap.Lazy as HM +import qualified Data.List.NonEmpty as NEL +import Data.String (String) +import qualified Data.String as String +import qualified Data.Text as T +import Data.Time.Clock (UTCTime) +import Data.Time.Format.ISO8601 (iso8601ParseM) +import Data.Time.LocalTime (zonedTimeToUTC) +import GitHub.REST (GHEndpoint(..), GitHubState(..), KeyValue(..), MonadGitHubREST, StdMethod(..), queryGitHub, runGitHubT) +import qualified SimpleCmd.Git as IOGit +import System.Directory (setCurrentDirectory) +import System.FilePath (normalise, takeFileName, ()) + +main = runGitHubT gitHubState $ do + git "rev-parse" ["--show-toplevel"] >>= liftIO . setCurrentDirectory + entries <- String.lines <$> git "ls-tree" ["--name-only", "HEAD", "CHANGELOG.d/"] + + breaks <- processEntriesStartingWith "break" entries + features <- processEntriesStartingWith "feat" entries + fixes <- processEntriesStartingWith "fix" entries + internal <- processEntriesStartingWith "int" entries + misc <- processEntriesStartingWith "misc" entries + + unless (all null [breaks, features, fixes, internal, misc]) $ do + + version <- getVersion + (changelogPreamble, changelogRest) <- T.breakOn "\n## " <$> readFile "CHANGELOG.md" + writeFile "CHANGELOG.md" $ + changelogPreamble + <> "\n## " <> version <> "\n" + <> conditionalSection "Breaking changes" breaks + <> conditionalSection "New features" features + <> conditionalSection "Bugfixes" fixes + <> conditionalSection "Other improvements" misc + <> conditionalSection "Internal" internal + <> changelogRest + + git_ "add" ["CHANGELOG.md"] + git_ "rm" $ "-q" : (ceFile <$> breaks <> features <> fixes <> internal <> misc) + +gitHubState :: GitHubState +gitHubState = GitHubState Nothing "purescript/purescript update-changelog.hs" "v3" + +processEntriesStartingWith :: (MonadFail m, MonadGitHubREST m, MonadIO m) => String -> [String] -> m [ChangelogEntry] +processEntriesStartingWith prefix + = fmap (sortOn ceDate) + . traverse updateEntry + . filter ((prefix `isPrefixOf`) . map toLower . takeFileName) + +updateEntry :: (MonadFail m, MonadGitHubREST m, MonadIO m) => String -> m ChangelogEntry +updateEntry file = do + (header, body) <- T.breakOn "\n" <$> (readFile . normalise) file + + allCommits <- + fmap (NEL.fromList . sortOn glcTime) + . traverse (\(T.breakOn " " -> (h, T.breakOn " " . T.tail -> (c, s))) -> + GitLogCommit (T.tail s) h . zonedTimeToUTC <$> iso8601ParseM (toS c)) + =<< gitLines "log" ["-m", "--follow", "--format=%H %cI %s", file] + + prCommits <- + filterM isInterestingCommit + . mapMaybe (traverse parsePRNumber) + $ NEL.toList allCommits + + let prNumbers = map (snd . glcData) prCommits + + prAuthors <- ordNub <$> traverse lookupPRAuthor prNumbers + + let headerSuffix = if null prNumbers then "" else + " (" + <> commaSeparate (map (("#" <>) . show) prNumbers) + <> " by " + <> commaSeparate (map ("@" <>) prAuthors) + <> ")" + + pure $ ChangelogEntry file (header <> headerSuffix <> body) (glcTime $ NEL.head allCommits) + +parsePRNumber :: Text -> Maybe (CommitType, Int) +parsePRNumber = liftA2 (<|>) + (fmap (MergeCommit, ) . readMaybe . toS . fst . T.breakOn " " <=< T.stripPrefix "Merge pull request #") + (fmap (SquashCommit, ) . readMaybe . toS <=< T.stripSuffix ")" . snd . T.breakOnEnd "(#") + +-- | +-- This function helps us exclude PRs that are just fixups of changelog +-- wording. An interesting commit is one that has either edited a file that +-- isn't part of the changelog, or is a merge commit. +-- +isInterestingCommit :: MonadIO m => GitLogCommit (CommitType, Int) -> m Bool +isInterestingCommit GitLogCommit{..} = case fst glcData of + MergeCommit -> pure True + SquashCommit -> + not . all (\path -> "CHANGELOG.md" == path || "CHANGELOG.d/" `T.isPrefixOf` path) + <$> gitLines "show" ["--format=", "--name-only", toS glcHash] + +lookupPRAuthor :: (MonadFail m, MonadGitHubREST m) => Int -> m Text +lookupPRAuthor prNum = + queryGitHub GHEndpoint{ method = GET + , endpoint = "/repos/purescript/purescript/pulls/:pr" + , endpointVals = ["pr" := prNum] + , ghData = [] + } + >>= \case + JSON.Object (HM.lookup "user" -> Just (JSON.Object (HM.lookup "login" -> Just (JSON.String name)))) -> pure name + _ -> fail "error accessing GitHub API" + +commaSeparate :: [Text] -> Text +commaSeparate = \case + [] -> "" + [a] -> a + [a, b] -> a <> " and " <> b + more | Just (init, last) <- unsnoc more -> T.intercalate ", " init <> ", and " <> last + +getVersion :: (MonadFail m, MonadIO m) => m Text +getVersion = + (liftIO . BS.readFile) ("npm-package" "package.json") >>= \case + (maybeResult . parse JSON.json -> Just (JSON.Object (HM.lookup "version" -> Just (JSON.String v)))) -> pure v + _ -> fail "could not read version from npm-package/package.json" + +conditionalSection :: Text -> [ChangelogEntry] -> Text +conditionalSection header = \case + [] -> "" + entries -> + "\n" <> header <> ":\n\n" <> T.intercalate "\n" (map ceContent entries) + +git :: MonadIO m => String -> [String] -> m String +git cmd = liftIO . IOGit.git cmd + +git_ :: MonadIO m => String -> [String] -> m () +git_ cmd = liftIO . IOGit.git_ cmd + +gitLines :: MonadIO m => String -> [String] -> m [Text] +gitLines cmd args = lines . toS <$> git cmd args + +readFile :: MonadIO m => FilePath -> m Text +readFile = liftIO . Protolude.readFile + +writeFile :: MonadIO m => FilePath -> Text -> m () +writeFile path = liftIO . Protolude.writeFile path + +data ChangelogEntry = ChangelogEntry + { ceFile :: String + , ceContent :: Text + , ceDate :: UTCTime + } + +data GitLogCommit a = GitLogCommit + { glcData :: a + , glcHash :: Text + , glcTime :: UTCTime + } + deriving (Functor, Foldable, Traversable) + +data CommitType = MergeCommit | SquashCommit From 9865dd80796e17c22e7988926a98d993295d7576 Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Sun, 11 Jul 2021 15:02:24 -0400 Subject: [PATCH 2/2] fixup! Move unreleased changelog entries to CHANGELOG.d --- update-changelog.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/update-changelog.hs b/update-changelog.hs index 35f3404d6d..bb149ec903 100755 --- a/update-changelog.hs +++ b/update-changelog.hs @@ -64,7 +64,13 @@ main = runGitHubT gitHubState $ do internal <- processEntriesStartingWith "int" entries misc <- processEntriesStartingWith "misc" entries - unless (all null [breaks, features, fixes, internal, misc]) $ do + let entryFiles = ceFile <$> breaks <> features <> fixes <> internal <> misc + unless (null entryFiles) $ do + + changes <- git "status" ("-s" : "--" : "CHANGELOG.md" : entryFiles) + unless (null changes) . liftIO . die $ + "You have uncommitted changes to changelog files. " <> + "Please commit, stash, or revert them before running this script." version <- getVersion (changelogPreamble, changelogRest) <- T.breakOn "\n## " <$> readFile "CHANGELOG.md" @@ -79,7 +85,7 @@ main = runGitHubT gitHubState $ do <> changelogRest git_ "add" ["CHANGELOG.md"] - git_ "rm" $ "-q" : (ceFile <$> breaks <> features <> fixes <> internal <> misc) + git_ "rm" $ "-q" : entryFiles gitHubState :: GitHubState gitHubState = GitHubState Nothing "purescript/purescript update-changelog.hs" "v3" @@ -92,7 +98,7 @@ processEntriesStartingWith prefix updateEntry :: (MonadFail m, MonadGitHubREST m, MonadIO m) => String -> m ChangelogEntry updateEntry file = do - (header, body) <- T.breakOn "\n" <$> (readFile . normalise) file + (header, body) <- T.breakOn "\n" . T.strip <$> (readFile . normalise) file allCommits <- fmap (NEL.fromList . sortOn glcTime) @@ -116,7 +122,7 @@ updateEntry file = do <> commaSeparate (map ("@" <>) prAuthors) <> ")" - pure $ ChangelogEntry file (header <> headerSuffix <> body) (glcTime $ NEL.head allCommits) + pure $ ChangelogEntry file (header <> headerSuffix <> body <> "\n") (glcTime $ NEL.head allCommits) parsePRNumber :: Text -> Maybe (CommitType, Int) parsePRNumber = liftA2 (<|>)