aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/aedifex/dependency/resolution.lux
blob: f5dbb0d54ff522731781517d1d721795ed45d439 (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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
(.module:
  [lux (#- Name)
   ["." host (#+ import:)]
   [abstract
    [codec (#+ Codec)]
    [equivalence (#+ Equivalence)]
    [monad (#+ Monad do)]]
   [control
    ["." try (#+ Try)]
    ["." exception (#+ Exception exception:)]
    ["<>" parser
     ["<.>" xml (#+ Parser)]]
    [concurrency
     ["." promise (#+ Promise)]]]
   [data
    ["." binary (#+ Binary)]
    ["." name]
    ["." maybe]
    [text
     ["%" format (#+ format)]
     ["." encoding]]
    [number
     ["." i64]
     ["n" nat]]
    [format
     ["." xml (#+ Tag XML)]]
    [collection
     ["." dictionary (#+ Dictionary)]
     ["." set]]]
   [world
    [net (#+ URL)
     ["." uri]]]]
  ["." // (#+ Dependency)
   ["/#" // #_
    ["/" profile]
    ["#." repository (#+ Address Repository)]
    ["#." hash]
    ["#." pom]
    ["#." package (#+ Package)]
    ["#." artifact (#+ Artifact)
     ["#/." extension (#+ Extension)]]]])

(template [<name>]
  [(exception: #export (<name> {dependency Dependency} {hash Text})
     (exception.report
      ["Artifact" (///artifact.format (get@ #//.artifact dependency))]
      ["Type" (%.text (get@ #//.type dependency))]
      ["Hash" (%.text hash)]))]

  [sha-1-does-not-match]
  [md5-does-not-match]
  )

(def: (verified-hash dependency library repository artifact extension hash codec exception)
  (All [h]
    (-> Dependency Binary (Repository Promise) Artifact Extension
        (-> Binary (///hash.Hash h)) (Codec Text (///hash.Hash h))
        (Exception [Dependency Text])
        (Promise (Try (///hash.Hash h)))))
  (do (try.with promise.monad)
    [actual (:: repository download artifact extension)]
    (:: promise.monad wrap
        (do try.monad
          [output (encoding.from-utf8 actual)
           actual (:: codec decode output)
           _ (exception.assert exception [dependency output]
                               (:: ///hash.equivalence = (hash library) actual))]
          (wrap actual)))))

(def: #export (one repository dependency)
  (-> (Repository Promise) Dependency (Promise (Try Package)))
  (let [[artifact type] dependency
        extension (///artifact/extension.extension type)]
    (do (try.with promise.monad)
      [library (:: repository download artifact extension)
       sha-1 (..verified-hash dependency library
                              repository artifact ///artifact/extension.sha-1
                              ///hash.sha-1 ///hash.sha-1-codec ..sha-1-does-not-match)
       md5 (..verified-hash dependency library
                            repository artifact ///artifact/extension.md5
                            ///hash.md5 ///hash.md5-codec ..md5-does-not-match)
       pom (:: repository download artifact ///artifact/extension.pom)]
      (:: promise.monad wrap
          (do try.monad
            [pom (encoding.from-utf8 pom)
             pom (:: xml.codec decode pom)
             profile (<xml>.run ///pom.parser pom)]
            (wrap {#///package.origin #///package.Remote
                   #///package.library library
                   #///package.pom pom
                   #///package.sha-1 sha-1
                   #///package.md5 md5}))))))

(type: #export Resolution
  (Dictionary Dependency Package))

(def: #export empty
  Resolution
  (dictionary.new //.hash))

(def: #export equivalence
  (Equivalence Resolution)
  (dictionary.equivalence ///package.equivalence))

(exception: #export (cannot-resolve {dependency Dependency})
  (exception.report
   ["Artifact" (%.text (///artifact.format (get@ #//.artifact dependency)))]
   ["Type" (%.text (get@ #//.type dependency))]))

(def: #export (any repositories dependency)
  (-> (List (Repository Promise)) Dependency (Promise (Try Package)))
  (case repositories
    #.Nil
    (|> dependency
        (exception.throw ..cannot-resolve)
        (:: promise.monad wrap))

    (#.Cons repository alternatives)
    (do promise.monad
      [outcome (..one repository dependency)]
      (case outcome
        (#try.Success package)
        (wrap outcome)

        (#try.Failure error)
        (any alternatives dependency)))))

(def: #export (all repositories dependencies resolution)
  (-> (List (Repository Promise)) (List Dependency) Resolution (Promise (Try Resolution)))
  (case dependencies
    #.Nil
    (:: (try.with promise.monad) wrap resolution)

    (#.Cons head tail)
    (do (try.with promise.monad)
      [package (case (dictionary.get head resolution)
                 (#.Some package)
                 (wrap package)

                 #.None
                 (..any repositories head))
       sub-dependencies (:: promise.monad wrap (///package.dependencies package))
       resolution (|> resolution
                      (dictionary.put head package)
                      (all repositories (set.to-list sub-dependencies)))]
      (all repositories tail resolution))))