diff --git a/README.md b/README.md index 69388d1..e39f87b 100644 --- a/README.md +++ b/README.md @@ -112,7 +112,10 @@ Would you like harmony to request team reviews in addition to individuals when i Creating config... ``` -Once configured, Harmony supports the following commands: `config`, `branch`, `pr`, `label`, `request`, `contribute`, `whoami`, `reflect`, `list`, `graph`, `health`, and `sync`. +Once configured, Harmony supports the following commands: `config`, `branch`, `pr`, `label`, `request` (also aliased to `rq`), `contribute`, `whoami`, `reflect`, `list`, `graph`, `health`, and `sync`. + +**Note on color output:** +Harmony uses colored output for some commands. You can adjust these colors slightly with the `theme` configuration option. You can also use the `NO_COLOR` environment variable to disable all colored output. Lastly, Harmony will avoid colored output when it determines `stdout` is not a TTY device (as is the case for e.g. redirecting harmony output into a file or piping into `cat`: `harmony ... | cat`). ### Config Running `harmony config ` will read the given configuration property. `harmony config ` will set the configuration property. @@ -124,6 +127,7 @@ Not all configuration properties can be read/set with this command. - `commentOnRequest` (`true`/`false`) -- When requesting a reviewer chosen by Harmony, comment on the pull request. - `defaultRemote` (optional string) -- When pushing new branches, what remote destination should be used. - `mainBranch` (optional string) -- When creating a PR, this is the default base branch. +- `theme` (`dark`/`light`) -- Use colors suited better for either a dark or light Terminal background. - `githubPAT` (optional string) -- If the `$GITHUB_PAT` environment variable is not set, this Personal Access Token is used to authenticate with GitHub. ### Branch diff --git a/default.nix b/default.nix index b0002bf..d369f9c 100644 --- a/default.nix +++ b/default.nix @@ -74,7 +74,7 @@ }; harmonyPkg = buildIdris { - version = "4.2.0"; + version = "4.3.0"; ipkgName = "harmony"; src = ./.; diff --git a/harmony.ipkg b/harmony.ipkg index 918ebe4..a9bd4da 100644 --- a/harmony.ipkg +++ b/harmony.ipkg @@ -1,5 +1,5 @@ package harmony -version = 4.2.0 +version = 4.3.0 authors = "Mathew Polzin" license = "MIT" brief = "Harmony GitHub collaboration tool" diff --git a/node-packages.nix b/node-packages.nix index a04c014..e7000ce 100644 --- a/node-packages.nix +++ b/node-packages.nix @@ -279,13 +279,13 @@ sha512 = "FE2V+QZ2UYlh+9wWd5BPLNXG+J/XUD/PPq0ovS+nCcGX4+3qVbi3jYOmCTW48hg9SBBLtInx9+o7fFt4H5iP0Q=="; }; }; - "@types/aws-lambda-8.10.138" = { + "@types/aws-lambda-8.10.140" = { name = "_at_types_slash_aws-lambda"; packageName = "@types/aws-lambda"; - version = "8.10.138"; + version = "8.10.140"; src = fetchurl { - url = "https://registry.npmjs.org/@types/aws-lambda/-/aws-lambda-8.10.138.tgz"; - sha512 = "71EHMl70TPWIAsFuHd85NHq6S6T2OOjiisPTrH7RgcjzpJpPh4RQJv7PvVvIxc6PIp8CLV7F9B+TdjcAES5vcA=="; + url = "https://registry.npmjs.org/@types/aws-lambda/-/aws-lambda-8.10.140.tgz"; + sha512 = "4Dh3dk2TUcbdfHrX0Al90mNGJDvA9NBiTQPzbrjGi/dLxzKCGOYgT8YQ47jUKNFALkAJAadifq0pzyjIUlhVhg=="; }; }; "@types/btoa-lite-1.0.2" = { @@ -306,13 +306,13 @@ sha512 = "/5hndP5dCjloafCXns6SZyESp3Ldq7YjH3zwzwczYnjxIT0Fqzk5ROSYVGfFyczIue7IUEj8hkvLbPoLQ18vQw=="; }; }; - "@types/node-20.12.13" = { + "@types/node-20.14.9" = { name = "_at_types_slash_node"; packageName = "@types/node"; - version = "20.12.13"; + version = "20.14.9"; src = fetchurl { - url = "https://registry.npmjs.org/@types/node/-/node-20.12.13.tgz"; - sha512 = "gBGeanV41c1L171rR7wjbMiEpEI/l5XFQdLLfhr/REwpgDy/4U8y89+i8kRiLzDyZdOkXh+cRaTetUnCYutoXA=="; + url = "https://registry.npmjs.org/@types/node/-/node-20.14.9.tgz"; + sha512 = "06OCtnTXtWOZBJlRApleWndH4JsRVs1pDCc8dLSQp+7PpUpX3ePdHyeNSFTeSe7FtKyQkrlPvHwJOW3SLd8Oyg=="; }; }; "aggregate-error-3.1.0" = { @@ -369,13 +369,13 @@ sha512 = "4diC9HaTE+KRAMWhDhrGOECgWZxoevMc5TlkObMqNSsVU62PYzXZ/SMTjzyGAFF1YusgxGcSWTEXBhp0CPwQ1A=="; }; }; - "debug-4.3.4" = { + "debug-4.3.5" = { name = "debug"; packageName = "debug"; - version = "4.3.4"; + version = "4.3.5"; src = fetchurl { - url = "https://registry.npmjs.org/debug/-/debug-4.3.4.tgz"; - sha512 = "PRWFHuSU3eDtQJPvnNY7Jcket1j0t5OuOsFzPPzsekD52Zl8qUfFIPEiswXqIvHWGVHOgX+7G/vCNNhehwxfkQ=="; + url = "https://registry.npmjs.org/debug/-/debug-4.3.5.tgz"; + sha512 = "pt0bNEmneDIvdL1Xsd9oDQ/wrQRkXDT4AUWlNZNPKvW5x/jyO9VFXkJUP07vQ2upmw5PlaITaPKc31jK13V+jg=="; }; }; "deprecation-2.3.1" = { @@ -495,13 +495,13 @@ sha512 = "Sb487aTOCr9drQVL8pIxOzVhafOjZN9UU54hiN8PU3uAiSV7lx1yYNpbNmex2PK6dSJoNTSJUUswT651yww3Mg=="; }; }; - "lru-cache-10.2.2" = { + "lru-cache-10.3.0" = { name = "lru-cache"; packageName = "lru-cache"; - version = "10.2.2"; + version = "10.3.0"; src = fetchurl { - url = "https://registry.npmjs.org/lru-cache/-/lru-cache-10.2.2.tgz"; - sha512 = "9hp3Vp2/hFQUiIwKo8XCeFVnrg8Pk3TYNPIR7tJADKi5YfcF7vEaK7avFHTlSy3kOKYaJQaalfEo6YuXdceBOQ=="; + url = "https://registry.npmjs.org/lru-cache/-/lru-cache-10.3.0.tgz"; + sha512 = "CQl19J/g+Hbjbv4Y3mFNNXFEL/5t/KCg8POCuUqd4rMKjGG+j1ybER83hxV58zL+dFI1PTkt3GNFSHRt+d8qEQ=="; }; }; "ms-2.1.2" = { @@ -558,13 +558,13 @@ sha512 = "FNAIBWCx9qcRhoHcgcJ0gvU7SN1lYU2ZXuSfl04bSC5OpvDHFyJCjdNHomPXxjQlCBU67YW64PzY7/VIEH7F2w=="; }; }; - "simple-git-3.24.0" = { + "simple-git-3.25.0" = { name = "simple-git"; packageName = "simple-git"; - version = "3.24.0"; + version = "3.25.0"; src = fetchurl { - url = "https://registry.npmjs.org/simple-git/-/simple-git-3.24.0.tgz"; - sha512 = "QqAKee9Twv+3k8IFOFfPB2hnk6as6Y6ACUpwCtQvRYBAes23Wv3SZlHVobAzqcE8gfsisCvPw3HGW3HYM+VYYw=="; + url = "https://registry.npmjs.org/simple-git/-/simple-git-3.25.0.tgz"; + sha512 = "KIY5sBnzc4yEcJXW7Tdv4viEz8KyG+nU0hay+DWZasvdFOYKeUZ6Xc25LUHHjw0tinPT7O1eY6pzX7pRT1K8rw=="; }; }; "undici-types-5.26.5" = { @@ -607,7 +607,7 @@ args = { name = "_at_mattpolzin_slash_harmony"; packageName = "@mattpolzin/harmony"; - version = "4.2.0"; + version = "4.3.0"; src = ./.; dependencies = [ sources."@kwsites/file-exists-1.1.1" @@ -663,17 +663,17 @@ sources."@octokit/webhooks-12.2.0" sources."@octokit/webhooks-methods-4.1.0" sources."@octokit/webhooks-types-7.4.0" - sources."@types/aws-lambda-8.10.138" + sources."@types/aws-lambda-8.10.140" sources."@types/btoa-lite-1.0.2" sources."@types/jsonwebtoken-9.0.6" - sources."@types/node-20.12.13" + sources."@types/node-20.14.9" sources."aggregate-error-3.1.0" sources."before-after-hook-2.2.3" sources."bottleneck-2.19.5" sources."btoa-lite-1.0.0" sources."buffer-equal-constant-time-1.0.1" sources."clean-stack-2.2.0" - (sources."debug-4.3.4" + (sources."debug-4.3.5" // { dependencies = [ sources."ms-2.1.2" @@ -692,13 +692,13 @@ sources."lodash.isplainobject-4.0.6" sources."lodash.isstring-4.0.1" sources."lodash.once-4.1.1" - sources."lru-cache-10.2.2" + sources."lru-cache-10.3.0" sources."ms-2.1.3" sources."octokit-3.2.1" sources."once-1.4.0" sources."safe-buffer-5.2.1" sources."semver-7.6.2" - sources."simple-git-3.24.0" + sources."simple-git-3.25.0" sources."undici-types-5.26.5" sources."universal-github-app-jwt-1.1.2" sources."universal-user-agent-6.0.1" diff --git a/package-lock.json b/package-lock.json index 1eb3995..b23b48e 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,12 +1,12 @@ { "name": "@mattpolzin/harmony", - "version": "4.2.0", + "version": "4.3.0", "lockfileVersion": 3, "requires": true, "packages": { "": { "name": "@mattpolzin/harmony", - "version": "4.2.0", + "version": "4.3.0", "license": "MIT", "dependencies": { "octokit": "^3.1", @@ -422,9 +422,9 @@ "integrity": "sha512-FE2V+QZ2UYlh+9wWd5BPLNXG+J/XUD/PPq0ovS+nCcGX4+3qVbi3jYOmCTW48hg9SBBLtInx9+o7fFt4H5iP0Q==" }, "node_modules/@types/aws-lambda": { - "version": "8.10.138", - "resolved": "https://registry.npmjs.org/@types/aws-lambda/-/aws-lambda-8.10.138.tgz", - "integrity": "sha512-71EHMl70TPWIAsFuHd85NHq6S6T2OOjiisPTrH7RgcjzpJpPh4RQJv7PvVvIxc6PIp8CLV7F9B+TdjcAES5vcA==" + "version": "8.10.140", + "resolved": "https://registry.npmjs.org/@types/aws-lambda/-/aws-lambda-8.10.140.tgz", + "integrity": "sha512-4Dh3dk2TUcbdfHrX0Al90mNGJDvA9NBiTQPzbrjGi/dLxzKCGOYgT8YQ47jUKNFALkAJAadifq0pzyjIUlhVhg==" }, "node_modules/@types/btoa-lite": { "version": "1.0.2", @@ -440,9 +440,9 @@ } }, "node_modules/@types/node": { - "version": "20.12.13", - "resolved": "https://registry.npmjs.org/@types/node/-/node-20.12.13.tgz", - "integrity": "sha512-gBGeanV41c1L171rR7wjbMiEpEI/l5XFQdLLfhr/REwpgDy/4U8y89+i8kRiLzDyZdOkXh+cRaTetUnCYutoXA==", + "version": "20.14.9", + "resolved": "https://registry.npmjs.org/@types/node/-/node-20.14.9.tgz", + "integrity": "sha512-06OCtnTXtWOZBJlRApleWndH4JsRVs1pDCc8dLSQp+7PpUpX3ePdHyeNSFTeSe7FtKyQkrlPvHwJOW3SLd8Oyg==", "dependencies": { "undici-types": "~5.26.4" } @@ -488,9 +488,9 @@ } }, "node_modules/debug": { - "version": "4.3.4", - "resolved": "https://registry.npmjs.org/debug/-/debug-4.3.4.tgz", - "integrity": "sha512-PRWFHuSU3eDtQJPvnNY7Jcket1j0t5OuOsFzPPzsekD52Zl8qUfFIPEiswXqIvHWGVHOgX+7G/vCNNhehwxfkQ==", + "version": "4.3.5", + "resolved": "https://registry.npmjs.org/debug/-/debug-4.3.5.tgz", + "integrity": "sha512-pt0bNEmneDIvdL1Xsd9oDQ/wrQRkXDT4AUWlNZNPKvW5x/jyO9VFXkJUP07vQ2upmw5PlaITaPKc31jK13V+jg==", "dependencies": { "ms": "2.1.2" }, @@ -600,9 +600,9 @@ "integrity": "sha512-Sb487aTOCr9drQVL8pIxOzVhafOjZN9UU54hiN8PU3uAiSV7lx1yYNpbNmex2PK6dSJoNTSJUUswT651yww3Mg==" }, "node_modules/lru-cache": { - "version": "10.2.2", - "resolved": "https://registry.npmjs.org/lru-cache/-/lru-cache-10.2.2.tgz", - "integrity": "sha512-9hp3Vp2/hFQUiIwKo8XCeFVnrg8Pk3TYNPIR7tJADKi5YfcF7vEaK7avFHTlSy3kOKYaJQaalfEo6YuXdceBOQ==", + "version": "10.3.0", + "resolved": "https://registry.npmjs.org/lru-cache/-/lru-cache-10.3.0.tgz", + "integrity": "sha512-CQl19J/g+Hbjbv4Y3mFNNXFEL/5t/KCg8POCuUqd4rMKjGG+j1ybER83hxV58zL+dFI1PTkt3GNFSHRt+d8qEQ==", "engines": { "node": "14 || >=16.14" } @@ -671,13 +671,13 @@ } }, "node_modules/simple-git": { - "version": "3.24.0", - "resolved": "https://registry.npmjs.org/simple-git/-/simple-git-3.24.0.tgz", - "integrity": "sha512-QqAKee9Twv+3k8IFOFfPB2hnk6as6Y6ACUpwCtQvRYBAes23Wv3SZlHVobAzqcE8gfsisCvPw3HGW3HYM+VYYw==", + "version": "3.25.0", + "resolved": "https://registry.npmjs.org/simple-git/-/simple-git-3.25.0.tgz", + "integrity": "sha512-KIY5sBnzc4yEcJXW7Tdv4viEz8KyG+nU0hay+DWZasvdFOYKeUZ6Xc25LUHHjw0tinPT7O1eY6pzX7pRT1K8rw==", "dependencies": { "@kwsites/file-exists": "^1.1.1", "@kwsites/promise-deferred": "^1.1.1", - "debug": "^4.3.4" + "debug": "^4.3.5" }, "funding": { "type": "github", diff --git a/package.json b/package.json index 3bcfb5d..d5e11b5 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "@mattpolzin/harmony", - "version": "4.2.0", + "version": "4.3.0", "engines": { "node": ">=18.0.0" }, diff --git a/src/AppVersion.idr b/src/AppVersion.idr index f8d0a5e..9667775 100644 --- a/src/AppVersion.idr +++ b/src/AppVersion.idr @@ -4,7 +4,7 @@ module AppVersion export appVersion : String -appVersion = "4.2.0" +appVersion = "4.3.0" export printVersion : HasIO io => io () diff --git a/src/Commands.idr b/src/Commands.idr index 7dfef3d..01b13fe 100644 --- a/src/Commands.idr +++ b/src/Commands.idr @@ -207,7 +207,7 @@ health @{config} = do (<||>) : Alternative t => (a -> t b) -> (a -> t b) -> a -> t b (<||>) f g x = f x <|> g x -infixr 2 <||> +private infixr 2 <||> ||| Parse arguments for the graph command. export diff --git a/src/Config.idr b/src/Config.idr index 6041a96..b01ceae 100644 --- a/src/Config.idr +++ b/src/Config.idr @@ -7,6 +7,7 @@ import Data.List.PrefixSuffix import Data.List1 import Data.Promise import Data.String +import Data.Theme import Decidable.Equality import FFI.Git import FFI.GitHub @@ -131,6 +132,7 @@ propSetter RequestUsers = update parseBool (\b => { requestUsers := b }) propSetter CommentOnRequest = update parseBool (\b => { commentOnRequest := b }) propSetter DefaultRemote = update Just (\s => { defaultRemote := s }) propSetter MainBranch = update Just (\s => { mainBranch := s }) +propSetter ThemeProp = update parseString (\t => { theme := t }) propSetter GithubPAT = update Just (\s => { githubPAT := Just $ hide s }) propSetter AssignTeams = update parseBool (\b => { requestTeams := b }) propSetter AssignUsers = update parseBool (\b => { requestUsers := b }) @@ -156,6 +158,7 @@ propGetter RequestUsers = show . requestUsers propGetter CommentOnRequest = show . commentOnRequest propGetter DefaultRemote = show . defaultRemote propGetter MainBranch = show . mainBranch +propGetter ThemeProp = show . theme propGetter GithubPAT = maybe "Not set (will use $GITHUB_PAT environment variable)" show . githubPAT propGetter AssignTeams = show . requestTeams propGetter AssignUsers = show . requestUsers @@ -233,6 +236,13 @@ createConfig envGithubPAT terminalColors terminalColumns editor = do requestUsers <- yesNoPrompt "Would you like harmony to request reviews from individual users when it requests a teams review?" + let themeDefaultStr = enterForDefaultStr "dark" + putStrLn "Would you like harmony configured for a dark or light terminal background\{themeDefaultStr}?" + theme <- offerRetry "The theme must be either 'dark' or 'light'. Which would you prefer?" + "Could not parse the input as a valid theme; will use 'dark' for now." + Dark $ + Theme.parseString . orIfEmpty (Just "dark") . trim <$> getLine + _ <- liftIO $ octokit pat putStrLn "Creating config..." mainBranch <- getRepoDefaultBranch org repo @@ -260,6 +270,7 @@ createConfig envGithubPAT terminalColors terminalColumns editor = do , orgMembers , ignoredPRs = [] , githubPAT = hide <$> configPAT + , theme , ephemeral } ignore $ writeConfig config @@ -268,6 +279,21 @@ createConfig envGithubPAT terminalColors terminalColumns editor = do either renderIO pure (checkConfigConsistency config) pure config where + offerRetry : HasIO io => + (fallbackDescription : String) + -> (failureDescription : String) + -> (fallback : Lazy a) + -> io (Maybe a) + -> io a + offerRetry fallbackDescription failureDescription fallback p = do + Nothing <- p + | Just first => pure first + putStrLn fallbackDescription + Nothing <- p + | Just second => pure second + putStrLn failureDescription + pure fallback + orIfEmpty : Maybe String -> String -> String orIfEmpty Nothing x = x orIfEmpty (Just y) "" = y diff --git a/src/Data/Config.idr b/src/Data/Config.idr index fbf22fe..961a452 100644 --- a/src/Data/Config.idr +++ b/src/Data/Config.idr @@ -4,6 +4,7 @@ import Data.Either import Data.List import Data.List.Elem import Data.String +import Data.Theme import Data.Vect import JSON.Parser import Language.JSON.Accessors @@ -82,6 +83,9 @@ record Config where ||| either the environment variable or this config property ||| must be set. githubPAT : Maybe (Hidden String) + ||| Should Harmony print with colors fit for a dark terminal + ||| or a light terminal? + theme : Theme ||| Configuration properties that are not written to a file. ephemeral : Ephemeral -- not written out to file @@ -110,9 +114,12 @@ data SettableProp : (name : String) -> (help : String) -> Type where DefaultRemote : SettableProp "defaultRemote" "[string] The name of the default Git remote to use (e.g. 'origin')." - MainBranch : SettableProp + MainBranch : SettableProp "mainBranch" "[string] The name of the default Git base branch for new PRs." + ThemeProp : SettableProp + "theme" + "[dark/light]" GithubPAT : SettableProp "githubPAT" """ @@ -149,6 +156,7 @@ settablePropNamed "requestTeams" = Just $ Evidence _ RequestTeams settablePropNamed "commentOnRequest" = Just $ Evidence _ CommentOnRequest settablePropNamed "defaultRemote" = Just $ Evidence _ DefaultRemote settablePropNamed "mainBranch" = Just $ Evidence _ MainBranch +settablePropNamed "theme" = Just $ Evidence _ ThemeProp settablePropNamed "githubPAT" = Just $ Evidence _ GithubPAT settablePropNamed "requestUsers" = Just $ Evidence _ RequestUsers settablePropNamed "assignTeams" = Just $ Evidence _ AssignTeams @@ -171,6 +179,7 @@ settableProps = [ , (_ ** _ ** CommentOnRequest) , (_ ** _ ** DefaultRemote) , (_ ** _ ** MainBranch) + , (_ ** _ ** ThemeProp) , (_ ** _ ** GithubPAT) , (_ ** _ ** AssignUsers) , (_ ** _ ** AssignTeams) @@ -231,6 +240,7 @@ export Show Config where show config = unlines [ " updatedAt: \{show config.updatedAt}" + , " theme: \{show config.theme}" , " org: \{show config.org}" , " repo: \{show config.repo}" , " defaultRemote: \{show config.defaultRemote}" @@ -254,8 +264,9 @@ Show Config where export json : Config -> JSON -json (MkConfig updatedAt org repo defaultRemote mainBranch requestTeams requestUsers commentOnRequest - teamSlugs repoLabels orgMembers ignoredPRs githubPAT _) = +json (MkConfig updatedAt org repo defaultRemote mainBranch + requestTeams requestUsers commentOnRequest teamSlugs + repoLabels orgMembers ignoredPRs githubPAT theme _) = JObject [ ("requestTeams" , JBool requestTeams) , ("requestUsers" , JBool requestUsers) @@ -264,6 +275,7 @@ json (MkConfig updatedAt org repo defaultRemote mainBranch requestTeams requestU , ("repo" , JString repo) , ("defaultRemote" , JString defaultRemote) , ("mainBranch" , JString mainBranch) + , ("theme" , JString $ show theme) , ("orgMembers" , JArray $ JString <$> sort orgMembers) , ("teamSlugs" , JArray $ JString <$> sort teamSlugs) , ("repoLabels" , JArray $ JString <$> sort repoLabels) @@ -308,6 +320,7 @@ parseConfig ephemeral = (mapFst (const "Failed to parse JSON") . parseJSON Virtu requestUsers <- exactlyOneOf "assignUsers" "requestUsers" commentOnRequest <- exactlyOneOf "commentOnAssign" "commentOnRequest" let maybeGithubPAT = lookup "githubPAT" config + let maybeTheme = lookup "theme" config ua <- cast <$> integer updatedAt o <- string org r <- string repo @@ -321,6 +334,11 @@ parseConfig ephemeral = (mapFst (const "Failed to parse JSON") . parseJSON Virtu om <- array string orgMembers ip <- array integer ignoredPRs gp <- maybe (Right Nothing) (optional string) maybeGithubPAT + -- TODO 5.0.0: Make theme required part of config file (default to dark still) + -- theme lookup can be moved to the required lookupAll above. + th <- maybe (Right Dark) + (stringy "dark or light" parseString) + maybeTheme pure $ MkConfig { updatedAt = ua , org = o @@ -335,6 +353,7 @@ parseConfig ephemeral = (mapFst (const "Failed to parse JSON") . parseJSON Virtu , orgMembers = om , ignoredPRs = ip , githubPAT = (map Hide) gp + , theme = th , ephemeral = ephemeral } where diff --git a/src/Data/Theme.idr b/src/Data/Theme.idr new file mode 100644 index 0000000..5bf01b5 --- /dev/null +++ b/src/Data/Theme.idr @@ -0,0 +1,18 @@ +module Data.Theme + +%default total + +public export +data Theme = Light + | Dark + +export +Show Theme where + show Light = "light" + show Dark = "dark" + +export +parseString : String -> Maybe Theme +parseString "light" = Just Light +parseString "dark" = Just Dark +parseString _ = Nothing diff --git a/src/Graph.idr b/src/Graph.idr index 38bb02c..9df05fd 100644 --- a/src/Graph.idr +++ b/src/Graph.idr @@ -1,10 +1,12 @@ module Graph +import Data.Config import Data.Fuel import Data.List import Data.ReviewScore import Data.SortedMap import Data.Nat +import Theme import Data.Date import Data.PullRequest @@ -43,67 +45,71 @@ record PRsOnDate dateTy where date : dateTy prCount : Nat -Pretty dateTy => Graphable (PRsOnDate dateTy) where - totalWidth g = g.prCount - label g = coloredLabel <++> countInParens - where - coloredLabel : Doc AnsiStyle - coloredLabel = if g.prCount == 0 - then (annotate (color Green) $ pretty g.date) - else if g.prCount < 2 - then pretty g.date - else if g.prCount < 6 - then (annotate (color Yellow) $ pretty g.date) - else (annotate (color Red) $ pretty g.date) - - countInParens : Doc AnsiStyle - countInParens = if g.prCount > 4 - then (annotate italic $ pretty "(\{show g.prCount})") - else pretty "" - score g = g.prCount - detractor _ = 0 - bonus _ = 0 - Pretty Date where pretty = pretty . showYearAndMonth -||| Graph a single line (bar) of dots. -||| @ indentation a number of leading spaces to product off to the left (uses Doc's @indent@) -||| @ score the net score to graph out in yellow. -||| @ detractor the amount detracting from the score, graphed in red. -||| @ bonus a bonus indicator graphed on the far right in green. -bar : (indentation : Nat) -> (score : Nat) -> (detractor : Nat) -> (bonus : Nat) -> Doc AnsiStyle -bar idt score detractor bonus = indent (cast idt) . hcat $ - [ annotate (color Red) . hcat $ replicate detractor (pretty '◦') - , annotate (color Yellow) . hcat $ replicate score (pretty '·') - , annotate (color Green) . hcat $ replicate bonus (pretty '▪') - ] - -graphOne : Graphable g => (highScore : Nat) -> g -> Doc AnsiStyle -graphOne highScore x = - -- we create a bar with the combinedScore and then fill in any - -- remaining space with an indication of the detractor. We cap - -- the detractor representation at the high score to make everything - -- line up nicely. The detractor is just there to give some indication - -- of review requests that did not count positively toward the score. - let idt = highScore `minus` (totalWidth x) - remainingSpace = highScore `minus` (score x) - in bar idt (score x) (min remainingSpace (detractor x)) (bonus x) <++> (label x) - -graph : Graphable g => (highScore : Nat) -> List g -> Doc AnsiStyle -graph highScore = vsep . map (graphOne highScore) +parameters (config : Config) + -- Make the PR count on each date graphable for the + -- health command's graph. + Pretty dateTy => Graphable (PRsOnDate dateTy) where + totalWidth g = g.prCount + label g = coloredLabel <++> countInParens + where + coloredLabel : Doc AnsiStyle + coloredLabel = if g.prCount == 0 + then (theme Good $ pretty g.date) + else if g.prCount < 2 + then pretty g.date + else if g.prCount < 6 + then (theme NotGreat $ pretty g.date) + else (theme Bad $ pretty g.date) + + countInParens : Doc AnsiStyle + countInParens = if g.prCount > 4 + then (annotate italic $ pretty "(\{show g.prCount})") + else pretty "" + score g = g.prCount + detractor _ = 0 + bonus _ = 0 + + ||| Graph a single line (bar) of dots. + ||| @ indentation a number of leading spaces to product off to the left (uses Doc's @indent@) + ||| @ score the net score to graph out in yellow. + ||| @ detractor the amount detracting from the score, graphed in red. + ||| @ bonus a bonus indicator graphed on the far right in green. + bar : (indentation : Nat) -> (score : Nat) -> (detractor : Nat) -> (bonus : Nat) -> Doc AnsiStyle + bar idt score detractor bonus = indent (cast idt) . hcat $ + [ theme Missed . hcat $ replicate detractor (pretty '◦') + , theme Pending' . hcat $ replicate score (pretty '·') + , theme Completed . hcat $ replicate bonus (pretty '▪') + ] + + graphOne : Graphable g => (highScore : Nat) -> g -> Doc AnsiStyle + graphOne highScore x = + -- we create a bar with the combinedScore and then fill in any + -- remaining space with an indication of the detractor. We cap + -- the detractor representation at the high score to make everything + -- line up nicely. The detractor is just there to give some indication + -- of review requests that did not count positively toward the score. + let idt = highScore `minus` (totalWidth x) + remainingSpace = highScore `minus` (score x) + in bar idt (score x) (min remainingSpace (detractor x)) (bonus x) <++> (label x) + + graph : Graphable g => (highScore : Nat) -> List g -> Doc AnsiStyle + graph highScore = vsep . map (graphOne highScore) ||| Produce a graph of open pull requests per month (by the month the PR was created). export -healthGraph : (openPullRequests : List PullRequest) +healthGraph : Config => + (openPullRequests : List PullRequest) -> (org : String) -> (repo : String) -> Doc AnsiStyle -healthGraph openPullRequests org repo = +healthGraph @{config} openPullRequests org repo = let groups = groupBy ((==) `on` .month `on` .createdAt) $ sortBy (compare `on` .createdAt) openPullRequests max = foldr (\xs,m => max (length xs) m) 1 groups in vsep [ header - , graph max (unfoldGraph (limit 48) groups Nothing) + , graph config max (unfoldGraph (limit 48) groups Nothing) , emptyDoc , pretty link , emptyDoc @@ -137,9 +143,6 @@ healthGraph openPullRequests org repo = placeholder = MkPRsOnDate placeholderDate 0 in unfoldGraph fuel (next :: xs) (Just (placeholderDate, placeholder ::: forget acc)) - yellowDot : Doc AnsiStyle - yellowDot = annotate (color Yellow) "·" - header : Doc AnsiStyle header = vsep $ catMaybes [ Just $ emptyDoc @@ -155,13 +158,13 @@ healthGraph openPullRequests org repo = ||| @ completedReviews Optionally pass a map from login to count of completed reviews to ||| graph as well. export -reviewsGraph : Ord login => Pretty login => +reviewsGraph : Config => Ord login => Pretty login => (closedReviews : List login) -> (openReviews : List login) -> (candidates : List login) -> (completedReviews : Maybe (SortedMap login Nat)) -> Doc AnsiStyle -reviewsGraph closedReviews openReviews candidates completedReviews = +reviewsGraph @{config} closedReviews openReviews candidates completedReviews = let scoredOptions = reverse $ scoredReviewers closedReviews openReviews (sort $ nub candidates) augmentedOptions : List (AugmentedReviewScore login) = case completedReviews of @@ -173,27 +176,27 @@ reviewsGraph closedReviews openReviews candidates completedReviews = ((MkScore _ s c) :: _) => let highScore = c + (s `minus` c) + maxBonus in vsep [ header - , graph (if highScore > 0 then highScore else 1) augmentedOptions + , graph config (if highScore > 0 then highScore else 1) augmentedOptions , footer ] where - yellowDot : Doc AnsiStyle - yellowDot = annotate (color Yellow) "·" + pendingDot : Doc AnsiStyle + pendingDot = theme Pending' $ pretty "·" - redDot : Doc AnsiStyle - redDot = annotate (color Red) "◦" + missedDot : Doc AnsiStyle + missedDot = theme Missed $ pretty "◦" - greenBox : Doc AnsiStyle - greenBox = annotate (color Green) "▪" + completedBox : Doc AnsiStyle + completedBox = theme Completed $ pretty "▪" header : Doc AnsiStyle header = vsep $ catMaybes [ Just $ emptyDoc , Just $ pretty "Weighted review workload." - , Just $ pretty "4x the number of open review requests" <++> parens yellowDot - , Just $ pretty "1x the number of closed PRs with unanswered review requests" <++> parens redDot - , if (null completedReviews) then Nothing else Just $ pretty "1x the number of completed reviews" <++> parens greenBox - , Just $ parens $ redDot <++> pretty "overlayed on" <++> yellowDot + , Just $ pretty "4x the number of open review requests" <++> parens pendingDot + , Just $ pretty "1x the number of closed PRs with unanswered review requests" <++> parens missedDot + , if (null completedReviews) then Nothing else Just $ pretty "1x the number of completed reviews" <++> parens completedBox + , Just $ parens $ missedDot <++> pretty "overlayed on" <++> pendingDot , Just $ emptyDoc ] diff --git a/src/Language/JSON/Accessors.idr b/src/Language/JSON/Accessors.idr index f6bbec5..942af6d 100644 --- a/src/Language/JSON/Accessors.idr +++ b/src/Language/JSON/Accessors.idr @@ -30,6 +30,13 @@ string : JSON -> Either String String string (JString x) = Right x string json = Left "Expected a string but found \{show json}." +export +stringy : (desc : String) -> (String -> Maybe a) -> JSON -> Either String a +stringy d f (JString x) = case f x of + (Just y) => Right y + Nothing => Left "Expected \{d} but found \{show x}." +stringy d f json = Left "Expected a string but found \{show json}." + export integer : JSON -> Either String Integer integer (JInteger x) = Right $ cast x diff --git a/src/Theme.idr b/src/Theme.idr new file mode 100644 index 0000000..517d838 --- /dev/null +++ b/src/Theme.idr @@ -0,0 +1,51 @@ +module Theme + +import Data.Config +import Data.Theme +import Text.PrettyPrint.Prettyprinter +import Text.PrettyPrint.Prettyprinter.Render.Terminal + +%default total + +record Colors where + constructor MkCs + foreground : Maybe Color + background : Maybe Color + +cs : List Color -> Colors +cs [foreground] = MkCs (Just foreground) Nothing +cs [foreground, background] = MkCs (Just foreground) (Just background) +cs _ = MkCs Nothing Nothing + +||| The prime variants where they exist are for situations where the +||| character being drawn is small so a different color choice might +||| be useful for visibility. +public export +data SemanticColor : Colors -> Colors -> Type where + Good : SemanticColor (cs [Green ]) (cs [Green]) + NotGreat : SemanticColor (cs [Yellow]) (cs [Black]) + Bad : SemanticColor (cs [Red ]) (cs [Red]) + Completed : SemanticColor (cs [Green ]) (cs [Green]) + Completed' : SemanticColor (cs [Green ]) (cs [Black]) + Pending : SemanticColor (cs [Yellow]) (cs [Yellow]) + Pending' : SemanticColor (cs [Yellow]) (cs [Black]) + Missed : SemanticColor (cs [Red ]) (cs [Red]) + Data : SemanticColor (cs [Green ]) (cs [Blue]) + +public export +theme : Config => {d, l : _} -> SemanticColor d l -> Doc AnsiStyle -> Doc AnsiStyle +theme @{config} = go configTheme + where + configTheme : Theme + configTheme = config.theme + + maybeAnnotate : (Color -> AnsiStyle) -> Maybe Color -> Doc AnsiStyle -> Doc AnsiStyle + maybeAnnotate s c = maybe id (annotate . s) c + + colorsAnn : Colors -> Doc AnsiStyle -> Doc AnsiStyle + colorsAnn (MkCs fg bg) = maybeAnnotate color fg . maybeAnnotate bgColor bg + + go : Theme -> {dark, light : _} -> SemanticColor dark light -> Doc AnsiStyle -> Doc AnsiStyle + go Dark _ = colorsAnn dark + go Light _ = colorsAnn light + diff --git a/src/User.idr b/src/User.idr index 83b062d..b21b520 100644 --- a/src/User.idr +++ b/src/User.idr @@ -11,6 +11,7 @@ import Data.User import FFI.Git import FFI.GitHub import PullRequest +import Theme import Util import Text.PrettyPrint.Prettyprinter @@ -18,9 +19,9 @@ import Text.PrettyPrint.Prettyprinter.Render.Terminal %default total -replicate' : Color -> Nat -> Char -> Doc AnsiStyle +replicate' : Config => {d,l : _} -> SemanticColor d l -> Nat -> Char -> Doc AnsiStyle replicate' c n char = - annotate (color c) (pretty $ String.replicate n char) + theme c . pretty $ String.replicate n char namespace Reflect prCount : Fin 101 @@ -48,18 +49,19 @@ namespace Reflect intro = "Your current pull request summary (out of the past \{show prCount} PRs):" parameters (pageWidth : Nat, reviews : Nat, openReq : Nat, closedReq : Nat, closedAuth : Nat, openAuth : Nat) - chart : (leftPadding : Nat) + chart : Config => + (leftPadding : Nat) -> Doc AnsiStyle chart leftPadding = indent (cast leftPadding) $ - replicate' Green reviews '·' - <+> replicate' Red closedReq '◦' - <+> replicate' Yellow openReq '<' + replicate' Completed' reviews '·' + <+> replicate' Missed closedReq '◦' + <+> replicate' Pending openReq '<' <++> pretty "|" - <++> replicate' Yellow openAuth '>' - <+> replicate' Green closedAuth '·' + <++> replicate' Pending openAuth '>' + <+> replicate' Completed' closedAuth '·' - graph : Doc AnsiStyle + graph : Config => Doc AnsiStyle graph = let req = openReq + closedReq auth = openAuth + closedAuth @@ -99,7 +101,7 @@ namespace Reflect , annotate italic $ pretty "*review count (not PR count) of most recent \{show reviewDetailsCount} PRs." ] - print : Doc AnsiStyle + print : Config => Doc AnsiStyle print = vsep [ emptyDoc , graph @@ -138,11 +140,12 @@ namespace Reflect earliestOpenReq namespace Me - print : (gitEmail : Maybe String) + print : Config + -> (gitEmail : Maybe String) -> (githubUser : User) -> (githubTeams : List String) -> Doc AnsiStyle - print gitEmail githubUser githubTeams = + print config gitEmail githubUser githubTeams = vsep [ emptyDoc , email @@ -160,19 +163,19 @@ namespace Me it : String -> Doc AnsiStyle it = annotate italic . pretty - green : String -> Doc AnsiStyle - green = annotate (color Green) . pretty + dataVal : String -> Doc AnsiStyle + dataVal = theme Data . pretty email : Doc AnsiStyle email = "Git Email:" <++> case gitEmail of - Just e => green e + Just e => dataVal e Nothing => it "Not set" fullName : Doc AnsiStyle - fullName = "GitHub Name:" <++> green githubUser.name + fullName = "GitHub Name:" <++> dataVal githubUser.name login : Doc AnsiStyle - login = "GitHub Login:" <++> green githubUser.login + login = "GitHub Login:" <++> dataVal githubUser.login teams : Doc AnsiStyle teams = vsep $ @@ -184,11 +187,11 @@ namespace Me export printInfoOnSelf : Config => Octokit => Git => Promise () - printInfoOnSelf = do + printInfoOnSelf @{config} = do gitEmail <- handleUnsetEmail <$> userEmail githubUser <- getSelf githubTeams <- sort <$> listMyTeams - renderIO $ print gitEmail githubUser githubTeams + renderIO $ print config gitEmail githubUser githubTeams where handleUnsetEmail : String -> Maybe String handleUnsetEmail "" = Nothing diff --git a/test/expected_help.txt b/test/expected_help.txt index dc4a4c4..89c1408 100644 --- a/test/expected_help.txt +++ b/test/expected_help.txt @@ -9,7 +9,7 @@ Subcommands: Get or set the value of a configuration property. Not all properties can be set and read via this subcommand. properties: requestTeams, requestUsers, commentOnRequest, defaultRemote, - mainBranch, githubPAT, assignUsers, assignTeams, + mainBranch, theme, githubPAT, assignUsers, assignTeams, commentOnAssign contribute [-c/--checkout] [-] [-i/--ignore {/}] Contribute to an open PR. Prints a URL. Prioritizes PRs you are requested