aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/tool/compiler/meta/archive.lux
blob: edab30124110ef3fb94dd5d3afb8422e7a6b22ff (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
(.module:
  [lux (#- Module)
   [abstract
    ["." equivalence (#+ Equivalence)]
    ["." monad (#+ do)]]
   [control
    ["." try (#+ Try)]
    ["." exception (#+ exception:)]
    ["." function]]
   [data
    ["." name]
    ["." text]
    [collection
     ["." dictionary (#+ Dictionary)]]]
   [type
    abstract]
   [world
    [file (#+ File)]]]
  [/
   ["." signature (#+ Signature)]
   ["." key (#+ Key)]
   ["." descriptor (#+ Module Descriptor)]
   ["." document (#+ Document)]])

(exception: #export (unknown-document {module Module}
                                      {known-modules (List Module)})
  (exception.report
   ["Module" module]
   ["Known Modules" (exception.enumerate function.identity known-modules)]))

(exception: #export (cannot-replace-document {module Module}
                                             {old (Document Any)}
                                             {new (Document Any)})
  (exception.report
   ["Module" module]
   ["Old key" (signature.description (document.signature old))]
   ["New key" (signature.description (document.signature new))]))

(abstract: #export Archive
  {}
  
  (Dictionary Module [Descriptor (Document Any)])

  (def: #export empty
    Archive
    (:abstraction (dictionary.new text.hash)))

  (def: #export (add module [descriptor document] archive)
    (-> Module [Descriptor (Document Any)] Archive (Try Archive))
    (case (dictionary.get module (:representation archive))
      (#.Some [existing-descriptor existing-document])
      (if (is? document existing-document)
        (#try.Success archive)
        (exception.throw cannot-replace-document [module existing-document document]))
      
      #.None
      (#try.Success (|> archive
                        :representation
                        (dictionary.put module [descriptor document])
                        :abstraction))))

  (def: #export (find module archive)
    (-> Module Archive (Try [Descriptor (Document Any)]))
    (case (dictionary.get module (:representation archive))
      (#.Some document)
      (#try.Success document)
      
      #.None
      (exception.throw ..unknown-document [module
                                           (dictionary.keys (:representation archive))])))

  (def: #export (archived? archive module)
    (-> Archive Module Bit)
    (case (find module archive)
      (#try.Success _)
      yes

      (#try.Failure _)
      no))

  (def: #export archived
    (-> Archive (List Module))
    (|>> :representation dictionary.keys))

  (def: #export (merge additions archive)
    (-> Archive Archive (Try Archive))
    (monad.fold try.monad
                (function (_ [module' descriptor+document'] archive')
                  (..add module' descriptor+document' archive'))
                archive
                (dictionary.entries (:representation additions))))
  )