diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -14,8 +14,8 @@ Another usage: ```` -cd scirate3 -git remote add upstream `infer-upstream -r scirate3 -u silky` +noon@dev> cd scirate3 +noon@dev> git remote add upstream `infer-upstream --using-cwd` ```` A more interesting usage (and the reason I wrote this) is to use the diff --git a/infer-upstream.cabal b/infer-upstream.cabal --- a/infer-upstream.cabal +++ b/infer-upstream.cabal @@ -1,5 +1,5 @@ name: infer-upstream -version: 0.1.0.0 +version: 0.1.1.0 synopsis: Find the repository from where a given repo was forked description: Find the repository from where a given repo was forked homepage: https://github.com/silky/infer-upstream @@ -17,5 +17,9 @@ build-depends: base >= 4.0 && < 5.0, text >= 0.10 && < 0.12, - optparse-applicative >= 0.5 && < 0.6, - github >= 0.8 + optparse-applicative >= 0.5, + github >= 0.8 && < 0.9, + process >= 1.1 && < 1.3, + parsec >= 3.0 && < 3.2, + ansi-wl-pprint >= 0.5 && < 0.7 + diff --git a/infer-upstream.hs b/infer-upstream.hs --- a/infer-upstream.hs +++ b/infer-upstream.hs @@ -4,48 +4,88 @@ import Prelude import System.Exit (exitFailure, exitSuccess) -import Control.Applicative ((<$>), (<*>)) +import Control.Applicative ((<$>), (<*>),optional,pure) import Data.Monoid (mempty, (<>)) import Data.Maybe (fromMaybe) import Github.Data (Repo(..), GithubOwner(..), RepoRef(..)) import Github.Repos (userRepo) +import System.IO (hGetContents) +import System.Process (createProcess,StdStream(CreatePipe),proc,std_out) +import qualified Text.ParserCombinators.Parsec as P +import Data.Char (isSpace) +import System.Environment (getArgs, getProgName) + import qualified Options.Applicative.Builder.Internal as X import qualified Options.Applicative as O +import qualified Options.Applicative.Help.Core as C +import qualified Options.Applicative.Help.Chunk as Ch -data Options = Options { repo :: String - , user :: String +import qualified Text.PrettyPrint.ANSI.Leijen as L + +data Repository = Repository { + repositoryName :: String + , userName :: String + } deriving Show + +data Options = Options { repo :: Maybe Repository + , usingCwd :: Bool } deriving Show main :: IO () -main = O.execParser (O.info (O.helper <*> options) mempty) >>= start +main = O.execParser (O.info (O.helper <*> choices) mempty) >>= start +choices :: O.Parser Options +choices = Options + <$> optional repository + <*> O.switch ( O.long "using-cwd" <> + O.help "Use git and current directory to obtain upstream." ) -options :: O.Parser Options -options = Options +repository :: O.Parser Repository +repository = Repository <$> 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 +defaultPrefs = O.prefs mempty +usageHelp programName = + let i = (O.info (O.helper <*> choices) mempty) + str = (`L.displayS` "") + $ L.renderPretty 1.0 (O.prefColumns defaultPrefs) + $ C.helpText + $ C.usageHelp $ Ch.vcatChunks + [ pure . C.parserUsage defaultPrefs (O.infoParser i) . unwords $ programName : [] + , fmap (L.indent 2) . O.infoProgDesc $ i ] + in putStrLn str + start :: Options -> IO () start opts = do - d <- userRepo (user opts) (repo opts) - case d of - Right repo -> inferUpstream repo opts - Left err -> do + r <- + case repo opts of + Nothing -> case usingCwd opts of + True -> obtainOriginFromCurrentDirectory >>= \res -> + case res of + (Just (repo,user)) -> return (Just (Repository repo user)) + _ -> putStrLn "Could not find git origin remote for current directory." >> return Nothing + False -> getProgName >>= usageHelp >> return Nothing + _ -> return (repo opts) + case r of + Just (Repository repo user) -> do + d <- userRepo user repo + case d of + Right repo -> inferUpstream repo + Left err -> do putStrLn $ show err exitFailure - + _ -> exitFailure obtainUpstreamRepo :: RepoRef -> IO () obtainUpstreamRepo (RepoRef ghUser repoName) = do @@ -53,13 +93,33 @@ case rd of -- Print put the ssh repo url Right repo -> putStrLn (repoSshUrl repo) - Left err -> do + Left err -> do putStrLn $ show err exitFailure - -inferUpstream :: Repo -> Options -> IO () -inferUpstream repo opts = do +inferUpstream :: Repo -> IO () +inferUpstream repo = do case (repoParent repo) of Just repoParent -> obtainUpstreamRepo repoParent Nothing -> exitSuccess -- No upstream, say nothing. + +originParser = do + sequence (map P.char "origin") + P.many1 P.space + sequence (map P.char "https://github.com/") P.<|> sequence (map P.char "git@github.com:") + user <- P.many1 (P.satisfy ( \x -> not (isSpace x || x=='/' || x == '.'))) + P.char '/' + repo <- P.many1 (P.satisfy ( \x -> not (isSpace x || x=='/' || x == '.'))) + return (repo,user) + +obtainOriginFromCurrentDirectory = do + (_, Just hout, _, _) <- + createProcess (proc "git" ["remote","-v"]){ std_out = CreatePipe } + originInfo <- hGetContents hout >>= return . lines >>= return . take 1 . filter isRight . map (P.parse originParser "") + return (case originInfo of + [Right x] -> Just x + _ -> Nothing) + +isRight r = case r of + (Right _) -> True + _ -> False diff --git a/upstream_everything.sh b/upstream_everything.sh --- a/upstream_everything.sh +++ b/upstream_everything.sh @@ -7,9 +7,9 @@ if git remote | grep 'upstream' > /dev/null; then echo "'upstream' remote already exists in ${PWD##*/}" else - UPSTREAM=`infer-upstream -r "${PWD##*/}" -u silky` + UPSTREAM=`infer-upstream --using-cwd` if [ $? -eq 0 ]; then - git remote add upstream `infer-upstream -r "${PWD##*/}" -u silky` + git remote add upstream ${UPSTREAM} echo "created 'upstream' remote in ${PWD##*/} pointing at ${UPSTREAM}" else echo "can't determine upstream for ${PWD##*/}"