extra/ci/docker/docker.factor

   1 ! Copyright (C) 2018 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: io.launcher io.standard-paths json.reader
   4 kernel literals namespaces sequences strings system ;
   5 IN: ci.docker
   6
   7 SYMBOL: docker-username
   8 SYMBOL: docker-password
   9
  10 : docker-path ( -- path )
  11     "docker" find-in-standard-login-path ;
  12
  13 : docker-machine-path ( -- path )
  14     "docker-machine" find-in-standard-login-path ;
  15
  16 : vboxmanage-path ( -- path )
  17     "VBoxManage" find-in-standard-login-path ;
  18
  19 : sudo-linux ( seq -- seq' )
  20     os linux? [ "sudo" prefix ] when ;
  21
  22 : docker-lines ( seq -- lines )
  23     docker-path prefix sudo-linux process-lines ;
  24
  25 : docker-machine-lines ( seq -- lines )
  26     docker-machine-path prefix process-lines ;
  27
  28
  29 : docker-command ( seq -- )
  30     docker-path prefix sudo-linux try-output-process ;
  31
  32 : docker-machine-command ( seq -- )
  33     docker-machine-path prefix try-output-process ;
  34
  35
  36 : docker-version ( -- string )
  37     { "version" } docker-lines ;
  38
  39 : docker-machine-version ( -- string )
  40     { "version" } docker-machine-lines ?first ;
  41
  42
  43
  44 : docker-machine-inspect ( string -- json )
  45     { "inspect" } swap suffix docker-machine-lines "" join json> ;
  46
  47
  48 : docker-machines ( -- seq )
  49     { "ls" "-q" } docker-machine-lines ;
  50
  51 : docker-machine-status ( string -- status )
  52     { "status" } swap suffix docker-machine-lines ;
  53
  54
  55 : docker-image-names ( -- seq )
  56     { "image" "ls" "-q" } docker-lines ;
  57
  58 : docker-image-ls ( -- seq )
  59     { "image" "ls" } docker-lines ;
  60
  61 : docker-login ( -- )
  62     ${
  63         "sudo"
  64         docker-path "login"
  65         "-p" docker-password get-global
  66         "-u" docker-username get-global
  67     } run-process drop ;
  68
  69 GENERIC: docker-pull ( obj -- )
  70
  71 M: string docker-pull ( string -- )
  72     { "pull" } swap suffix docker-command ;
  73
  74 M: sequence docker-pull ( seq -- )
  75     [ docker-pull ] each ;
  76
  77 : docker-hello-world ( -- )
  78     { "run" "hello-world" } docker-command ;