module Hit.Issue
( runIssue
, mkIssueId
, getIssueTitle
, getOwnerRepo
, parseOwnerRepo
) where
import Data.Vector (Vector)
import GitHub (Error (..), Id, Issue (..), IssueLabel (..), IssueState (..), Name, Owner, Repo,
SimpleUser (..), User, getUrl, mkId, mkName, untagName)
import GitHub.Auth (Auth (OAuth))
import GitHub.Data.Options (stateOpen)
import GitHub.Endpoints.Issues (issue', issuesForRepo')
import Shellmet (($|))
import System.Environment (lookupEnv)
import Hit.ColorTerminal (arrow, blueBg, blueCode, boldCode, errorMessage, greenCode, redCode,
resetCode)
import qualified Data.Text as T
import qualified Data.Vector as V
runIssue :: Maybe Int -> Maybe Text -> IO ()
runIssue issue me = case issue of
Just num -> getIssue $ mkIssueId num
Nothing -> getAllIssues me
getAllIssues :: Maybe Text -> IO ()
getAllIssues me = withOwnerRepo (\t o r -> issuesForRepo' t o r stateOpen) >>= \case
Left err -> errorMessage $ show err
Right is -> for_ (my is) (putTextLn . showIssueName blueCode)
where
my :: Vector Issue -> Vector Issue
my issues = case me of
Just (makeName -> username) -> V.filter (assignedTo username . issueAssignees) issues
Nothing -> issues
assignedTo :: Name User -> Vector SimpleUser -> Bool
assignedTo user = isJust . V.find ((user ==) . simpleUserLogin)
getIssue :: Id Issue -> IO ()
getIssue num = fetchIssue num >>= \case
Left err -> errorMessage $ show err
Right is -> putTextLn $ showIssueFull is
showIssueName :: Text -> Issue -> Text
showIssueName colorCode Issue{..} =
arrow <> colorCode <> " [#" <> show @Text issueNumber <> "] " <> resetCode <> issueTitle
showIssueFull :: Issue -> Text
showIssueFull i@Issue{..} = T.intercalate "\n" $
showIssueName (statusToCode issueState) i
: [ highlight " Assignees: " <> assignees | not $ null issueAssignees]
++ [ highlight " Labels: " <> labels | not $ null issueLabels]
++ [ highlight " URL: " <> getUrl url | Just url <- [issueHtmlUrl]]
++ [ indentDesc desc | Just (T.strip -> desc) <- [issueBody], desc /= ""]
where
statusToCode :: IssueState -> Text
statusToCode = \case
StateOpen -> blueCode
StateClosed -> redCode
indentDesc :: Text -> Text
indentDesc = unlines
. map (" " <> )
. (highlight "Description:" :)
. lines
assignees :: Text
assignees = T.intercalate ", "
$ map (untagName . simpleUserLogin)
$ toList issueAssignees
labels :: Text
labels = T.intercalate " "
$ map (putLabel . untagName . labelName)
$ toList issueLabels
putLabel :: Text -> Text
putLabel x = blueBg <> x <> resetCode
highlight :: Text -> Text
highlight x = boldCode <> greenCode <> x <> resetCode
mkIssueId :: Int -> Id Issue
mkIssueId = mkId $ Proxy @Issue
makeName :: forall a . Text -> Name a
makeName = mkName (Proxy @a)
fetchIssue :: Id Issue -> IO (Either Error Issue)
fetchIssue iNum = withOwnerRepo (\t o r -> issue' t o r iNum)
getIssueTitle :: Id Issue -> IO Text
getIssueTitle num = fetchIssue num >>= \case
Left err -> errorMessage (show err) >> exitFailure
Right Issue{..} -> pure issueTitle
withOwnerRepo
:: (Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error a))
-> IO (Either Error a)
withOwnerRepo action = getOwnerRepo >>= \case
Just (owner, repo) -> do
token <- lookupEnv "GITHUB_TOKEN"
let gitHubToken = OAuth . encodeUtf8 <$> token
action gitHubToken owner repo
Nothing -> do
let errTxt = "Can not get the owner/repo names"
errorMessage errTxt
pure $ Left $ ParseError errTxt
getOwnerRepo :: IO (Maybe (Name Owner, Name Repo))
getOwnerRepo = parseOwnerRepo <$> "git" $| ["remote", "get-url", "origin"]
parseOwnerRepo :: Text -> Maybe (Name Owner, Name Repo)
parseOwnerRepo url =
( T.stripPrefix "git@github.com:" url
<|> T.stripPrefix "https://github.com/" url
) >>= stripGitSuffix >>= separateName
where
separateName :: Text -> Maybe (Name Owner, Name Repo)
separateName nm =
let (owner, T.drop 1 -> repo) = T.breakOn "/" nm in
guard (owner /= "" && repo /= "") *> Just (makeName owner, makeName repo)
stripGitSuffix :: Text -> Maybe Text
stripGitSuffix x = whenNothing (T.stripSuffix ".git" x) (Just x)