steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

cli.git, web-services.github: Better api.

modern-harvey2
Doug Coleman 2017-09-14 23:10:34 -05:00
parent 6dc30e953e
commit 994485a90c
2 changed files with 33 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
extra/cli/git/git.factor
View File

@ -9,24 +9,36 @@ IN: cli.git
SYMBOL: cli-git-num-parallel SYMBOL: cli-git-num-parallel
cli-git-num-parallel [ cpus 2 * ] initialize cli-git-num-parallel [ cpus 2 * ] initialize
: git-clone-as ( ssh-url path -- process ) : git-clone-as ( uri path -- process ) [ { "git" "clone" } ] 2dip 2array append run-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-clone ( ssh-url -- process ) : git-pull ( path -- process ) [ git-pull* ] with-directory ;
[ { "git" "clone" } ] dip suffix run-process ; : git-fetch-all* ( -- process ) { "git" "fetch" "--all" } run-process ;
: git-fetch-all ( path -- process ) [ git-fetch-all* ] with-directory ;
: git-pull ( path -- process ) : git-fetch-tags* ( -- process ) { "git" "fetch" "--tags" } run-process ;
[ { "git" "pull" } run-process ] with-directory ; : 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-repository? ( directory -- ? )
".git" append-path current-directory get prepend-path ".git" append-path current-directory get prepend-path
?file-info dup [ directory? ] when ; ?file-info dup [ directory? ] when ;
: git-current-branch ( directory -- name ) : git-current-branch* ( -- name )
[
{ "git" "rev-parse" "--abbrev-ref" "HEAD" } { "git" "rev-parse" "--abbrev-ref" "HEAD" }
utf8 <process-reader> stream-contents utf8 <process-reader> stream-contents
] with-directory [ blank? ] trim-tail ; [ blank? ] trim-tail ;
: git-current-branch ( directory -- name )
[ git-current-branch* ] with-directory ;
: repository-url>name ( string -- string' ) : repository-url>name ( string -- string' )
file-name ".git" ?tail drop ; file-name ".git" ?tail drop ;

11
extra/web-services/github/github.factor
View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: assocs cli.git concurrency.combinators USING: assocs cli.git concurrency.combinators
concurrency.semaphores formatting fry http.client io concurrency.semaphores formatting fry http.client io
io.directories json.reader kernel locals math namespaces io.directories io.pathnames json.reader kernel locals math
sequences ; namespaces sequences ;
IN: web-services.github IN: web-services.github
SYMBOL: github-username SYMBOL: github-username
@ -30,3 +30,10 @@ SYMBOL: github-token
github-username get github-username get
github-token get github-token get
sync-organization-with-credentials ; 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 ;