2020-09-02 22:50:14 +03:00
|
|
|
#!/usr/bin/env cabal
|
|
|
|
{- cabal:
|
2021-11-28 15:54:17 +03:00
|
|
|
build-depends: base, bytestring, process, text, github, time >= 1.9
|
2020-09-02 22:50:14 +03:00
|
|
|
-}
|
|
|
|
|
2021-02-25 05:34:35 +03:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
2020-09-02 22:50:14 +03:00
|
|
|
|
2021-02-25 05:34:35 +03:00
|
|
|
import Control.Monad
|
2021-11-28 15:54:17 +03:00
|
|
|
import qualified Data.ByteString.Char8 as BS
|
2021-02-25 05:34:35 +03:00
|
|
|
import Data.List
|
|
|
|
import Data.Maybe
|
|
|
|
import qualified Data.Text as T
|
|
|
|
import Data.Time.Format.ISO8601
|
|
|
|
import Data.Time.LocalTime
|
|
|
|
import GitHub
|
2021-11-28 15:54:17 +03:00
|
|
|
import System.Environment
|
2021-02-25 05:34:35 +03:00
|
|
|
import System.Process
|
2020-09-02 22:50:14 +03:00
|
|
|
|
|
|
|
main = do
|
|
|
|
callCommand "git fetch --tags"
|
2021-06-12 22:40:50 +03:00
|
|
|
tags <- filter (isPrefixOf "1.") . lines <$>
|
2020-09-02 22:50:14 +03:00
|
|
|
readProcess "git" ["tag", "--list", "--sort=v:refname"] ""
|
|
|
|
|
2020-10-03 16:45:05 +03:00
|
|
|
lastDateStr <- last . lines <$> readProcess "git" ["show", "-s", "--format=%cI", "-1", last tags] ""
|
|
|
|
lastDate <- zonedTimeToUTC <$> iso8601ParseM lastDateStr
|
|
|
|
|
2021-11-28 15:54:17 +03:00
|
|
|
args <- getArgs
|
|
|
|
let githubReq = case args of
|
|
|
|
[] -> github'
|
|
|
|
token:_ -> github (OAuth $ BS.pack token)
|
|
|
|
prs <- githubReq $ pullRequestsForR "haskell" "haskell-language-server" stateClosed FetchAll
|
2020-10-03 18:21:14 +03:00
|
|
|
let prsAfterLastTag = either (error . show)
|
2021-02-19 09:33:21 +03:00
|
|
|
(foldMap (\pr -> [pr | inRange pr]))
|
2020-10-03 16:45:05 +03:00
|
|
|
prs
|
|
|
|
inRange pr
|
|
|
|
| Just mergedDate <- simplePullRequestMergedAt pr = mergedDate > lastDate
|
|
|
|
| otherwise = False
|
|
|
|
|
|
|
|
forM_ prsAfterLastTag $ \SimplePullRequest{..} ->
|
|
|
|
putStrLn $ T.unpack $ "- " <> simplePullRequestTitle <>
|
2021-02-18 04:48:40 +03:00
|
|
|
"\n([#" <> T.pack (show $ unIssueNumber simplePullRequestNumber) <> "](" <> getUrl simplePullRequestHtmlUrl <> "))" <>
|
2021-01-18 17:51:44 +03:00
|
|
|
" by @" <> untagName (simpleUserLogin simplePullRequestUser)
|