{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Tools.Changelogs
  ( fetchChangeLog
  , formatChangeLog
  , ChangeLog
  ) where

import           Control.Arrow           (first, second, (&&&))
import qualified Control.Monad.Parallel  as P
import           Data.List               (foldl')
import qualified Data.List               as List
import qualified Data.List.Split         as List
import qualified Data.Map                as Map
import qualified Data.Maybe              as Maybe
import           Data.Text               (Text)
import qualified Data.Text               as Text
import qualified Data.Vector             as V
import           Debug.Trace             (traceIO)
import qualified GitHub
import           Network.HTTP.Client     (newManager)
import           Network.HTTP.Client.TLS (tlsManagerSettings)
import           Text.Read               (readMaybe)
-- import           Text.Groom              (groom)

import           GitHub.Tools.Requests


newtype ChangeLog = ChangeLog { ChangeLog -> [(Text, [Text], [Text])]
unChangeLog :: [(Text, [Text], [Text])] }


data VersionComponent
  = Number Int
  | Wildcard
  deriving (Eq VersionComponent
Eq VersionComponent
-> (VersionComponent -> VersionComponent -> Ordering)
-> (VersionComponent -> VersionComponent -> Bool)
-> (VersionComponent -> VersionComponent -> Bool)
-> (VersionComponent -> VersionComponent -> Bool)
-> (VersionComponent -> VersionComponent -> Bool)
-> (VersionComponent -> VersionComponent -> VersionComponent)
-> (VersionComponent -> VersionComponent -> VersionComponent)
-> Ord VersionComponent
VersionComponent -> VersionComponent -> Bool
VersionComponent -> VersionComponent -> Ordering
VersionComponent -> VersionComponent -> VersionComponent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VersionComponent -> VersionComponent -> VersionComponent
$cmin :: VersionComponent -> VersionComponent -> VersionComponent
max :: VersionComponent -> VersionComponent -> VersionComponent
$cmax :: VersionComponent -> VersionComponent -> VersionComponent
>= :: VersionComponent -> VersionComponent -> Bool
$c>= :: VersionComponent -> VersionComponent -> Bool
> :: VersionComponent -> VersionComponent -> Bool
$c> :: VersionComponent -> VersionComponent -> Bool
<= :: VersionComponent -> VersionComponent -> Bool
$c<= :: VersionComponent -> VersionComponent -> Bool
< :: VersionComponent -> VersionComponent -> Bool
$c< :: VersionComponent -> VersionComponent -> Bool
compare :: VersionComponent -> VersionComponent -> Ordering
$ccompare :: VersionComponent -> VersionComponent -> Ordering
$cp1Ord :: Eq VersionComponent
Ord, VersionComponent -> VersionComponent -> Bool
(VersionComponent -> VersionComponent -> Bool)
-> (VersionComponent -> VersionComponent -> Bool)
-> Eq VersionComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionComponent -> VersionComponent -> Bool
$c/= :: VersionComponent -> VersionComponent -> Bool
== :: VersionComponent -> VersionComponent -> Bool
$c== :: VersionComponent -> VersionComponent -> Bool
Eq)


instance Read VersionComponent where
  readsPrec :: Int -> ReadS VersionComponent
readsPrec Int
_ (Char
'x':[Char]
s) = [(VersionComponent
Wildcard, [Char]
s)]
  readsPrec Int
p [Char]
input   = ((Int, [Char]) -> (VersionComponent, [Char]))
-> [(Int, [Char])] -> [(VersionComponent, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> VersionComponent)
-> (Int, [Char]) -> (VersionComponent, [Char])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Int -> VersionComponent
Number) ([(Int, [Char])] -> [(VersionComponent, [Char])])
-> ([Char] -> [(Int, [Char])]) -> ReadS VersionComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [(Int, [Char])]
forall a. Read a => Int -> ReadS a
readsPrec Int
p ReadS VersionComponent -> ReadS VersionComponent
forall a b. (a -> b) -> a -> b
$ [Char]
input


data Version
  = VersionNumber [VersionComponent]
  | VersionString Text
  deriving (Eq Version
Eq Version
-> (Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmax :: Version -> Version -> Version
>= :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c< :: Version -> Version -> Bool
compare :: Version -> Version -> Ordering
$ccompare :: Version -> Version -> Ordering
$cp1Ord :: Eq Version
Ord, Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq)


formatChangeLog :: Bool -> ChangeLog -> Text
formatChangeLog :: Bool -> ChangeLog -> Text
formatChangeLog Bool
wantRoadmap =
  (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") (Text -> Text) -> (ChangeLog -> Text) -> ChangeLog -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text) -> Text -> [Text] -> Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"" ([Text] -> Text) -> (ChangeLog -> [Text]) -> ChangeLog -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, [Text], [Text]) -> Text)
-> [(Text, [Text], [Text])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [Text], [Text]) -> Text
formatMilestone ([(Text, [Text], [Text])] -> [Text])
-> (ChangeLog -> [(Text, [Text], [Text])]) -> ChangeLog -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangeLog -> [(Text, [Text], [Text])]
unChangeLog
  where
    prsWord :: Text
prsWord    = if Bool
wantRoadmap then Text
"PRs to review" else Text
"Merged PRs"
    issuesWord :: Text
issuesWord = if Bool
wantRoadmap then Text
"Planned tasks" else Text
"Closed issues"

    formatMilestone :: (Text, [Text], [Text]) -> Text
formatMilestone (Text
milestone, [Text]
issues, [Text]
pulls) =
      Text
"\n\n## " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
milestone
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
mergedPrs [Text]
pulls
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
closedIssues [Text]
issues

    mergedPrs :: [Text] -> Text
mergedPrs [] = Text
""
    mergedPrs [Text]
pulls =
      (Text -> Text -> Text) -> Text -> [Text] -> Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) (Text
"\n\n### " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prsWord Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":\n") ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
itemise ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
pulls

    closedIssues :: [Text] -> Text
closedIssues [] = Text
""
    closedIssues [Text]
issues =
      (Text -> Text -> Text) -> Text -> [Text] -> Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) (Text
"\n\n### " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
issuesWord Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":\n") ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
itemise ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
issues

    itemise :: [Text] -> [Text]
itemise = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"\n- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)


data ChangeLogItemKind
  = Issue
  | PullRequest
  deriving Int -> ChangeLogItemKind -> ShowS
[ChangeLogItemKind] -> ShowS
ChangeLogItemKind -> [Char]
(Int -> ChangeLogItemKind -> ShowS)
-> (ChangeLogItemKind -> [Char])
-> ([ChangeLogItemKind] -> ShowS)
-> Show ChangeLogItemKind
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ChangeLogItemKind] -> ShowS
$cshowList :: [ChangeLogItemKind] -> ShowS
show :: ChangeLogItemKind -> [Char]
$cshow :: ChangeLogItemKind -> [Char]
showsPrec :: Int -> ChangeLogItemKind -> ShowS
$cshowsPrec :: Int -> ChangeLogItemKind -> ShowS
Show


data ChangeLogItem = ChangeLogItem
  { ChangeLogItem -> Text
clMilestone :: Text
  , ChangeLogItem -> Text
clTitle     :: Text
  , ChangeLogItem -> Int
clNumber    :: Int
  }


groupByMilestone
  :: (ChangeLogItem -> ([a], [a]) -> ([a], [a]))
  -> [ChangeLogItem]
  -> Map.Map Text ([a], [a])
  -> Map.Map Text ([a], [a])
groupByMilestone :: (ChangeLogItem -> ([a], [a]) -> ([a], [a]))
-> [ChangeLogItem] -> Map Text ([a], [a]) -> Map Text ([a], [a])
groupByMilestone ChangeLogItem -> ([a], [a]) -> ([a], [a])
add = (Map Text ([a], [a]) -> [ChangeLogItem] -> Map Text ([a], [a]))
-> [ChangeLogItem] -> Map Text ([a], [a]) -> Map Text ([a], [a])
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Map Text ([a], [a]) -> [ChangeLogItem] -> Map Text ([a], [a]))
 -> [ChangeLogItem] -> Map Text ([a], [a]) -> Map Text ([a], [a]))
-> (Map Text ([a], [a]) -> [ChangeLogItem] -> Map Text ([a], [a]))
-> [ChangeLogItem]
-> Map Text ([a], [a])
-> Map Text ([a], [a])
forall a b. (a -> b) -> a -> b
$ (ChangeLogItem -> Map Text ([a], [a]) -> Map Text ([a], [a]))
-> Map Text ([a], [a]) -> [ChangeLogItem] -> Map Text ([a], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ChangeLogItem
item Map Text ([a], [a])
group ->
    Text -> ([a], [a]) -> Map Text ([a], [a]) -> Map Text ([a], [a])
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ChangeLogItem -> Text
clMilestone ChangeLogItem
item) (
        case Text -> Map Text ([a], [a]) -> Maybe ([a], [a])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ChangeLogItem -> Text
clMilestone ChangeLogItem
item) Map Text ([a], [a])
group of
          Just ([a], [a])
old -> ChangeLogItem -> ([a], [a]) -> ([a], [a])
add ChangeLogItem
item ([a], [a])
old
          Maybe ([a], [a])
Nothing  -> ChangeLogItem -> ([a], [a]) -> ([a], [a])
add ChangeLogItem
item ([], [])
      ) Map Text ([a], [a])
group)


formatChangeLogItem
  :: ChangeLogItemKind
  -> GitHub.Name GitHub.Owner
  -> GitHub.Name GitHub.Repo
  -> ChangeLogItem
  -> Text
formatChangeLogItem :: ChangeLogItemKind
-> Name Owner -> Name Repo -> ChangeLogItem -> Text
formatChangeLogItem ChangeLogItemKind
kind Name Owner
ownerName Name Repo
repoName ChangeLogItem
item =
  Text
"[#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
number Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"](https://github.com/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name Owner -> Text
forall entity. Name entity -> Text
GitHub.untagName Name Owner
ownerName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
  Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name Repo -> Text
forall entity. Name entity -> Text
GitHub.untagName Name Repo
repoName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
kindPart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
number Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
  ChangeLogItem -> Text
clTitle ChangeLogItem
item
  where
    number :: Text
number = [Char] -> Text
Text.pack ([Char] -> Text)
-> (ChangeLogItem -> [Char]) -> ChangeLogItem -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char])
-> (ChangeLogItem -> Int) -> ChangeLogItem -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangeLogItem -> Int
clNumber (ChangeLogItem -> Text) -> ChangeLogItem -> Text
forall a b. (a -> b) -> a -> b
$ ChangeLogItem
item
    kindPart :: Text
kindPart =
      case ChangeLogItemKind
kind of
        ChangeLogItemKind
Issue       -> Text
"/issues/"
        ChangeLogItemKind
PullRequest -> Text
"/pull/"


makeChangeLog
  :: Bool
  -> GitHub.Name GitHub.Owner
  -> GitHub.Name GitHub.Repo
  -> [GitHub.SimplePullRequest]
  -> [GitHub.Issue]
  -> ChangeLog
makeChangeLog :: Bool
-> Name Owner
-> Name Repo
-> [SimplePullRequest]
-> [Issue]
-> ChangeLog
makeChangeLog Bool
wantRoadmap Name Owner
ownerName Name Repo
repoName [SimplePullRequest]
pulls [Issue]
issues =
  [(Text, [Text], [Text])] -> ChangeLog
ChangeLog
  ([(Text, [Text], [Text])] -> ChangeLog)
-> (Map Text ([ChangeLogItem], [ChangeLogItem])
    -> [(Text, [Text], [Text])])
-> Map Text ([ChangeLogItem], [ChangeLogItem])
-> ChangeLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, [Text], [Text])] -> [(Text, [Text], [Text])]
forall a. [a] -> [a]
reverseIfChangelog
  ([(Text, [Text], [Text])] -> [(Text, [Text], [Text])])
-> (Map Text ([ChangeLogItem], [ChangeLogItem])
    -> [(Text, [Text], [Text])])
-> Map Text ([ChangeLogItem], [ChangeLogItem])
-> [(Text, [Text], [Text])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, [Text], [Text])] -> [(Text, [Text], [Text])]
sortChangelog
  ([(Text, [Text], [Text])] -> [(Text, [Text], [Text])])
-> (Map Text ([ChangeLogItem], [ChangeLogItem])
    -> [(Text, [Text], [Text])])
-> Map Text ([ChangeLogItem], [ChangeLogItem])
-> [(Text, [Text], [Text])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, [Text], [Text])]
 -> Text
 -> ([ChangeLogItem], [ChangeLogItem])
 -> [(Text, [Text], [Text])])
-> [(Text, [Text], [Text])]
-> Map Text ([ChangeLogItem], [ChangeLogItem])
-> [(Text, [Text], [Text])]
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey (\[(Text, [Text], [Text])]
changes Text
milestone ([ChangeLogItem]
msIssues, [ChangeLogItem]
msPulls) ->
      if Text
milestone Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"meta"
        then [(Text, [Text], [Text])]
changes
        else
          ( Text
milestone
          , (ChangeLogItem -> Text) -> [ChangeLogItem] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ChangeLogItemKind
-> Name Owner -> Name Repo -> ChangeLogItem -> Text
formatChangeLogItem ChangeLogItemKind
Issue       Name Owner
ownerName Name Repo
repoName) [ChangeLogItem]
msIssues
          , (ChangeLogItem -> Text) -> [ChangeLogItem] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ChangeLogItemKind
-> Name Owner -> Name Repo -> ChangeLogItem -> Text
formatChangeLogItem ChangeLogItemKind
PullRequest Name Owner
ownerName Name Repo
repoName) [ChangeLogItem]
msPulls
          ) (Text, [Text], [Text])
-> [(Text, [Text], [Text])] -> [(Text, [Text], [Text])]
forall a. a -> [a] -> [a]
: [(Text, [Text], [Text])]
changes
    ) []
  (Map Text ([ChangeLogItem], [ChangeLogItem])
 -> [(Text, [Text], [Text])])
-> (Map Text ([ChangeLogItem], [ChangeLogItem])
    -> Map Text ([ChangeLogItem], [ChangeLogItem]))
-> Map Text ([ChangeLogItem], [ChangeLogItem])
-> [(Text, [Text], [Text])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChangeLogItem
 -> ([ChangeLogItem], [ChangeLogItem])
 -> ([ChangeLogItem], [ChangeLogItem]))
-> [ChangeLogItem]
-> Map Text ([ChangeLogItem], [ChangeLogItem])
-> Map Text ([ChangeLogItem], [ChangeLogItem])
forall a.
(ChangeLogItem -> ([a], [a]) -> ([a], [a]))
-> [ChangeLogItem] -> Map Text ([a], [a]) -> Map Text ([a], [a])
groupByMilestone (([ChangeLogItem] -> [ChangeLogItem])
-> ([ChangeLogItem], [ChangeLogItem])
-> ([ChangeLogItem], [ChangeLogItem])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first  (([ChangeLogItem] -> [ChangeLogItem])
 -> ([ChangeLogItem], [ChangeLogItem])
 -> ([ChangeLogItem], [ChangeLogItem]))
-> (ChangeLogItem -> [ChangeLogItem] -> [ChangeLogItem])
-> ChangeLogItem
-> ([ChangeLogItem], [ChangeLogItem])
-> ([ChangeLogItem], [ChangeLogItem])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)) [ChangeLogItem]
changeLogIssues
  (Map Text ([ChangeLogItem], [ChangeLogItem])
 -> Map Text ([ChangeLogItem], [ChangeLogItem]))
-> (Map Text ([ChangeLogItem], [ChangeLogItem])
    -> Map Text ([ChangeLogItem], [ChangeLogItem]))
-> Map Text ([ChangeLogItem], [ChangeLogItem])
-> Map Text ([ChangeLogItem], [ChangeLogItem])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChangeLogItem
 -> ([ChangeLogItem], [ChangeLogItem])
 -> ([ChangeLogItem], [ChangeLogItem]))
-> [ChangeLogItem]
-> Map Text ([ChangeLogItem], [ChangeLogItem])
-> Map Text ([ChangeLogItem], [ChangeLogItem])
forall a.
(ChangeLogItem -> ([a], [a]) -> ([a], [a]))
-> [ChangeLogItem] -> Map Text ([a], [a]) -> Map Text ([a], [a])
groupByMilestone (([ChangeLogItem] -> [ChangeLogItem])
-> ([ChangeLogItem], [ChangeLogItem])
-> ([ChangeLogItem], [ChangeLogItem])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([ChangeLogItem] -> [ChangeLogItem])
 -> ([ChangeLogItem], [ChangeLogItem])
 -> ([ChangeLogItem], [ChangeLogItem]))
-> (ChangeLogItem -> [ChangeLogItem] -> [ChangeLogItem])
-> ChangeLogItem
-> ([ChangeLogItem], [ChangeLogItem])
-> ([ChangeLogItem], [ChangeLogItem])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)) [ChangeLogItem]
changeLogPrs
  (Map Text ([ChangeLogItem], [ChangeLogItem]) -> ChangeLog)
-> Map Text ([ChangeLogItem], [ChangeLogItem]) -> ChangeLog
forall a b. (a -> b) -> a -> b
$ Map Text ([ChangeLogItem], [ChangeLogItem])
forall k a. Map k a
Map.empty
  where
    reverseIfChangelog :: [a] -> [a]
reverseIfChangelog [a]
l =
      if Bool
wantRoadmap
        then [a]
l
        else [a] -> [a]
forall a. [a] -> [a]
reverse [a]
l

    sortChangelog :: [(Text, [Text], [Text])] -> [(Text, [Text], [Text])]
    sortChangelog :: [(Text, [Text], [Text])] -> [(Text, [Text], [Text])]
sortChangelog = ((Text, [Text], [Text]) -> Version)
-> [(Text, [Text], [Text])] -> [(Text, [Text], [Text])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (((Text, [Text], [Text]) -> Version)
 -> [(Text, [Text], [Text])] -> [(Text, [Text], [Text])])
-> ((Text, [Text], [Text]) -> Version)
-> [(Text, [Text], [Text])]
-> [(Text, [Text], [Text])]
forall a b. (a -> b) -> a -> b
$ \(Text
v, [Text]
_, [Text]
_) -> Text -> Version
parseVersion Text
v

    parseVersion :: Text -> Version
    parseVersion :: Text -> Version
parseVersion Text
v =
        case Text -> [Char]
Text.unpack Text
v of
            -- Milestones starting with "v" must be versions.
            Char
'v':[Char]
version ->
                case ([Char] -> Maybe VersionComponent)
-> [[Char]] -> [Maybe VersionComponent]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Maybe VersionComponent
forall a. Read a => [Char] -> Maybe a
readMaybe ([[Char]] -> [Maybe VersionComponent])
-> [[Char]] -> [Maybe VersionComponent]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
List.splitOn [Char]
"." [Char]
version of
                  [Just VersionComponent
major, Just VersionComponent
minor, Just VersionComponent
rev] -> [VersionComponent] -> Version
VersionNumber [VersionComponent
major, VersionComponent
minor, VersionComponent
rev]
                  [Maybe VersionComponent]
_ -> [Char] -> Version
forall a. HasCallStack => [Char] -> a
error ([Char] -> Version) -> [Char] -> Version
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid version: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
version
            [Char]
_ -> Text -> Version
VersionString Text
v

    ([SimplePullRequest]
mergedPrs, [SimplePullRequest]
openPrs) = (SimplePullRequest -> Bool)
-> [SimplePullRequest]
-> ([SimplePullRequest], [SimplePullRequest])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (\case
        GitHub.SimplePullRequest
          { simplePullRequestMergedAt :: SimplePullRequest -> Maybe UTCTime
GitHub.simplePullRequestMergedAt = Just UTCTime
_ } -> Bool
True
        SimplePullRequest
_                                               -> Bool
False
      ) [SimplePullRequest]
pulls

    selectedPrs :: [SimplePullRequest]
selectedPrs =
      if Bool
wantRoadmap
        then [SimplePullRequest]
openPrs
        else [SimplePullRequest]
mergedPrs

    selectedItems :: [Issue]
selectedItems = (Issue -> Bool) -> [Issue] -> [Issue]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case
        GitHub.Issue
          { issueMilestone :: Issue -> Maybe Milestone
GitHub.issueMilestone = Just GitHub.Milestone
            { milestoneState :: Milestone -> Text
GitHub.milestoneState = Text
state }
          } ->
            if Bool
wantRoadmap
              then Text
state Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"open"
              else Text
state Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"closed"
        Issue
_ -> Bool
False
      ) [Issue]
issues

    ([Issue]
backlogPrs, [Issue]
backlogIssues) =
      if Bool
wantRoadmap
        then
            -- Split into PRs and non-PR issues.
            (Issue -> Bool) -> [Issue] -> ([Issue], [Issue])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (\case
              GitHub.Issue { issuePullRequest :: Issue -> Maybe PullRequestReference
GitHub.issuePullRequest = Just PullRequestReference
_ } -> Bool
True
              Issue
_                                                 -> Bool
False
            )
            -- Filter by issues that don't have a milestone.
          ([Issue] -> ([Issue], [Issue]))
-> ([Issue] -> [Issue]) -> [Issue] -> ([Issue], [Issue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Issue -> Bool) -> [Issue] -> [Issue]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case
              GitHub.Issue { issueMilestone :: Issue -> Maybe Milestone
GitHub.issueMilestone = Maybe Milestone
Nothing } -> Bool
True
              Issue
_                                                -> Bool
False
            )
          ([Issue] -> ([Issue], [Issue])) -> [Issue] -> ([Issue], [Issue])
forall a b. (a -> b) -> a -> b
$ [Issue]
issues
        else
          ([], [])

    addToBacklog :: [Issue] -> [ChangeLogItem]
addToBacklog =
      (Issue -> ChangeLogItem) -> [Issue] -> [ChangeLogItem]
forall a b. (a -> b) -> [a] -> [b]
map ((Issue -> ChangeLogItem) -> [Issue] -> [ChangeLogItem])
-> (Issue -> ChangeLogItem) -> [Issue] -> [ChangeLogItem]
forall a b. (a -> b) -> a -> b
$ \Issue
issue -> ChangeLogItem :: Text -> Text -> Int -> ChangeLogItem
ChangeLogItem
        { clMilestone :: Text
clMilestone = Text
"Backlog"
        , clTitle :: Text
clTitle     = Issue -> Text
GitHub.issueTitle Issue
issue
        , clNumber :: Int
clNumber    = IssueNumber -> Int
GitHub.unIssueNumber (IssueNumber -> Int) -> IssueNumber -> Int
forall a b. (a -> b) -> a -> b
$ Issue -> IssueNumber
GitHub.issueNumber Issue
issue
        }

    backlogPrItems :: [ChangeLogItem]
backlogPrItems    = [Issue] -> [ChangeLogItem]
addToBacklog [Issue]
backlogPrs
    backlogIssueItems :: [ChangeLogItem]
backlogIssueItems = [Issue] -> [ChangeLogItem]
addToBacklog [Issue]
backlogIssues

    milestoneByIssueId :: Map IssueNumber Text
milestoneByIssueId =
      [(IssueNumber, Text)] -> Map IssueNumber Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      ([(IssueNumber, Text)] -> Map IssueNumber Text)
-> ([Issue] -> [(IssueNumber, Text)])
-> [Issue]
-> Map IssueNumber Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Issue -> (IssueNumber, Text)) -> [Issue] -> [(IssueNumber, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Issue -> IssueNumber
GitHub.issueNumber (Issue -> IssueNumber)
-> (Issue -> Text) -> Issue -> (IssueNumber, Text)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Milestone -> Text
GitHub.milestoneTitle (Milestone -> Text) -> (Issue -> Milestone) -> Issue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Milestone -> Milestone
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust (Maybe Milestone -> Milestone)
-> (Issue -> Maybe Milestone) -> Issue -> Milestone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Issue -> Maybe Milestone
GitHub.issueMilestone)
      ([Issue] -> Map IssueNumber Text)
-> [Issue] -> Map IssueNumber Text
forall a b. (a -> b) -> a -> b
$ [Issue]
selectedItems

    changeLogIssues :: [ChangeLogItem]
    changeLogIssues :: [ChangeLogItem]
changeLogIssues = [ChangeLogItem]
backlogIssueItems [ChangeLogItem] -> [ChangeLogItem] -> [ChangeLogItem]
forall a. [a] -> [a] -> [a]
++ (Issue -> Maybe ChangeLogItem) -> [Issue] -> [ChangeLogItem]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (\case
        -- filter out PRs
        GitHub.Issue { issuePullRequest :: Issue -> Maybe PullRequestReference
GitHub.issuePullRequest = Just PullRequestReference
_ } -> Maybe ChangeLogItem
forall a. Maybe a
Nothing
        Issue
issue -> ChangeLogItem -> Maybe ChangeLogItem
forall a. a -> Maybe a
Just ChangeLogItem :: Text -> Text -> Int -> ChangeLogItem
ChangeLogItem
          { clMilestone :: Text
clMilestone = Milestone -> Text
GitHub.milestoneTitle (Milestone -> Text) -> (Issue -> Milestone) -> Issue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Milestone -> Milestone
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust (Maybe Milestone -> Milestone)
-> (Issue -> Maybe Milestone) -> Issue -> Milestone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Issue -> Maybe Milestone
GitHub.issueMilestone (Issue -> Text) -> Issue -> Text
forall a b. (a -> b) -> a -> b
$ Issue
issue
          , clTitle :: Text
clTitle     = Issue -> Text
GitHub.issueTitle Issue
issue
          , clNumber :: Int
clNumber    = IssueNumber -> Int
GitHub.unIssueNumber (IssueNumber -> Int) -> IssueNumber -> Int
forall a b. (a -> b) -> a -> b
$ Issue -> IssueNumber
GitHub.issueNumber Issue
issue
          }
      ) [Issue]
selectedItems

    changeLogPrs :: [ChangeLogItem]
    changeLogPrs :: [ChangeLogItem]
changeLogPrs = [ChangeLogItem]
backlogPrItems [ChangeLogItem] -> [ChangeLogItem] -> [ChangeLogItem]
forall a. [a] -> [a] -> [a]
++ (SimplePullRequest -> Maybe ChangeLogItem)
-> [SimplePullRequest] -> [ChangeLogItem]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (\SimplePullRequest
issue -> do
        Text
milestone <- (IssueNumber -> Map IssueNumber Text -> Maybe Text)
-> Map IssueNumber Text -> IssueNumber -> Maybe Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip IssueNumber -> Map IssueNumber Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map IssueNumber Text
milestoneByIssueId (IssueNumber -> Maybe Text)
-> (SimplePullRequest -> IssueNumber)
-> SimplePullRequest
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimplePullRequest -> IssueNumber
GitHub.simplePullRequestNumber (SimplePullRequest -> Maybe Text)
-> SimplePullRequest -> Maybe Text
forall a b. (a -> b) -> a -> b
$ SimplePullRequest
issue
        ChangeLogItem -> Maybe ChangeLogItem
forall (m :: * -> *) a. Monad m => a -> m a
return ChangeLogItem :: Text -> Text -> Int -> ChangeLogItem
ChangeLogItem
          { clMilestone :: Text
clMilestone = Text
milestone
          , clTitle :: Text
clTitle     = SimplePullRequest -> Text
GitHub.simplePullRequestTitle SimplePullRequest
issue
          , clNumber :: Int
clNumber    = IssueNumber -> Int
GitHub.unIssueNumber (IssueNumber -> Int) -> IssueNumber -> Int
forall a b. (a -> b) -> a -> b
$ SimplePullRequest -> IssueNumber
GitHub.simplePullRequestNumber SimplePullRequest
issue
          }
      ) [SimplePullRequest]
selectedPrs


fetchChangeLog
  :: Bool
  -> GitHub.Name GitHub.Owner
  -> GitHub.Name GitHub.Repo
  -> Maybe GitHub.Auth
  -> IO ChangeLog
fetchChangeLog :: Bool -> Name Owner -> Name Repo -> Maybe Auth -> IO ChangeLog
fetchChangeLog Bool
wantRoadmap Name Owner
ownerName Name Repo
repoName Maybe Auth
auth = do
  -- Initialise HTTP manager so we can benefit from keep-alive connections.
  Manager
mgr <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings

  let fetchPulls :: PullRequestMod -> IO [SimplePullRequest]
fetchPulls PullRequestMod
state = do
          [Char] -> IO ()
traceIO ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Fetching pull requests"
          [SimplePullRequest]
l <- Vector SimplePullRequest -> [SimplePullRequest]
forall a. Vector a -> [a]
V.toList (Vector SimplePullRequest -> [SimplePullRequest])
-> IO (Vector SimplePullRequest) -> IO [SimplePullRequest]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Auth
-> Manager
-> Request 'RO (Vector SimplePullRequest)
-> IO (Vector SimplePullRequest)
forall a.
FromJSON a =>
Maybe Auth -> Manager -> Request 'RO a -> IO a
request Maybe Auth
auth Manager
mgr (Name Owner
-> Name Repo
-> PullRequestMod
-> FetchCount
-> Request 'RO (Vector SimplePullRequest)
forall (k :: RW).
Name Owner
-> Name Repo
-> PullRequestMod
-> FetchCount
-> Request k (Vector SimplePullRequest)
GitHub.pullRequestsForR Name Owner
ownerName Name Repo
repoName PullRequestMod
state FetchCount
GitHub.FetchAll)
          [Char] -> IO ()
traceIO ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Got " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show ([SimplePullRequest] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SimplePullRequest]
l) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" pull requests"
          [SimplePullRequest] -> IO [SimplePullRequest]
forall (m :: * -> *) a. Monad m => a -> m a
return [SimplePullRequest]
l
  let fetchIssues :: IssueRepoMod -> IO [Issue]
fetchIssues IssueRepoMod
state = do
          [Char] -> IO ()
traceIO ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Fetching issues"
          [Issue]
l <- Vector Issue -> [Issue]
forall a. Vector a -> [a]
V.toList (Vector Issue -> [Issue]) -> IO (Vector Issue) -> IO [Issue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Auth
-> Manager -> Request 'RO (Vector Issue) -> IO (Vector Issue)
forall a.
FromJSON a =>
Maybe Auth -> Manager -> Request 'RO a -> IO a
request Maybe Auth
auth Manager
mgr (Name Owner
-> Name Repo
-> IssueRepoMod
-> FetchCount
-> Request 'RO (Vector Issue)
forall (k :: RW).
Name Owner
-> Name Repo
-> IssueRepoMod
-> FetchCount
-> Request k (Vector Issue)
GitHub.issuesForRepoR   Name Owner
ownerName Name Repo
repoName IssueRepoMod
state FetchCount
GitHub.FetchAll)
          [Char] -> IO ()
traceIO ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Got " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show ([Issue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Issue]
l) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" issues"
          [Issue] -> IO [Issue]
forall (m :: * -> *) a. Monad m => a -> m a
return [Issue]
l

  -- issues >>= putStrLn . groom

  ([SimplePullRequest]
pulls, [Issue]
issues) <- (IO [SimplePullRequest]
 -> IO [Issue] -> IO ([SimplePullRequest], [Issue]))
-> (IO [SimplePullRequest], IO [Issue])
-> IO ([SimplePullRequest], [Issue])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([SimplePullRequest]
 -> [Issue] -> IO ([SimplePullRequest], [Issue]))
-> IO [SimplePullRequest]
-> IO [Issue]
-> IO ([SimplePullRequest], [Issue])
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> m c) -> m a -> m b -> m c
P.bindM2 (\[SimplePullRequest]
p [Issue]
i -> ([SimplePullRequest], [Issue]) -> IO ([SimplePullRequest], [Issue])
forall (m :: * -> *) a. Monad m => a -> m a
return ([SimplePullRequest]
p, [Issue]
i))) ((IO [SimplePullRequest], IO [Issue])
 -> IO ([SimplePullRequest], [Issue]))
-> (IO [SimplePullRequest], IO [Issue])
-> IO ([SimplePullRequest], [Issue])
forall a b. (a -> b) -> a -> b
$
          if Bool
wantRoadmap
             then (PullRequestMod -> IO [SimplePullRequest]
fetchPulls PullRequestMod
forall mod. HasState mod => mod
GitHub.stateOpen  , IssueRepoMod -> IO [Issue]
fetchIssues IssueRepoMod
forall mod. HasState mod => mod
GitHub.stateOpen  )
             else (PullRequestMod -> IO [SimplePullRequest]
fetchPulls PullRequestMod
forall mod. HasState mod => mod
GitHub.stateClosed, IssueRepoMod -> IO [Issue]
fetchIssues IssueRepoMod
forall mod. HasState mod => mod
GitHub.stateClosed)

  [Char] -> IO ()
traceIO [Char]
"Formatting changelog/roadmap"
  ChangeLog -> IO ChangeLog
forall (m :: * -> *) a. Monad m => a -> m a
return (ChangeLog -> IO ChangeLog) -> ChangeLog -> IO ChangeLog
forall a b. (a -> b) -> a -> b
$ Bool
-> Name Owner
-> Name Repo
-> [SimplePullRequest]
-> [Issue]
-> ChangeLog
makeChangeLog Bool
wantRoadmap Name Owner
ownerName Name Repo
repoName [SimplePullRequest]
pulls [Issue]
issues