mirror of
https://github.com/haskell/haskell-ide-engine.git
synced 2024-10-26 11:18:42 +03:00
Hack awful script for generating changelog
Need to tidy up but my flight is boarding now!
This commit is contained in:
parent
f478eddb3a
commit
315e360c87
40
GenChangelogs.hs
Executable file
40
GenChangelogs.hs
Executable file
@ -0,0 +1,40 @@
|
||||
#!/usr/bin/env cabal
|
||||
{- cabal:
|
||||
build-depends: base, process, html-conduit, http-conduit, xml-conduit, text
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
import Control.Monad
|
||||
import Data.Char
|
||||
import Data.List
|
||||
import qualified Data.Map.Lazy as M
|
||||
import Network.HTTP.Simple
|
||||
import System.Process
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Text.HTML.DOM
|
||||
import Text.XML.Cursor
|
||||
import Text.XML (Element(..))
|
||||
|
||||
main = do
|
||||
callCommand "git fetch --tags"
|
||||
tags <- filter (isPrefixOf "0.") . lines <$>
|
||||
readProcess "git" ["tag", "--list", "--sort=v:refname"] ""
|
||||
let lastTag = last tags
|
||||
messages <- lines <$>
|
||||
readProcess "git" ["log", last tags <> "..HEAD", "--merges", "--reverse", "--pretty=format:\"%s\""] ""
|
||||
|
||||
let prNums = map (filter isDigit) $ map head $ filter (not . null) $ map (filter (isPrefixOf "#") . words) messages
|
||||
prUrls = map ("https://github.com/haskell/haskell-ide-engine/pull/" <>) prNums
|
||||
|
||||
(flip mapM_) prUrls $ \url -> do
|
||||
body <- getResponseBody <$> httpLBS (parseRequest_ url)
|
||||
let cursor = fromDocument (parseLBS body)
|
||||
titles = (descendant >=> attributeIs "class" "js-issue-title" >=> child >=> content) cursor
|
||||
title = T.unpack $ T.strip $ head titles
|
||||
checkAuthor :: Element -> Bool
|
||||
checkAuthor e = maybe False (T.isInfixOf "author") (M.lookup "class" (elementAttributes e))
|
||||
authors = (descendant >=> checkElement checkAuthor >=> child >=> content) cursor
|
||||
author = T.unpack $ T.strip $ authors !! 2 -- second author is the pr author
|
||||
putStrLn $ "- [" <> title <> "](" <> url <> ") (@" <> author <> ")"
|
Loading…
Reference in New Issue
Block a user