extra/web-services/github/github.factor

   1 ! Copyright (C) 2017 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs cli.git formatting http.client io.pathnames
   4 json.reader kernel locals math namespaces sequences ;
   5 IN: web-services.github
   6
   7 SYMBOL: github-username
   8 SYMBOL: github-token
   9
  10 ! type is orgs, users
  11 :: get-repositories-with-credentials ( type name username token -- seq )
  12     0 [ dup ] [
  13         1 + dup
  14         [ username token type name ] dip
  15         "https://%s:%s@api.github.com/%s/%s/repos?per_page=100&page=%d" sprintf http-get nip json>
  16         dup empty? [ 2drop f f ] [ ] if
  17     ] produce nip concat ;
  18
  19 : get-repositories ( type name -- seq )
  20     github-username get
  21     github-token get
  22     get-repositories-with-credentials ;
  23
  24 : sync-github-org-or-user ( directory type name -- )
  25     get-repositories
  26     [ "ssh_url" of ] map sync-repositories ;
  27
  28 : sync-github-org ( directory name -- ) "orgs" swap sync-github-org-or-user ;
  29 : sync-github-user ( directory name -- ) "users" swap sync-github-org-or-user ;
  30
  31 : github-git-uri ( user/org project -- uri ) [ "git@github.com" ] 2dip "/" glue ":" glue ;
  32 : github-ssh-uri ( user/org project -- uri ) [ "https://github.com" ] 2dip 3append-path ;
  33 : github-git-clone-as ( user/org project name -- process ) [ github-git-uri ] dip git-clone-as ;
  34 : github-ssh-clone-as ( user/org project name -- process ) [ github-ssh-uri ] dip git-clone-as ;
  35 : github-git-clone ( user/org project -- process ) dup github-git-clone-as ;
  36 : github-ssh-clone ( user/org project -- process ) dup github-ssh-clone-as ;
  37