44 lines
		
	
	
		
			1.4 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			44 lines
		
	
	
		
			1.4 KiB
		
	
	
	
		
			Factor
		
	
	
! Copyright (C) 2017 Doug Coleman.
 | 
						|
! See http://factorcode.org/license.txt for BSD license.
 | 
						|
USING: arrays concurrency.combinators concurrency.semaphores fry
 | 
						|
io io.directories io.encodings.utf8 io.files.info io.launcher
 | 
						|
io.pathnames kernel math namespaces sequences splitting
 | 
						|
system-info unicode ;
 | 
						|
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-repository? ( directory -- ? )
 | 
						|
    ".git" append-path current-directory get prepend-path
 | 
						|
    ?file-info dup [ directory? ] when ;
 | 
						|
 | 
						|
: git-current-branch ( directory -- name )
 | 
						|
    [
 | 
						|
        { "git" "rev-parse" "--abbrev-ref" "HEAD" }
 | 
						|
        utf8 <process-reader> stream-contents
 | 
						|
    ] with-directory [ blank? ] trim-tail ;
 | 
						|
 | 
						|
: repository-url>name ( string -- string' )
 | 
						|
    file-name ".git" ?tail drop ;
 | 
						|
 | 
						|
: update-repository ( url -- process )
 | 
						|
    dup repository-url>name git-repository?
 | 
						|
    [ repository-url>name git-pull ] [ git-clone ] if ;
 | 
						|
 | 
						|
: sync-repositories ( directory urls -- )
 | 
						|
    '[
 | 
						|
        _ cli-git-num-parallel get <semaphore> '[
 | 
						|
            _ [ update-repository ] with-semaphore
 | 
						|
        ] parallel-each
 | 
						|
    ] with-ensure-directory ;
 |