From 994485a90c25aae1a349aa5307d106bb985fc6eb Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 14 Sep 2017 23:10:34 -0500 Subject: [PATCH] cli.git, web-services.github: Better api. --- extra/cli/git/git.factor | 36 ++++++++++++++++--------- extra/web-services/github/github.factor | 11 ++++++-- 2 files changed, 33 insertions(+), 14 deletions(-) diff --git a/extra/cli/git/git.factor b/extra/cli/git/git.factor index ce9bbcc7b0..0c24298bcd 100644 --- a/extra/cli/git/git.factor +++ b/extra/cli/git/git.factor @@ -9,24 +9,36 @@ IN: cli.git SYMBOL: cli-git-num-parallel cli-git-num-parallel [ cpus 2 * ] initialize -: git-clone-as ( ssh-url path -- process ) - [ { "git" "clone" } ] 2dip 2array append run-process ; - -: git-clone ( ssh-url -- process ) - [ { "git" "clone" } ] dip suffix run-process ; - -: git-pull ( path -- process ) - [ { "git" "pull" } run-process ] with-directory ; +: git-clone-as ( uri path -- process ) [ { "git" "clone" } ] 2dip 2array append run-process ; +: git-clone ( uri -- process ) [ { "git" "clone" } ] dip suffix run-process ; +: git-pull* ( -- process ) { "git" "pull" } run-process ; +: git-pull ( path -- process ) [ git-pull* ] with-directory ; +: git-fetch-all* ( -- process ) { "git" "fetch" "--all" } run-process ; +: git-fetch-all ( path -- process ) [ git-fetch-all* ] with-directory ; +: git-fetch-tags* ( -- process ) { "git" "fetch" "--tags" } run-process ; +: git-fetch-tags ( path -- process ) [ git-fetch-tags* ] with-directory ; +: git-checkout-new-branch* ( branch -- process ) [ { "git" "checkout" "-b" } ] dip suffix run-process ; +: git-checkout-new-branch ( path branch -- process ) '[ _ git-checkout-new-branch* ] with-directory ; +: git-checkout-existing-branch* ( branch -- process ) [ { "git" "checkout" } ] dip suffix run-process ; +: git-checkout-existing-branch ( path branch -- process ) '[ _ git-checkout-existing-branch* ] with-directory ; +: git-change-remote* ( remote uri -- process ) [ { "git" "remote" "set-url" } ] 2dip 2array append run-process ; +: git-change-remote ( path remote uri -- process ) '[ _ _ git-change-remote* ] with-directory ; +: git-remote-add* ( remote uri -- process ) [ { "git" "remote" "add" } ] 2dip 2array append run-process ; +: git-remote-add ( path remote uri -- process ) '[ _ _ git-remote-add* ] with-directory ; +: git-remote-get-url* ( remote -- process ) [ { "git" "remote" "get-url" } ] dip suffix run-process ; +: git-remote-get-url ( path remote -- process ) '[ _ git-remote-get-url* ] with-directory ; : git-repository? ( directory -- ? ) ".git" append-path current-directory get prepend-path ?file-info dup [ directory? ] when ; +: git-current-branch* ( -- name ) + { "git" "rev-parse" "--abbrev-ref" "HEAD" } + utf8 stream-contents + [ blank? ] trim-tail ; + : git-current-branch ( directory -- name ) - [ - { "git" "rev-parse" "--abbrev-ref" "HEAD" } - utf8 stream-contents - ] with-directory [ blank? ] trim-tail ; + [ git-current-branch* ] with-directory ; : repository-url>name ( string -- string' ) file-name ".git" ?tail drop ; diff --git a/extra/web-services/github/github.factor b/extra/web-services/github/github.factor index 21d9280eee..2bb14e77a3 100644 --- a/extra/web-services/github/github.factor +++ b/extra/web-services/github/github.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: assocs cli.git concurrency.combinators concurrency.semaphores formatting fry http.client io -io.directories json.reader kernel locals math namespaces -sequences ; +io.directories io.pathnames json.reader kernel locals math +namespaces sequences ; IN: web-services.github SYMBOL: github-username @@ -30,3 +30,10 @@ SYMBOL: github-token github-username get github-token get sync-organization-with-credentials ; + +: github-git-uri ( user project -- uri ) [ "git@github.com" ] 2dip "/" glue ":" glue ; +: github-ssh-uri ( user project -- uri ) [ "https://github.com" ] 2dip 3append-path ; +: github-git-clone-as ( user project name -- process ) [ github-git-uri ] dip git-clone-as ; +: github-ssh-clone-as ( user project name -- process ) [ github-ssh-uri ] dip git-clone-as ; +: github-git-clone ( user project -- process ) dup github-git-clone-as ; +: github-ssh-clone ( user project -- process ) dup github-ssh-clone-as ;