checkmate 0.2.1 → 0.3.0
raw patch · 6 files changed
+553/−113 lines, 6 filesdep +processdep ~github
Dependencies added: process
Dependency ranges changed: github
Files
- CHANGELOG.md +29/−2
- README.md +194/−1
- app/Main.hs +174/−86
- checkmate.cabal +4/−2
- src/Checkmate/Discover.hs +30/−22
- src/Checkmate/Publisher/GitHub.hs +122/−0
CHANGELOG.md view
@@ -1,6 +1,33 @@ Checkmate changelog =================== +Version 0.3.0+-------------++Released on October 21, 2017.++### Frontend++ - Added a new filename *.check* besides *CHECK* as directory-level checklist+ file.++ - `checkmate github` command became to leave no comment when there are+ nothing to `CHECK` corresponding to the given diff. It also removes+ the existing comment previously left by Checkmate on the same pull request.++ - Added `checkmate github-travis` and `checkmate github-circle` commands,+ shortcuts of `checkmate github` for Travis CI and Circle CI integration.+ It even doesn't need the result of `git diff`.++ - `checkmate` and its subcommands became to terminate with a proper non-zero+ exit code and print messages to /dev/stderr instead of /dev/stdout when+ it fails to read diff.++### Internals++ - Added `Checkmate.Publisher` and `Checkmate.Publisher.GitHub` module.++ Version 0.2.1 ------------- @@ -76,14 +103,14 @@ Released on September 20, 2017. -### Program+### Frontend - Checklist texts generated by `checkmate commonmark`, `checkmate gfm`, and `checkmate github` became to have two levels of headings. The top-level heading is still the title of the checklist as it has been, and the second-level heading is a corresponding file path of its following checks. -### Library+### Internals - Added `Checkmate.Renderer` module.
README.md view
@@ -4,9 +4,202 @@ [![Build Status][ci-badge]][ci] [![Hackage][hackage-badge]][hackage] -Generate checklists relevant to a given patch.+Checkmate is a small program to generate human-readable checklists from+a given patch (or pull request). Leave `CHECK` comments (that are the same+fashion as `FIXME` or `TODO` comments); then Checkmate detects when a diff+touches some code scopes having any `CHECK` comments, and lists the checks. +It helps contributors and reviewers to remind matters that require attention+when a part of the code is changed.+++Situation+---------++Let's say there's a dictionary, and we should update the manual when a key+is added to or removed from it:++~~~~~~~~ python+TARGET_LANGUAGES = {+ # CHECK: Please update the manual on the project wiki when you add/remove+ # a language.++ 'c': '*.c',+ 'java': '*.java',+ 'javascript': '*.js',+ 'python': '*.py',+}+~~~~~~~~++The above example may be artificial, but suppose lines of the dictionary are+lengthy. Such tasks should be done outside of the source code repository+so that they cannot be automated by simply eliminating code duplicates.+Contributors and reviewers altogether are easy to forget about such tasks.++To remind peers of such tasks, Checkmate detects `CHECK` comments like the above+example when a relevant *code block* is touched and show peers a checklist.+ [ci-badge]: https://travis-ci.org/spoqa/checkmate.svg?branch=master [ci]: https://travis-ci.org/spoqa/checkmate [hackage-badge]: https://img.shields.io/hackage/v/checkmate.svg [hackage]: https://hackage.haskell.org/package/checkmate+++Listing relevant checks: overlapped blocks+------------------------------------------++How does Checkmate list only relevant checks to a diff? It currently doesn't+have any language-specific algorithms, but only a language-agnostic heuristics+on indented blocks.++Suppose the following diff:++~~~~~~~~ diff+diff --git a/langs.py b/langs.py+--- a/langs.py++++ b/langs.py+@@ -5,6 +5,7 @@ TARGET_LANGUAGES = {+ 'c': '*.c',+ 'java': '*.java',+ 'javascript': '*.js',++ 'haskell': '*.hs',+ 'python': '*.py',+ }+ +~~~~~~~~++Since it touched a code block with a `CHECK` comment, Checkmate generates+the following checklist:++> - Please update the manual on the project wiki when you add/remove a language.++Suppose a patch touches only code blocks without any `CHECK` comments too, e.g.:++~~~~~~~~ diff+diff --git a/langs.py b/langs.py+--- a/langs.py++++ b/langs.py+@@ -8,6 +8,7 @@ TARGET_LANGUAGES = {+ 'python': '*.py',+ }+ + OTHER_DATA = {+ # This code block is not relevant to TARGET_LANGUAGES.++ 'haskell': '*.hs',+ }+~~~~~~~~++Since the touched block doesn't have any `CHECK` comments, Checkmate generates+an empty checklist.++Note that it doesn't parse code's semantics, but only scans blocks through+indentation. Even if a block is wrapped in curly braces without indentation,+it isn't counted as a block.+++Directory-level checklist+-------------------------++Some checks may need to be listed for a whole directory. Checkmate recognizes+files named *.check* or *CHECK* in a directory and include checks in that to+the checklist if any file in the directory are changed. Its syntax is basically+a simple bullet list and a bullet can be `*`/`-`/`+`/`CHECK` or digits followed+by `.`/`)`, e.g.:++ - Check 1+ - Check 2++ + A plus sign too can be a bullet.+ * An asterisk too.++ 1. Numbered-bullets also can be used.+ 2) A closing parenthesis as well can follow instead of a period.++ CHECK: For consistency `CHECK` keyword also can be a bullet as well.+ CHECK And a colon can be omitted.+ Lines without any bullet is continued from previous line(s).+++Download+--------++We provide an official Linux x86_64 binary for [every release][]. See also+the [latest release][]. Note that official binaries are distributed as+statically-linked standalone executable, and they aren't gzipped. Download and+give an `+x` permission; then it's ready.++On the other platforms you can download and install using Haskell [Cabal][]+or [Stack][] since source tarballs also are distributed on [Hackage][]:++~~~~~~~~ bash+stack install checkmate+~~~~~~~~++[every release]: https://github.com/spoqa/checkmate/releases+[latest release]: https://github.com/spoqa/checkmate/releases/latest+[Cabal]: https://www.haskell.org/cabal/+[Stack]: https://www.haskellstack.org/+++Integration with CI+-------------------++Since Checkmate usually is executed as a part of CI build, we show examples+for widely-used CI services.++All examples assume the environment variables are defined:++ - `GITHUB_TOKEN` contains the access token to leave comments on a+ corresponding GitHub repository. See also GitHub's official article+ about [personal API tokens][].+ - `CHECKMATE_DOWNLOAD_URL` contains the download link to the prebuilt binary+ of the latest release, i.e.:++ ~~~~~~~ bash+ CHECKMATE_DOWNLOAD_URL=https://github.com/spoqa/checkmate/releases/download/0.3.0/checkmate-linux-x86_64+ ~~~~~~~++[personal API tokens]: https://github.com/blog/1509-personal-api-tokens+++### Travis CI++~~~~~~~~ yaml+install:+- curl -L -o ~/bin/checkmate "$CHECKMATE_DOWNLOAD_URL"+- chmod +x ~/bin/checkmate+script:+- ~/bin/checkmate github-travis --token "$GITHUB_TOKEN"+~~~~~~~~+++### Circle CI++~~~~~~~~ yaml+dependencies:+ post:+ - curl -L -o ~/bin/checkmate "$CHECKMATE_DOWNLOAD_URL"+ - chmod +x ~/bin/checkmate+test:+ post:+ - ~/bin/checkmate github-circle --token "$GITHUB_TOKEN"+~~~~~~~~+++### Other CI softwares/services++You can run `checkmate github` command with explicit arguments:++~~~~~~~~ bash+curl -L -o ~/bin/checkmate "$CHECKMATE_DOWNLOAD_URL"+chmod +x ~/bin/checkmate+# Suppose we're running a build of github.com/foo/bar/pull/123+~/bin/checkmate github \+ --token "$GITHUB_TOKEN" \+ --login foo \+ --repo bar \+ --pr 123+~~~~~~~~++If you're using GitHub Enterprise on premise use `--endpoint` option.+Further reading: `checkmate github --help`.
app/Main.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE OverloadedStrings #-}-import Data.Foldable+import Control.Monad+import Data.List (elemIndices)+import Data.List.NonEmpty (nonEmpty, last) import Data.Maybe import Data.Semigroup ((<>)) import Prelude hiding (error)@@ -7,123 +9,149 @@ import System.Exit import System.IO -import Data.Text hiding (find)+import Data.Text import Data.Text.Encoding import Data.Text.IO as TIO-import GitHub.Auth-import GitHub.Data.Comments-import GitHub.Data.Definitions-import GitHub.Data.Id-import GitHub.Data.Issues-import GitHub.Data.Name-import GitHub.Data.Repos-import GitHub.Data.URL-import GitHub.Endpoints.Issues.Comments (comments', createComment, editComment)-import GitHub.Endpoints.Users (userInfoCurrent') import Options.Applicative import System.Directory+import System.Process hiding (cwd) import Checkmate.Check import Checkmate.Discover+import Checkmate.Publisher.GitHub import Checkmate.Renderer -type Command = App -> Checklist -> IO ()+type InputReader = App -> IO Text+type CommandRunner = App -> Checklist -> IO () +data Command = Command+ { inputReader :: InputReader+ , commandRunner :: CommandRunner+ }+ data App = App- { inputFilePath :: FilePath+ { inputFilePath :: Maybe FilePath , appCommand :: Command } withInputFile :: App -> (Handle -> IO r) -> IO r-withInputFile App { inputFilePath = "-" } action' = do+withInputFile App { inputFilePath = Nothing } action' = do let i = stdin r <- action' i hClose i return r-withInputFile App { inputFilePath = i } action' =+withInputFile app@App { inputFilePath = Just "-" } action' =+ withInputFile (app { inputFilePath = Nothing }) action'+withInputFile App { inputFilePath = Just i } action' = withFile i ReadMode action' +readInputFile :: App -> IO Text+readInputFile = (`withInputFile` TIO.hGetContents)++readDiff :: App -> IO (Either String FileDeltas)+readDiff app@App{ appCommand = Command { inputReader = readInput } } =+ parseDiff <$> readInput app++listChecks :: App -> IO Checklist+listChecks app = do+ d <- readDiff app+ cwd <- getCurrentDirectory+ case d of+ Left msg -> die msg+ Right deltas -> discover cwd deltas+ appP :: Parser App appP = App- <$> strOption ( long "input-file"- <> short 'i'- <> metavar "FILE"- <> showDefault- <> value "-"- <> help "A diff text to extract a checklist from"- )+ <$> option (Just <$> str)+ ( long "input-file"+ <> short 'i'+ <> metavar "FILE"+ <> value Nothing+ <> help "A diff text to extract a checklist from"+ ) <*> subparser ( command "commonmark" commonmarkPI <> command "gfm" gfmPI <> command "github" githubPI+ <> command "github-circle" githubCirclePI+ <> command "github-travis" githubTravisPI ) commonmarkPI :: ParserInfo Command-commonmarkPI = info (pure cmd) $+commonmarkPI = info (pure $ Command readInputFile cmd) $ progDesc "Print a checklist as CommonMark (i.e. Markdown) format." where- cmd :: Command+ cmd :: CommandRunner cmd _ checklist = do cwd <- getCurrentDirectory TIO.putStr $ toCommonMark cwd 1 checklist gfmPI :: ParserInfo Command-gfmPI = info (pure cmd) $+gfmPI = info (pure $ Command readInputFile cmd) $ progDesc "Print a checklist as GitHub Flavored Markdown format." where- cmd :: Command+ cmd :: CommandRunner cmd _ checklist = do cwd <- getCurrentDirectory TIO.putStr $ toGFMarkdown cwd 1 checklist +githubTokenOption :: Parser Token+githubTokenOption = option (encodeUtf8 . pack <$> str)+ ( long "access-token"+ <> long "token"+ <> short 't'+ <> metavar "TOKEN"+ <> help "GitHub OAuth access token"+ )++leaveGithubComment :: Maybe OwnerName+ -> RepoName+ -> PullRequestId+ -> Token+ -> Maybe Text+ -> CommandRunner+leaveGithubComment owner' repo pr accessToken endpoint _ checklist = do+ cwd <- getCurrentDirectory+ r <- leaveComment owner' repo pr accessToken endpoint cwd checklist+ case r of+ Right Nothing -> return ()+ Right (Just (URL url)) -> TIO.putStrLn url+ Left e -> handleGithubError e++githubInputReader :: IO (Maybe OwnerName, RepoName, PullRequestId)+ -> String+ -> Token -> InputReader+githubInputReader identifier headEnvironKey accessToken (App Nothing _) = do+ (owner, repo, prId) <- identifier+ result <- pullRequestBaseSha owner repo prId accessToken Nothing+ base <- case result of+ Left e -> handleGithubError e+ Right sha -> return sha+ head' <- environ headEnvironKey+ let range = unpack base ++ ".." ++ head'+ diff <- readProcess "git" ["diff", range] ""+ return $ pack diff+githubInputReader _ _ _ app = readInputFile app++githubCommandRunner :: IO (Maybe OwnerName, RepoName, PullRequestId)+ -> Token -> CommandRunner+githubCommandRunner identifier accessToken app checklist = do+ (owner, repo, prId) <- identifier+ leaveGithubComment owner repo prId accessToken Nothing app checklist++handleGithubError :: Checkmate.Publisher.GitHub.Error -> IO a+handleGithubError (HTTPError httpError) = printError $ pack $ show httpError+handleGithubError (ParseError message) = printError message+handleGithubError (JsonError message) = printError message+handleGithubError (UserError message) = printError message+ githubPI :: ParserInfo Command githubPI = info (parser <**> helper) $ progDesc $ "Create a checklist comment on the corresponding pull " ++ "reuqest on GitHub." where- cmd :: Maybe (Name Owner)- -> Name Repo- -> Id Issue- -> Token- -> Maybe Text- -> Command- cmd owner' repo pr accessToken endpoint _ checklist = do- user <- userInfoCurrent' auth >>= error- let owner = fromMaybe (N . untagName $ userLogin user) owner'- prComments <- comments' (Just auth) owner repo pr >>= error- let checklistComment = find (isChecklist user) prComments- leave = case checklistComment of- Nothing -> createComment auth owner repo pr- Just IssueComment { issueCommentId = cid } ->- editComment auth owner repo $ Id cid- cwd <- getCurrentDirectory- Comment { commentHtmlUrl = leftCommentUrl } <-- leave (signature `append` toGFMarkdown cwd 3 checklist) >>= error- case leftCommentUrl of- Just (URL u) -> TIO.putStrLn u- _ -> return ()- where- auth :: Auth- auth = case endpoint of- Nothing -> OAuth accessToken- Just e -> EnterpriseOAuth e accessToken- signature :: Text- signature = "<!-- COMMENT BY CHECKMATE -->\n"- isChecklist :: User -> IssueComment -> Bool- isChecklist User { userId = uid }- IssueComment { issueCommentBody = cBody- , issueCommentUser =- SimpleUser { simpleUserId = authorId }- } =- uid == authorId && isPrefixOf signature cBody- error :: Either Error a -> IO a- error (Right v) = return v- error (Left (HTTPError httpError)) = printError $ pack $ show httpError- error (Left (ParseError message)) = printError message- error (Left (JsonError message)) = printError message- error (Left (UserError message)) = printError message parser :: Parser Command parser = cmd- <$> option (Just . (N :: Text -> Name Owner) . pack <$> str)+ <$> option (Just . mkOwnerName . pack <$> str) ( long "owner" <> long "login" <> short 'l'@@ -134,7 +162,7 @@ "\"github.com/foo/bar\". The currently authenticated " ++ "user (through -t/--access-token/--token) by default") )- <*> option ((N :: Text -> Name Repo) . pack <$> str)+ <*> option (mkRepoName . pack <$> str) ( long "repository" <> long "repo" <> short 'r'@@ -142,20 +170,14 @@ <> help ("Name of GitHub repository of a pull request to create " ++ "a checklist comment. \"bar\" of \"github.com/foo/bar\"") )- <*> option ((Id :: Int -> Id Issue) <$> (auto :: ReadM Int))+ <*> option (mkPullRequestId <$> (auto :: ReadM Int)) ( long "pull-request" <> long "pr" <> short 'p' <> metavar "NUM" <> help "No. of pull request to create a checklist comment" )- <*> option (encodeUtf8 . pack <$> str)- ( long "access-token"- <> long "token"- <> short 't'- <> metavar "TOKEN"- <> help "GitHub OAuth access token"- )+ <*> githubTokenOption <*> option (Just . dropWhileEnd (== '/') . pack <$> str) ( long "enterprise-endpoint" <> short 'e'@@ -163,13 +185,84 @@ <> value Nothing <> help "API endpoint URL for GitHub Enterprise (if applicable)" )+ cmd :: Maybe OwnerName -> RepoName -> PullRequestId -> Token -> Maybe Text+ -> Command+ cmd owner repo prId token endpoint =+ Command readInputFile+ (leaveGithubComment owner repo prId token endpoint) +githubCirclePI :: ParserInfo Command+githubCirclePI = info (parser <**> helper) $+ progDesc $ "Create a checklist comment on the corresponding pull " +++ "reuqest on GitHub from Circle CI. It depends on the " +++ "following environment variables: CI_PULL_REQUEST, " +++ "CIRCLE_PROJECT_REPONAME, CIRCLE_PROJECT_USERNAME, CIRCLE_SHA1"+ where+ parser :: Parser Command+ parser = fmap cmd githubTokenOption+ cmd :: Token -> Command+ cmd token = Command (githubInputReader identifier "CIRCLE_SHA1" token)+ (githubCommandRunner identifier token)+ identifier :: IO (Maybe OwnerName, RepoName, PullRequestId)+ identifier = do+ pr <- environ "CI_PULL_REQUEST"+ case nonEmpty $ elemIndices '/' pr of+ Nothing -> do+ System.IO.hPutStrLn stderr "This is not a PR build; skipped..."+ exitSuccess -- It shouldn't be marked as failure on CI builds+ Just slashes -> do+ let lastPart = Prelude.drop+ (succ $ Data.List.NonEmpty.last slashes)+ pr+ prId = mkPullRequestId $ read lastPart+ owner <- environ "CIRCLE_PROJECT_USERNAME"+ repo <- environ "CIRCLE_PROJECT_REPONAME"+ return ( Just $ mkOwnerName $ pack owner+ , mkRepoName $ pack repo+ , prId+ )++githubTravisPI :: ParserInfo Command+githubTravisPI = info (parser <**> helper) $+ progDesc $ "Create a checklist comment on the corresponding pull " +++ "reuqest on GitHub from Travis CI. It depends on the " +++ "following environment variables: TRAVIS_PULL_REQUEST, " +++ "TRAVIS_PULL_REQUEST_SHA, TRAVIS_REPO_SLUG."+ where+ parser :: Parser Command+ parser = cmd <$> githubTokenOption+ cmd :: Token -> Command+ cmd token = Command+ (githubInputReader identifier "TRAVIS_PULL_REQUEST_SHA" token)+ (githubCommandRunner identifier token)+ identifier :: IO (Maybe OwnerName, RepoName, PullRequestId)+ identifier = do+ pr <- environ "TRAVIS_PULL_REQUEST"+ case pr of+ "false" -> do+ System.IO.hPutStrLn stderr "This is not a PR build; skipped..."+ exitSuccess -- It shouldn't be marked as failure on CI builds+ _ -> do+ let prId = mkPullRequestId $ read pr+ slug <- pack <$> environ "TRAVIS_REPO_SLUG"+ let (o, r) = Data.Text.break (== '/') slug+ owner = mkOwnerName o+ repo = mkRepoName $ Data.Text.drop 1 r+ return (Just owner, repo, prId)+ appPI :: ParserInfo App appPI = info (appP <**> helper) ( fullDesc <> progDesc "Generate checklists relevant to a given patch." ) +environ :: String -> IO String+environ name = do+ r <- lookupEnv name+ case r of+ Nothing -> printError $ pack name `append` " is not defined."+ Just v -> return v+ printError :: Text -> IO a printError message = do prog <- getProgName@@ -177,11 +270,6 @@ main :: IO () main = do- app@App { appCommand = cmd' } <- execParser appPI- cwd <- getCurrentDirectory- diff <- withInputFile app TIO.hGetContents- case parseDiff diff of- Left msg -> System.IO.putStrLn msg- Right deltas -> do- checklist <- discover cwd deltas- cmd' app checklist+ app@App { appCommand = Command { commandRunner = cmd } } <- execParser appPI+ checklist <- listChecks app+ cmd app checklist
checkmate.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: checkmate-version: 0.2.1+version: 0.3.0 synopsis: Generate checklists relevant to a given patch category: Development stability: alpha@@ -43,6 +43,7 @@ , range >= 0.1.2 && < 0.2.0 , text == 1.* , containers >= 0.5.7.1 && < 0.6.0.0+ , github == 0.17.* , monad-parallel >= 0.7.2.2 && < 0.8.0.0 exposed-modules: Checkmate.Check@@ -50,6 +51,7 @@ Checkmate.Discover Checkmate.Parser.CheckFile Checkmate.Parser.IndentBlock+ Checkmate.Publisher.GitHub Checkmate.Renderer default-language: Haskell2010 @@ -67,8 +69,8 @@ , range >= 0.1.2 && < 0.2.0 , text == 1.* , checkmate- , github == 0.16.* , optparse-applicative >= 0.13.2.0 && < 0.15.0.0+ , process >= 1.4.3.0 && < 1.5.0.0 if flag(static) ghc-options: -fwarn-incomplete-uni-patterns -threaded -rtsopts -with-rtsopts=-N -static -optl-static -optl-pthread -optc-Os -fPIC else
src/Checkmate/Discover.hs view
@@ -1,5 +1,6 @@ module Checkmate.Discover- ( discover+ ( FileDeltas+ , discover , discoverDirectory , discoverFile , parseDiff@@ -19,8 +20,13 @@ import Checkmate.Parser.CheckFile import Checkmate.Parser.IndentBlock -checkFileName :: FilePath-checkFileName = "CHECK"+checkFileNames :: Set FilePath+checkFileNames = fromList+ -- CHECK: All checklist filenames that Checkmate recognize should be+ -- written in the project docs (i.e. README.md).+ [ "CHECK"+ , ".check"+ ] discover :: FilePath -> FileDeltas -> IO Checklist discover baseDirPath deltas = do@@ -31,28 +37,30 @@ return . unions $ checklists ++ dirChecklists discoverDirectory :: FilePath -> FilePath -> IO Checklist-discoverDirectory baseDirPath dirPath = do- dirExist <- doesDirectoryExist dirPath'- if not dirExist then return S.empty else do- checkFileExist <- doesFileExist checkFilePath- checklist <-- if checkFileExist- then do- result <- parseCheckFile checkFilePath- return $ case result of- Left _ -> S.empty- Right checklist -> checklist- else return S.empty- parentChecklist <-- if dirPath == "." || dirPath == "" || parent == dirPath- then return S.empty- else discoverDirectory baseDirPath parent- return $ S.union checklist parentChecklist+discoverDirectory baseDirPath dirPath = fmap unions $ forM checkFileNames' $+ \ checkFileName -> do+ let checkFilePath = dirPath' </> checkFileName+ dirExist <- doesDirectoryExist dirPath'+ if not dirExist then return S.empty else do+ checkFileExist <- doesFileExist checkFilePath+ checklist <-+ if checkFileExist+ then do+ result <- parseCheckFile checkFilePath+ return $ case result of+ Left _ -> S.empty+ Right checklist -> checklist+ else return S.empty+ parentChecklist <-+ if dirPath == "." || dirPath == "" || parent == dirPath+ then return S.empty+ else discoverDirectory baseDirPath parent+ return $ S.union checklist parentChecklist where+ checkFileNames' :: [FilePath]+ checkFileNames' = toList checkFileNames dirPath' :: FilePath dirPath' = baseDirPath </> dirPath- checkFilePath :: FilePath- checkFilePath = dirPath' </> checkFileName parent :: FilePath parent = takeDirectory dirPath
+ src/Checkmate/Publisher/GitHub.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings #-}+module Checkmate.Publisher.GitHub+ ( Error (..)+ , OwnerName+ , PullRequestId+ , RepoName+ , Token+ , URL (URL)+ , leaveComment+ , mkOwnerName+ , mkPullRequestId+ , mkRepoName+ , pullRequestBaseSha+ ) where++import Control.Exception+import Data.Foldable+import Data.Maybe++import Data.Text hiding (find, null)+import GitHub.Auth+import GitHub.Data.Comments+import GitHub.Data.Definitions+import GitHub.Data.Id+import GitHub.Data.Issues+import GitHub.Data.Name+import GitHub.Data.PullRequests+import GitHub.Data.Repos+import GitHub.Data.URL+import GitHub.Endpoints.Issues.Comments+ ( comments'+ , createComment+ , deleteComment+ , editComment+ )+import GitHub.Endpoints.PullRequests (pullRequest)+import GitHub.Endpoints.Users (userInfoCurrent')++import Checkmate.Check (Checklist)+import Checkmate.Renderer++type PullRequestId = Id PullRequest+type OwnerName = Name Owner+type RepoName = Name Repo++mkPullRequestId :: Int -> PullRequestId+mkPullRequestId = Id++mkOwnerName :: Text -> OwnerName+mkOwnerName = N++mkRepoName :: Text -> RepoName+mkRepoName = N++leaveComment :: Maybe OwnerName+ -> RepoName+ -> PullRequestId+ -> Token+ -> Maybe Text+ -> FilePath+ -> Checklist+ -> IO (Either Error (Maybe URL))+leaveComment owner' repo prId accessToken endpoint basePath checklist = try $ do+ user <- userInfoCurrent' auth >>= error'+ let owner = fromMaybe (N . untagName $ userLogin user) owner'+ prComments <- comments' (Just auth) owner repo issueId' >>= error'+ let checklistComment = find (isChecklist user) prComments+ if null checklist+ then+ case checklistComment of+ Nothing -> return Nothing+ Just IssueComment { issueCommentId = cid } -> do+ deleteComment auth owner repo (Id cid) >>= error'+ return Nothing+ else do+ let leave = case checklistComment of+ Nothing -> createComment auth owner repo issueId'+ Just IssueComment { issueCommentId = cid } ->+ editComment auth owner repo $ Id cid+ Comment { commentHtmlUrl = leftCommentUrl } <-+ leave (signature `append` toGFMarkdown basePath 3 checklist)+ >>= error'+ return leftCommentUrl+ where+ issueId' :: Id Issue+ issueId' = Id $ untagId prId+ auth :: Auth+ auth = case endpoint of+ Nothing -> OAuth accessToken+ Just e -> EnterpriseOAuth e accessToken+ signature :: Text+ signature = "<!-- COMMENT BY CHECKMATE -->\n"+ isChecklist :: User -> IssueComment -> Bool+ isChecklist User { userId = uid }+ IssueComment { issueCommentBody = cBody+ , issueCommentUser =+ SimpleUser { simpleUserId = authorId }+ } =+ uid == authorId && isPrefixOf signature cBody++pullRequestBaseSha :: Maybe OwnerName+ -> RepoName+ -> PullRequestId+ -> Token+ -> Maybe Text+ -> IO (Either Error Text)+pullRequestBaseSha owner' repo prId accessToken endpoint = try $ do+ user <- userInfoCurrent' auth >>= error'+ let owner = fromMaybe (N . untagName $ userLogin user) owner'+ PullRequest+ { pullRequestBase = PullRequestCommit { pullRequestCommitSha = sha }+ } <- pullRequest owner repo prId >>= error'+ return sha+ where+ auth :: Auth+ auth = case endpoint of+ Nothing -> OAuth accessToken+ Just e -> EnterpriseOAuth e accessToken++error' :: Either Error a -> IO a+error' (Right v) = return v+error' (Left e) = throwIO e