aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/aedifex/command/deploy.lux
blob: 3041c53f190ae21f435e970bab51ab9e4c867617 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
(.module:
  [lux #*
   [abstract
    [monad (#+ do)]]
   [control
    ["." exception (#+ exception:)]
    [concurrency
     ["." promise ("#@." monad)]]]
   [data
    [binary (#+ Binary)]
    [text
     ["%" format (#+ format)]
     ["." encoding]]
    [collection
     ["." dictionary (#+ Dictionary)]
     ["." set]]
    [format
     ["." binary]
     ["." tar]
     ["." xml]]]
   [world
    ["." file]]]
  [program
   [compositor
    ["." export]]]
  ["." /// #_
   ["/" profile (#+ Profile)]
   ["//" upload (#+ User Password)]
   ["#." action (#+ Action)]
   ["#." command (#+ Command)]
   ["#." pom]
   ["#." hash]
   ["#." artifact
    ["#/." type]]
   ["#." dependency
    ["#/." resolution]]])

(exception: #export (cannot-find-repository {repository Text}
                                            {options (Dictionary Text ///dependency.Repository)})
  (exception.report
   ["Repository" (%.text repository)]
   ["Options" (exception.enumerate (function (_ [name repo])
                                     (format (%.text name) " := " (%.text repo)))
                                   (dictionary.entries options))]))

(def: #export (do! repository user password profile)
  (-> Text User Password (Command Any))
  (case [(get@ #/.identity profile)
         (dictionary.get repository (get@ #/.deploy-repositories profile))]
    [#.None _]
    (promise@wrap (exception.throw /.no-identity []))

    [_ #.None]
    (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)]))

    [(#.Some identity) (#.Some repository)]
    (let [deploy! (: (-> ///artifact/type.Type Binary (Action Any))
                     (function (_ type content)
                       (promise.future
                        (//.upload repository
                                   user
                                   password
                                   {#///dependency.artifact identity
                                    #///dependency.type type}
                                   content))))]
      (do {! ///action.monad}
        [library (:: ! map (binary.run tar.writer)
                     (export.library (file.async file.default)
                                     (set.to-list (get@ #/.sources profile))))
         pom (promise@wrap (///pom.write profile))
         _ (deploy! ///artifact/type.pom (|> pom (:: xml.codec encode) encoding.to-utf8))
         _ (deploy! ///artifact/type.lux-library library)
         _ (deploy! ///artifact/type.sha-1 (///hash.data (///hash.sha-1 library)))
         _ (deploy! ///artifact/type.md5 (///hash.data (///hash.md5 library)))]
        (wrap [])))))