extra/cli/git/git.factor

   1 ! Copyright (C) 2017 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays concurrency.combinators concurrency.semaphores fry
   4 io io.directories io.encodings.utf8 io.files.info io.launcher
   5 io.pathnames kernel math namespaces sequences splitting
   6 system-info unicode ;
   7 IN: cli.git
   8
   9 SYMBOL: cli-git-num-parallel
  10 cli-git-num-parallel [ cpus 2 * ] initialize
  11
  12 : git-clone-as ( uri path -- process ) [ { "git" "clone" } ] 2dip 2array append run-process ;
  13 : git-clone ( uri -- process ) [ { "git" "clone" } ] dip suffix run-process ;
  14 : git-pull* ( -- process ) { "git" "pull" } run-process ;
  15 : git-pull ( path -- process ) [ git-pull* ] with-directory ;
  16 : git-fetch-all* ( -- process ) { "git" "fetch" "--all" } run-process ;
  17 : git-fetch-all ( path -- process ) [ git-fetch-all* ] with-directory ;
  18 : git-fetch-tags* ( -- process ) { "git" "fetch" "--tags" } run-process ;
  19 : git-fetch-tags ( path -- process ) [ git-fetch-tags* ] with-directory ;
  20 : git-checkout-new-branch* ( branch -- process ) [ { "git" "checkout" "-b" } ] dip suffix run-process ;
  21 : git-checkout-new-branch ( path branch -- process ) '[ _ git-checkout-new-branch* ] with-directory ;
  22 : git-checkout-existing-branch* ( branch -- process ) [ { "git" "checkout" } ] dip suffix run-process ;
  23 : git-checkout-existing-branch ( path branch -- process ) '[ _ git-checkout-existing-branch* ] with-directory ;
  24 : git-change-remote* ( remote uri -- process ) [ { "git" "remote" "set-url" } ] 2dip 2array append run-process ;
  25 : git-change-remote ( path remote uri -- process ) '[ _ _ git-change-remote* ] with-directory ;
  26 : git-remote-add* ( remote uri -- process ) [ { "git" "remote" "add" } ] 2dip 2array append run-process ;
  27 : git-remote-add ( path remote uri -- process ) '[ _ _ git-remote-add* ] with-directory ;
  28 : git-remote-get-url* ( remote -- process ) [ { "git" "remote" "get-url" } ] dip suffix run-process ;
  29 : git-remote-get-url ( path remote -- process ) '[ _ git-remote-get-url* ] with-directory ;
  30
  31 : git-repository? ( directory -- ? )
  32     ".git" append-path current-directory get prepend-path
  33     ?file-info dup [ directory? ] when ;
  34
  35 : git-current-branch* ( -- name )
  36      ! { "git" "rev-parse" "--abbrev-ref" "HEAD" }
  37      { "git" "name-rev" "--name-only" "HEAD" }
  38      utf8 <process-reader> stream-contents
  39      [ blank? ] trim-tail ;
  40
  41 : git-current-branch ( directory -- name )
  42     [ git-current-branch* ] with-directory ;
  43
  44 : repository-url>name ( string -- string' )
  45     file-name ".git" ?tail drop ;
  46
  47 : update-repository ( url -- process )
  48     dup repository-url>name git-repository?
  49     [ repository-url>name git-pull ] [ git-clone ] if ;
  50
  51 : sync-repositories ( directory urls -- )
  52     '[
  53         _ cli-git-num-parallel get <semaphore> '[
  54             _ [ update-repository ] with-semaphore
  55         ] parallel-each
  56     ] with-ensure-directory ;