infer-upstream 0.1.0.0 → 0.1.1.0
raw patch · 4 files changed
+88/−24 lines, 4 filesdep +ansi-wl-pprintdep +parsecdep +processdep ~githubdep ~optparse-applicative
Dependencies added: ansi-wl-pprint, parsec, process
Dependency ranges changed: github, optparse-applicative
Files
- README.md +2/−2
- infer-upstream.cabal +7/−3
- infer-upstream.hs +77/−17
- upstream_everything.sh +2/−2
README.md view
@@ -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
infer-upstream.cabal view
@@ -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+
infer-upstream.hs view
@@ -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
upstream_everything.sh view
@@ -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##*/}"