aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/aedifex/cache.lux
blob: a7f6439dfc0d893bdca85b0113c71f8a60c1da12 (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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
(.module:
  [lux #*
   [abstract
    [codec (#+ Codec)]
    ["." monad (#+ do)]]
   [control
    ["." try (#+ Try)]
    [concurrency
     ["." promise (#+ Promise)]]
    [security
     ["!" capability]]]
   [data
    [binary (#+ Binary)]
    ["." product]
    [text
     ["%" format (#+ format)]
     ["." encoding]]
    [collection
     ["." dictionary]
     ["." set (#+ Set)]
     ["." list]]
    [format
     ["." xml]]]
   [world
    [program (#+ Program)]
    ["." file (#+ Path File Directory)]]]
  ["." // #_
   ["#" local]
   ["#." hash (#+ Hash SHA-1 MD5)]
   ["#." package (#+ Package)]
   ["#." artifact (#+ Artifact)
    ["#/." type]
    ["#/." extension (#+ Extension)]]
   ["#." dependency (#+ Dependency)
    [resolution (#+ Resolution)]
    ["#/." status (#+ Status)]]
   ["#." repository #_
    ["#/." origin]]])

(def: (write! system content file)
  (-> (file.System Promise) Binary Path (Promise (Try Any)))
  (do (try.with promise.monad)
    [file (: (Promise (Try (File Promise)))
             (file.get_file promise.monad system file))]
    (!.use (\ file over_write) [content])))

(def: (write_hashed system directory [artifact type] [data status])
  (-> (file.System Promise) Path Dependency [Binary Status] (Promise (Try Any)))
  (let [prefix (format directory
                       (\ system separator)
                       (//artifact.identity artifact)
                       (//artifact/extension.extension type))]
    (do {! (try.with promise.monad)}
      [_ (..write! system data prefix)
       #let [write_hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Promise (Try Any))))
                           (function (_ codec extension hash)
                             (..write! system
                                       (|> hash (\ codec encode) (\ encoding.utf8 encode))
                                       (format prefix extension))))]]
      (case status
        #//dependency/status.Unverified
        (wrap [])
        
        (#//dependency/status.Partial partial)
        (case partial
          (#.Left sha-1)
          (write_hash //hash.sha-1_codec //artifact/extension.sha-1 sha-1)
          
          (#.Right md5)
          (write_hash //hash.md5_codec //artifact/extension.md5 md5))
        
        (#//dependency/status.Verified sha-1 md5)
        (do !
          [_ (write_hash //hash.sha-1_codec //artifact/extension.sha-1 sha-1)]
          (write_hash //hash.md5_codec //artifact/extension.md5 md5))))))

(def: #export (write_one program system [artifact type] package)
  (-> (Program Promise) (file.System Promise) Dependency Package (Promise (Try Artifact)))
  (do promise.monad
    [home (\ program home [])]
    (do (try.with promise.monad)
      [directory (: (Promise (Try Path))
                    (file.make_directories promise.monad system (//.path system home artifact)))
       _ (write_hashed system directory [artifact type] (get@ #//package.library package))
       _ (let [[pom status] (get@ #//package.pom package)]
           (write_hashed system directory
                         [artifact //artifact/type.pom]
                         [(|> pom (\ xml.codec encode) (\ encoding.utf8 encode))
                          status]))]
      (wrap artifact))))

(def: #export (write_all program system resolution)
  (-> (Program Promise) (file.System Promise) Resolution (Promise (Try (Set Artifact))))
  (do {! (try.with promise.monad)}
    []
    (|> (dictionary.entries resolution)
        (list.filter (|>> product.right //package.local? not))
        (monad.map ! (function (_ [dependency package])
                       (..write_one program system dependency package)))
        (\ ! map (set.from_list //artifact.hash)))))

(def: (read! system path)
  (-> (file.System Promise) Path (Promise (Try Binary)))
  (do (try.with promise.monad)
    [file (: (Promise (Try (File Promise)))
             (!.use (\ system file) path))]
    (!.use (\ file content) [])))

(def: (decode codec data)
  (All [a] (-> (Codec Text a) Binary (Try a)))
  (let [(^open "_\.") try.monad]
    (|> data
        (\ encoding.utf8 decode)
        (_\map (\ codec decode))
        _\join)))

(def: #export (read_one program system [artifact type])
  (-> (Program Promise) (file.System Promise) Dependency (Promise (Try Package)))
  (do promise.monad
    [home (\ program home [])
     #let [prefix (format (//.path system home artifact)
                          (\ system separator)
                          (//artifact.identity artifact))]]
    (do (try.with promise.monad)
      [pom (..read! system (format prefix //artifact/extension.pom))
       #let [extension (//artifact/extension.extension type)]
       library (..read! system (format prefix extension))
       library_sha-1 (..read! system (format prefix extension //artifact/extension.sha-1))
       library_md5 (..read! system (format prefix extension //artifact/extension.md5))]
      (\ promise.monad wrap
         (do try.monad
           [pom (..decode xml.codec pom)
            library_sha-1 (..decode //hash.sha-1_codec library_sha-1)
            library_md5 (..decode //hash.md5_codec library_md5)]
           (wrap {#//package.origin (#//repository/origin.Local prefix)
                  #//package.library [library (#//dependency/status.Verified library_sha-1 library_md5)]
                  #//package.pom [pom #//dependency/status.Unverified]}))))))

(def: #export (read_all program system dependencies resolution)
  (-> (Program Promise) (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution)))
  (case dependencies
    #.Nil
    (\ (try.with promise.monad) wrap resolution)
    
    (#.Cons head tail)
    (do promise.monad
      [package (case (dictionary.get head resolution)
                 (#.Some package)
                 (wrap (#try.Success package))

                 #.None
                 (..read_one program system head))]
      (with_expansions [<next> (as_is (read_all program system tail resolution))]
        (case package
          (#try.Success package)
          (do (try.with promise.monad)
            [sub_dependencies (|> package
                                  //package.dependencies
                                  (\ promise.monad wrap))
             resolution (|> resolution
                            (dictionary.put head package)
                            (read_all program system (set.to_list sub_dependencies)))]
            <next>)
          
          (#try.Failure error)
          <next>)))))