aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/aedifex/dependency/resolution.lux
blob: f49d1da56141493fc6d5dddcbb9aac5e4ee85c65 (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
147
148
149
150
151
(.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)
   ["#." status (#+ Status)]
   ["/#" // #_
    ["/" profile]
    ["#." repository (#+ Address Repository)]
    ["#." hash (#+ Hash SHA-1 MD5)]
    ["#." pom]
    ["#." package (#+ Package)]
    ["#." artifact (#+ Artifact)
     ["#/." extension (#+ Extension)]]]])

(template [<name>]
  [(exception: #export (<name> {artifact Artifact} {extension Extension} {hash Text})
     (exception.report
      ["Artifact" (///artifact.format artifact)]
      ["Extension" (%.text extension)]
      ["Hash" (%.text hash)]))]

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

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

(def: (hashed repository artifact extension)
  (-> (Repository Promise) Artifact Extension (Promise (Try [Binary Status])))
  (do (try.with promise.monad)
    [data (\ repository download (///repository.uri artifact extension))
     sha-1 (..verified-hash data
                            repository artifact (format extension ///artifact/extension.sha-1)
                            ///hash.sha-1 ///hash.sha-1-codec ..sha-1-does-not-match)
     md5 (..verified-hash data
                          repository artifact (format extension ///artifact/extension.md5)
                          ///hash.md5 ///hash.md5-codec ..md5-does-not-match)]
    (wrap [data (#//status.Verified sha-1 md5)])))

(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)
      [[pom pom-status] (..hashed repository artifact ///artifact/extension.pom)
       library-&-status (..hashed repository artifact extension)]
      (\ promise.monad wrap
         (do try.monad
           [pom (\ encoding.utf8 decode pom)
            pom (\ xml.codec decode pom)
            profile (<xml>.run ///pom.parser pom)]
           (wrap {#///package.origin #///package.Remote
                  #///package.library library-&-status
                  #///package.pom [pom pom-status]}))))))

(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))))