-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #66 from mattpolzin/only-teams-option
Add `assignUsers` configuration option.
- Loading branch information
Showing
18 changed files
with
231 additions
and
103 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,5 +1,5 @@ | ||
package harmony | ||
version = 1.1.1 | ||
version = 1.2.0 | ||
authors = "Mathew Polzin" | ||
license = "MIT" | ||
-- brief = | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -13,6 +13,10 @@ import FFI.GitHub | |
import Language.JSON | ||
import System | ||
import System.File | ||
import Util | ||
|
||
import Text.PrettyPrint.Prettyprinter | ||
import Text.PrettyPrint.Prettyprinter.Render.Terminal | ||
|
||
%default total | ||
|
||
|
@@ -53,6 +57,24 @@ syncIfOld config = | |
now <- time | ||
pure $ cast (now - oneDay) | ||
|
||
||| Determine if any configuration settings are inconsistent with each other or result in | ||
||| behavior that is likely undesirable. | ||
checkConfigConsistency : Config -> Either (Doc AnsiStyle) () | ||
checkConfigConsistency config = do | ||
checkAssignSettings config | ||
-- other checks... | ||
where | ||
checkAssignSettings : Config -> Either (Doc AnsiStyle) () | ||
checkAssignSettings config = | ||
if not (config.assignTeams || config.assignUsers) | ||
then Left $ (annotate (color Yellow) . hsep $ [ | ||
"`assignUsers` and `assignTeams` are both False." | ||
, "This means `harmony assign` commands will only ever assign users that are specified with the `+<userlogin>` syntax." | ||
, "More commonly, you want Harmony to at least assign either a team or a user from a team when you say `harmony assign teamname`;" | ||
, "It's suggested to either `harmony config assignUsers true` or `harmony config assignTeams true` (or both)." | ||
]) <+> hardline | ||
else Right () | ||
|
||
record GitRemote where | ||
constructor Remote | ||
org, repo : String | ||
|
@@ -81,28 +103,23 @@ parseGitHubURI str = parseHTTPS str <|> parseSSH str | |
parseSSH : String -> Maybe GitRemote | ||
parseSSH = dropPrefix' "[email protected]:" >=> parseSuffix | ||
|
||
propSetters : List (String, (Config -> String -> Maybe Config)) | ||
propSetters = [ | ||
("assignTeams" , update parseBool (\b => { assignTeams := b })) | ||
, ("commentOnAssign", update parseBool (\b => { commentOnAssign := b })) | ||
, ("defaultRemote" , update Just (\s => { defaultRemote := Just s })) | ||
, ("githubPAT" , update Just (\s => { githubPAT := Just $ hide s })) | ||
] | ||
where | ||
parseBool : String -> Maybe Bool | ||
parseBool x with (toLower x) | ||
_ | "yes" = Just True | ||
_ | "true" = Just True | ||
_ | "no" = Just False | ||
_ | "false" = Just False | ||
_ | _ = Nothing | ||
parseBool : String -> Maybe Bool | ||
parseBool x with (toLower x) | ||
_ | "yes" = Just True | ||
_ | "true" = Just True | ||
_ | "no" = Just False | ||
_ | "false" = Just False | ||
_ | _ = Nothing | ||
|
||
update : Functor f => (String -> f a) -> (a -> b -> b) -> b -> String -> f b | ||
update f g c = map (flip g c) . f | ||
update : Functor f => (String -> f a) -> (a -> b -> b) -> b -> String -> f b | ||
update f g c = map (flip g c) . f | ||
|
||
namespace PropSettersProperties | ||
propSettersCoveragePrf : Data.Config.settableProps = Builtin.fst <$> Config.propSetters | ||
propSettersCoveragePrf = Refl | ||
propSetter : SettableProp n h -> (Config -> String -> Maybe Config) | ||
propSetter AssignTeams = update parseBool (\b => { assignTeams := b }) | ||
propSetter AssignUsers = update parseBool (\b => { assignUsers := b }) | ||
propSetter CommentOnAssign = update parseBool (\b => { commentOnAssign := b }) | ||
propSetter DefaultRemote = update Just (\s => { defaultRemote := Just s }) | ||
propSetter GithubPAT = update Just (\s => { githubPAT := Just $ hide s }) | ||
|
||
||| Attempt to set a property and value given String representations. | ||
||| After setting, write the config and return the updated result. | ||
|
@@ -111,31 +128,34 @@ setConfig : Config => | |
(prop : String) | ||
-> (value : String) | ||
-> Promise Config | ||
setConfig @{config} prop value with (lookup prop propSetters) | ||
_ | Nothing = reject "\{prop} cannot be set via `config` command." | ||
_ | (Just set) with (set config value) | ||
_ | Nothing = reject "\{value} is not a valid value for \{prop}." | ||
_ | (Just config') = writeConfig config' | ||
|
||
propGetters : List (String, (Config -> String)) | ||
propGetters = [ | ||
("assignTeams" , show . assignTeams) | ||
, ("commentOnAssign", show . commentOnAssign) | ||
, ("defaultRemote" , maybe "Not set (defaults to \"origin\")" show . defaultRemote) | ||
, ("githubPAT" , maybe "Not set (will use $GITHUB_PAT environment variable)" show . githubPAT) | ||
] | ||
|
||
namespace PropGettersProperties | ||
propGetterCoveragePrf : Data.Config.settableProps = Builtin.fst <$> Config.propGetters | ||
propGetterCoveragePrf = Refl | ||
setConfig @{config} prop value with (settablePropNamed prop) | ||
_ | Nothing = reject "\{prop} cannot be set via `config` command." | ||
_ | Just (Evidence _ p) with ((propSetter p) config value) | ||
_ | Nothing = reject "\{value} is not a valid value for \{prop}." | ||
_ | Just config' = do either (renderIO @{config'}) pure (checkConfigConsistency config') | ||
writeConfig config' | ||
|
||
propGetter : SettableProp n h -> (Config -> String) | ||
propGetter AssignTeams = show . assignTeams | ||
propGetter AssignUsers = show . assignUsers | ||
propGetter CommentOnAssign = show . commentOnAssign | ||
propGetter DefaultRemote = maybe "Not set (defaults to \"origin\")" show . defaultRemote | ||
propGetter GithubPAT = maybe "Not set (will use $GITHUB_PAT environment variable)" show . githubPAT | ||
|
||
export | ||
getConfig : Config => | ||
(prop : String) | ||
-> Promise String | ||
getConfig @{config} prop with (lookup prop propGetters) | ||
getConfig prop | Nothing = reject "\{prop} cannot get read via `config` command." | ||
getConfig prop | (Just get) = pure $ get config | ||
getConfig @{config} prop with (settablePropNamed prop) | ||
getConfig @{config} prop | Nothing = reject "\{prop} cannot get read via `config` command." | ||
getConfig @{config} prop | (Just (Evidence _ p)) = pure $ (propGetter p) config | ||
|
||
export | ||
settablePropsWithHelp : Config => String | ||
settablePropsWithHelp = renderString . vsep $ help <$> settablePropNamesAndHelp | ||
where | ||
help : (String, String) -> Doc AnsiStyle | ||
help (n, h) = (annotate (color Green) $ pretty n) <+> pretty ": \{replicate (longestSettablePropName `minus` (length n)) ' ' ++ h}" | ||
|
||
||| Look for "origin" in a list of remote names or else | ||
||| fallback to the first name. | ||
|
@@ -187,9 +207,12 @@ createConfig envGithubPAT terminalColors editor = do | |
putStr "Would you like harmony to comment when it assigns reviewers? [Y/n] " | ||
commentOnAssign <- yesUnlessNo . trim <$> getLine | ||
|
||
putStr "Would you like harmony to assign teams in addition to individuals when it assigns reviewers? [Y/n] " | ||
putStr "Would you like harmony to assign teams when it assigns reviewers? [Y/n] " | ||
assignTeams <- yesUnlessNo . trim <$> getLine | ||
|
||
putStr "Would you like harmony to assign individual users when it assigns reviewers? [Y/n] " | ||
assignUsers <- yesUnlessNo . trim <$> getLine | ||
|
||
_ <- liftIO $ octokit pat | ||
putStrLn "Creating config..." | ||
mainBranch <- getRepoDefaultBranch org repo | ||
|
@@ -208,6 +231,7 @@ createConfig envGithubPAT terminalColors editor = do | |
, defaultRemote | ||
, mainBranch | ||
, assignTeams | ||
, assignUsers | ||
, commentOnAssign | ||
, teamSlugs | ||
, orgMembers | ||
|
@@ -217,6 +241,7 @@ createConfig envGithubPAT terminalColors editor = do | |
ignore $ writeConfig config | ||
putStrLn "Your new configuration is:" | ||
printLn config | ||
either renderIO pure (checkConfigConsistency config) | ||
pure config | ||
where | ||
orIfEmpty : Maybe String -> String -> String | ||
|
@@ -225,9 +250,10 @@ createConfig envGithubPAT terminalColors editor = do | |
orIfEmpty (Just _) x = x | ||
|
||
yesUnlessNo : String -> Bool | ||
yesUnlessNo "n" = False | ||
yesUnlessNo "N" = False | ||
yesUnlessNo _ = True | ||
yesUnlessNo answer with (toLower answer) | ||
_ | "n" = False | ||
_ | "no" = False | ||
_ | _ = True | ||
|
||
org : Maybe GitRemote -> Maybe String | ||
org = map (.org) | ||
|
Oops, something went wrong.