|
| 1 | +{-# LANGUAGE LambdaCase #-} |
1 | 2 | {-# LANGUAGE OverloadedStrings #-} |
2 | | -module CreateIssue where |
3 | 3 |
|
4 | | -import qualified Github.Auth as Github |
5 | | -import qualified Github.Issues as Github |
| 4 | +import Data.String (fromString) |
| 5 | +import qualified Data.Text as Text (unpack) |
| 6 | +import qualified Data.Vector as Vector (fromList) |
| 7 | +import qualified GitHub.Auth as GitHub |
| 8 | +import qualified GitHub.Data.Issues as GitHub |
| 9 | +import qualified GitHub.Endpoints.Issues as GitHub |
| 10 | +import qualified GitHub.Request as GitHub |
| 11 | + |
| 12 | +import System.Environment (lookupEnv) |
| 13 | +import qualified System.Exit as Exit (die) |
| 14 | + |
| 15 | +self :: String |
| 16 | +self = "github-create-issue" |
| 17 | + |
| 18 | +main :: IO () |
6 | 19 | main = do |
7 | | - let auth = Github.BasicAuth "user" "password" |
8 | | - newiss = (Github.newIssue "A new issue") { |
9 | | - Github.newIssueBody = Just "Issue description text goes here" |
| 20 | + token <- lookupEnv "GITHUB_TOKEN" >>= \case |
| 21 | + Nothing -> die "variable GITHUB_TOKEN not set" |
| 22 | + Just token -> return $ fromString token |
| 23 | + |
| 24 | + let auth = GitHub.OAuth token |
| 25 | + newiss = (GitHub.newIssue "A new issue") |
| 26 | + { GitHub.newIssueBody = Just "Issue description text goes here" |
| 27 | + , GitHub.newIssueLabels = Just $ Vector.fromList ["foo", "bar", "baz"] |
10 | 28 | } |
11 | | - possibleIssue <- Github.createIssue auth "thoughtbot" "paperclip" newiss |
12 | | - putStrLn $ either (\e -> "Error: " ++ show e) |
13 | | - formatIssue |
14 | | - possibleIssue |
15 | | - |
16 | | -formatIssue issue = |
17 | | - (Github.githubOwnerLogin $ Github.issueUser issue) ++ |
18 | | - " opened this issue " ++ |
19 | | - (show $ Github.fromDate $ Github.issueCreatedAt issue) ++ "\n" ++ |
20 | | - (Github.issueState issue) ++ " with " ++ |
21 | | - (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ |
22 | | - (Github.issueTitle issue) |
| 29 | + request = GitHub.createIssueR "haskell-github" "playground" newiss |
| 30 | + |
| 31 | + GitHub.github auth request >>= \case |
| 32 | + Left err -> die $ show err |
| 33 | + Right issue -> putStrLn $ formatIssue issue |
| 34 | + |
| 35 | +die :: String -> IO a |
| 36 | +die msg = Exit.die $ concat [ self, ": Error: ", msg ] |
| 37 | + |
| 38 | +formatIssue :: GitHub.Issue -> String |
| 39 | +formatIssue issue = concat |
| 40 | + [ formatUser issue |
| 41 | + , " opened this issue " |
| 42 | + , show $ GitHub.issueCreatedAt issue |
| 43 | + , "\n" |
| 44 | + , show $ GitHub.issueState issue |
| 45 | + , " with " |
| 46 | + , show $ GitHub.issueComments issue |
| 47 | + , " comments\n\n" |
| 48 | + , Text.unpack $ GitHub.issueTitle issue |
| 49 | + ] |
| 50 | + |
| 51 | +formatUser :: GitHub.Issue -> String |
| 52 | +formatUser issue = |
| 53 | + Text.unpack . GitHub.untagName . GitHub.simpleUserLogin $ GitHub.issueUser issue |
0 commit comments