-- * Configuration
["invalid-email-address"]
-- * Main
do
-- Get the GitHub authentication token from `GITHUB_TOKEN`
auth <- getAuth
-- Read the current set of authors from `authorDir`
authors <- readAuthors authorDir
-- Read the current set of contributors from `contributorDir`
localContributors <- readContributors contributorDir
remoteContributorAndAuthors <-
getContributors auth (GH.mkOwnerName githubOwner) (GH.mkRepoName githubRepo)
-- Filter the contributor list by the authors
let authorGithubs :: [Text]
authorGithubs = mapMaybe authorGithub authors
let isAuthorOrError :: Contributor -> Bool
isAuthorOrError Contributor {..} =
contributorGithub `elem` authorGithubs || contributorGithub `elem` githubErrors
let remoteContributors :: [Contributor]
remoteContributors = filter (not . isAuthorOrError) remoteContributorAndAuthors
-- Turn contributor lists into maps and merge them
let localContributorMap :: Map Text Contributor
localContributorMap = M.fromList [(contributorGithub c, c) | c <- localContributors]
let remoteContributorMap :: Map Text Contributor
remoteContributorMap = M.fromList [(contributorGithub c, c) | c <- remoteContributors]
let contributorMap :: Map Text Contributor
contributorMap = M.unionWith (<>) localContributorMap remoteContributorMap
-- Write contributor files
createDirectoryIfMissing True contributorDir
forM_ (M.toList contributorMap) $ \(github, contributor) -> do
let contributorFile = contributorDir </> T.unpack github <.> "yml"
let contributorBS = Y.encode contributor
BC.writeFile contributorFile contributorBS
-- * Authors
do
authorFiles <- getDirectoryFilesIO authorDir ["*.yml"]
authors <- traverse (\src -> readYamlIO $ authorDir </> src) authorFiles
return (authors :: [Author])
-- * Contributors
do
contributorFiles <- getDirectoryFilesIO contributorDir ["*.yml"]
contributors <- traverse (\src -> readYamlIO $ contributorDir </> src) contributorFiles
let sortedContributors = sortBy (compare `on` contributorCount) contributors
return (sortedContributors :: [Contributor])
-- * Github interaction
-- | Get user information for every user who authored a commit.
do
commits <- getCommits auth owner repo
-- If there author has an invalid email address, GitHub returns a SimpleUser
-- with the name "invalid-email-address", rather than throwing an error
let commitAuthors = flip mapMaybe commits $ \commit -> do
simpleUser <- GH.commitAuthor commit
let simpleUserName = GH.untagName $ GH.simpleUserLogin simpleUser
if simpleUserName == "invalid-email-address"
then fail "Invalid email address"
else return simpleUser
forM (frequency commitAuthors) $ \(simpleUser, count) -> do
printf "Get user info for %s\n" (T.unpack $ GH.untagName $ GH.simpleUserLogin simpleUser)
user <- getUserInfo auth simpleUser
return $ toContributor user count
-- | Convert a |GH.User| value to a |Contributor| value.
Contributor name github count
where
name = fromMaybe github (GH.userName commitAuthor)
github = GH.untagName (GH.userLogin commitAuthor)
-- | Get an authentication token from the environment.
do
mtoken <- lookupEnv "GITHUB_TOKEN"
case mtoken of
Nothing -> error "Please set GITHUB_TOKEN"
Just token -> return (GH.OAuth . fromString $ token)
-- | Get user information from a user login.
fromRight =<< GH.github auth GH.userInfoForR (GH.simpleUserLogin simpleUser)
-- | Get commit history for a repository.
V.toList <$> (fromRight =<< GH.github auth GH.commitsForR owner repo GH.FetchAll)
-- * Utils
M.toList (M.fromListWith (+) [(x, 1) | x <- xs])
either (fail . show) return