infer-upstream-0.1.0.0: infer-upstream.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Prelude
import System.Exit               (exitFailure, exitSuccess)
import Control.Applicative       ((<$>), (<*>))
import Data.Monoid               (mempty, (<>))
import Data.Maybe                (fromMaybe)
import Github.Data               (Repo(..), GithubOwner(..), RepoRef(..))
import Github.Repos              (userRepo)

import qualified Options.Applicative.Builder.Internal as X
import qualified Options.Applicative                  as O

data Options = Options { repo :: String
                       , user :: String
                       } deriving Show

main :: IO ()
main = O.execParser (O.info (O.helper <*> options) mempty) >>= start


options :: O.Parser Options
options = Options
  <$> O.strOption ( O.short 'r' <> O.long "repo" <> 
          O.help "Name of the repository that we will look up." )
  <*> O.strOption ( O.short 'u' <> O.long "user" <> 
          O.help "Name of the user that we will look this repo up on." )


defStr :: String -> X.Mod X.ArgumentFields String -> O.Parser String
defStr a = def a . O.argument O.str


def :: a -> O.Parser a -> O.Parser a
def a = fmap (fromMaybe a) . O.optional


start :: Options -> IO ()
start opts = do
  d <- userRepo (user opts) (repo opts)
  case d of
    Right repo  -> inferUpstream repo opts
    Left  err   -> do 
        putStrLn $ show err
        exitFailure


obtainUpstreamRepo :: RepoRef -> IO ()
obtainUpstreamRepo (RepoRef ghUser repoName) = do
    rd <- userRepo (githubOwnerLogin ghUser) repoName
    case rd of
      -- Print put the ssh repo url
      Right repo -> putStrLn (repoSshUrl repo)
      Left  err   -> do 
        putStrLn $ show err
        exitFailure


inferUpstream :: Repo -> Options -> IO ()
inferUpstream repo opts = do
  case (repoParent repo) of
      Just repoParent     -> obtainUpstreamRepo repoParent
      Nothing             -> exitSuccess -- No upstream, say nothing.