extra/zealot/zealot.factor

   1 ! Copyright (C) 2017 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: cli.git combinators io.directories io.files.info
   4 io.pathnames kernel sequences uuid web-services.github ;
   5 IN: zealot
   6
   7 : default-zealot-directory ( chunk -- path ) [ home ".zealot" ] dip 3append-path ;
   8 : default-zealot-source-directory ( -- path ) "source" default-zealot-directory ;
   9 : default-zealot-builds-directory ( -- path ) "builds" default-zealot-directory ;
  10
  11 : zealot-source-directory ( chunk -- path ) [ default-zealot-source-directory ] dip append-path ;
  12 : zealot-builds-directory ( chunk -- path ) [ default-zealot-builds-directory ] dip append-path ;
  13
  14 : with-default-zealot-source-directory ( chunk quot -- )
  15     [ default-zealot-source-directory ] dip with-ensure-directory ; inline
  16
  17 : with-default-zealot-builds-directory ( chunk quot -- )
  18     [ default-zealot-builds-directory ] dip with-ensure-directory ; inline
  19
  20 : with-zealot-source-directory ( chunk quot -- )
  21     [ zealot-source-directory ] dip with-ensure-directory ; inline
  22
  23 : with-zealot-builds-directory ( chunk quot -- )
  24     [ zealot-builds-directory ] dip with-ensure-directory ; inline
  25
  26
  27 : with-zealot-github-directory ( quot -- )
  28     [ "github" ] dip with-zealot-source-directory ; inline
  29
  30 : with-zealot-github-project-directory ( user project quot -- )
  31     [ "github" ] 3dip [ 3append-path ] dip with-zealot-source-directory ; inline
  32
  33 : zealot-github-clone ( user project -- process )
  34     '[ _ _ 2dup "/" glue github-git-clone-as ] with-zealot-github-directory ; inline
  35
  36 : zealot-github-source-path ( user project -- path )
  37     [ "github" ] 2dip 3append-path zealot-source-directory ;
  38
  39 : zealot-github-builds-path ( user project -- path )
  40     [ "github" ] 2dip 3append-path uuid1 append-path zealot-builds-directory ;
  41
  42 : zealot-github-fetch-all ( user project -- process )
  43     [ git-fetch-all* ] with-zealot-github-project-directory ;
  44
  45 : zealot-github-fetch-tags ( user project -- process )
  46     [ git-fetch-tags* ] with-zealot-github-project-directory ;
  47
  48 : zealot-github-pull ( user project -- process )
  49     [ git-pull* ] with-zealot-github-project-directory ;
  50
  51 : zealot-github-exists-locally? ( user project -- ? )
  52     zealot-github-source-path ?file-info >boolean ;
  53
  54 : zealot-github-ensure ( user project -- process )
  55     2dup zealot-github-exists-locally? [
  56         {
  57             [ zealot-github-fetch-all drop ]
  58             [ zealot-github-fetch-tags drop ]
  59             [ zealot-github-pull ]
  60         } 2cleave
  61     ] [
  62         zealot-github-clone
  63     ] if ;
  64
  65 : zealot-github-set-build-remote ( path user project -- process )
  66     '[ "origin" _ _ github-ssh-uri git-change-remote* ] with-directory ;
  67
  68 : zealot-github-add-build-remote ( path user project -- process )
  69     '[ "github" _ _ github-ssh-uri git-remote-add* ] with-directory ;
  70
  71 : zealot-github-clone-paths ( user project -- process builds-path )
  72     [ zealot-github-source-path ]
  73     [ zealot-github-builds-path ] 2bi
  74     [ git-clone-as ] keep ;
  75
  76 : zealot-build-checkout-branch ( path branch -- process )
  77     '[ _ git-checkout-existing-branch* ] with-directory ;