github utility for listing issues / repos

github-util.hs

-- github util
--
-- Expect a file called ~/.github-cred with your oauth string in first line.
-- Otherwise all commands are run without credentials
module Main where

import Control.Applicative
import Control.Exception
import Control.Monad
import Data.List
import System.Environment
import System.Directory
import System.FilePath
import Github.Issues
import Github.Repos
import Github.Repos.Starring
import Github.Auth
import Text.Printf

import Data.Time.Clock.POSIX
import Data.Hourglass

import System.Console.ANSI

type Cred = GithubAuth

printUTC utc = timePrint "YYYY-MM-DD H:MI" t
  where
    t = Elapsed $ Seconds $ floor $ utcTimeToPOSIXSeconds utc

setColor c = setSGR [SetColor Foreground Vivid c]

handleError :: String -> [String] -> Either Error a -> IO a
handleError action args (Left err) =
    error (action ++ ": " ++ intercalate " : " args ++ " : " ++ show err)
handleError action args (Right a) = return a

listRepoIssues :: Maybe Cred -> String -> String -> IO ()
listRepoIssues cred owner repo = do
    issues <- handleError "listing issues" [owner,repo] =<< issuesForRepo' cred owner repo [Open]
    mapM_ display issues
  where display i =
            printf "#%d: %s [%s]\n" (issueNumber i) (issueTitle i)
                (intercalate ", " $ map labelName $ issueLabels i)

listIssues :: Maybe Cred -> String -> IO ()
listIssues cred owner = do
    repos <- handleError "listing repos" [owner] =<< userRepos' cred owner All
    mapM_ display repos
  where display r
            | nbIssues == 0 = return ()
            | otherwise     = do
                issues <- handleError "listing issue" [owner, repoName r] =<< issuesForRepo' cred owner (repoName r) [Open]
                printf "[ %.30s ] %d issues\n" (repoName r) nbIssues
                forM_ issues $ \issue -> do
                    setColor Red >> putStr (printf "#%.3d" (issueNumber issue))
                    putStr " "
                    setColor Blue >> putStr (printUTC $ fromGithubDate $ issueCreatedAt issue) >> setSGR []
                    putStr " "
                    setColor Yellow >> putStr (printf "%12s" (take 12 $ githubOwnerLogin $ issueUser issue)) >> setSGR []
                    putStr " : "
                    putStrLn (issueTitle issue)
          where
            nbIssues = maybe 0 id $ repoOpenIssues r

listRepos :: Maybe Cred -> String -> IO ()
listRepos cred owner = do
    repos <- handleError "listing repos" [owner] =<< userRepos' cred owner All
    mapM_ display repos
  where display r =
            printf "%s [%d ★ ,%d ⚠ ]\n"
                   (repoName r)  (maybe 0 id $ repoWatchers r) (maybe 0 id $ repoOpenIssues r)

listStarred :: Maybe Cred -> String -> IO ()
listStarred cred user = do
    starred <- handleError "starred repos" [user] =<< reposStarredBy cred user
    mapM_ display starred
  where display r =
            let own  = repoOwner r
                url  = maybe (error "no clone url") id $ repoCloneUrl r
                name = repoName r
             in printf "%s %s %s\n" (ownerToLogin own) name url
        ownerToLogin u = githubOwnerLogin u

main = do
    cred <- either (constException Nothing) Just <$> try readAuth
 
    args <- getArgs
    case args of
        "starred":owner:[]          -> listStarred cred owner
        "list":owner:[]             -> listRepos cred owner
        "issues":owner:[]           -> listIssues cred owner
        "repo-issues":owner:repo:[] -> listRepoIssues cred owner repo
        _                           -> usage
  where
    usage = error $ intercalate "\n"
        ["usage: gh <cmd> [options]"
        ,""
        ,"  starred <owner>"
        ,"  list    <owner>"
        ,"  issues  <owner>"
        ,"  repo-issues <owner> <repo>"
        ,""
        ]
    constException :: a -> SomeException -> a
    constException a _ = a

    toAuth = GithubOAuth . head 
    readAuth = do
        home <- getHomeDirectory
        let dotFile = home </> ".github-cred"
        toAuth . lines <$> readFile dotFile