aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/language/compiler/meta/archive.lux
blob: 4a981007a247ff7ec5631514b5b4576b59580391 (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
(.module:
  [lux #*
   [control
    ["ex" exception (#+ exception:)]
    [equivalence (#+ Equivalence)]
    [monad (#+ do)]]
   [data
    [error (#+ Error)]
    [ident]
    ["." text
     format]
    [collection ["dict" dictionary (#+ Dictionary)]]]
   [language [type (#+ :share)]]
   [type abstract]
   [world [file (#+ File)]]]
  [//// (#+ Version)])

## Key
(type: #export Signature
  {#name Ident
   #version Version})

(def: Equivalence<Signature>
  (Equivalence Signature)
  (equivalence.product ident.Equivalence<Ident> text.Equivalence<Text>))

(def: (describe signature)
  (-> Signature Text)
  (format (%ident (get@ #name signature)) " " (get@ #version signature)))

(abstract: #export (Key k)
  {}

  Signature

  (structure: #export Equivalence<Key>
    (All [k] (Equivalence (Key k)))
    (def: (= reference sample)
      (:: Equivalence<Signature> = (:representation reference) (:representation sample))))

  (def: #export default
    (Key Nothing)
    (:abstraction {#name ["" ""]
                   #version ////.version}))

  (def: #export signature
    (-> (Key Any) Signature)
    (|>> :representation))
  )

## Document
(exception: #export (invalid-key-for-document {expected (Key Any)} {actual (Key Any)})
  (ex.report ["Expected" (describe (..signature expected))]
             ["Actual" (describe (..signature actual))]))

(exception: #export (signature-does-not-match-key {key (Key Any)} {signature Signature})
  (ex.report ["Key" (describe (..signature key))]
             ["Signature" (describe signature)]))

(type: #export Reference Text)

(type: #export Descriptor
  {#hash Nat
   #file File
   #references (List Reference)
   #state Module-State})

(type: #export (Document d)
  {#key (Key d)
   #descriptor Descriptor
   #content d})

(def: #export (open expected [actual _descriptor content])
  (All [d] (-> (Key d) (Document Any) (Error d)))
  (if (:: Equivalence<Key> = expected actual)
    (#error.Success (:share [e]
                            {(Key e)
                             expected}
                            {e
                             content}))
    (ex.throw invalid-key-for-document [expected actual])))

(def: #export (close key signature descriptor content)
  (All [d] (-> (Key d) Signature Descriptor d (Error (Document d))))
  (if (:: Equivalence<Signature> = (..signature key) signature)
    (#error.Success {#key key
                     #descriptor descriptor
                     #content content})
    (ex.throw signature-does-not-match-key [key signature])))

## Archive
(exception: #export (cannot-replace-document-in-archive {name Text} {old (Document Any)} {new (Document Any)})
  (ex.report ["Module's name" name]
             ["Old document's key" (describe (..signature (get@ #key old)))]
             ["New document's key" (describe (..signature (get@ #key new)))]))

(type: #export Archive
  (Dictionary Text (Ex [d] (Document d))))

(def: #export empty Archive (dict.new text.Hash<Text>))

(def: #export (add name document archive)
  (-> Text (Ex [d] (Document d)) Archive (Error Archive))
  (case (dict.get name archive)
    (#.Some existing)
    (if (is? document existing)
      (#error.Success archive)
      (ex.throw cannot-replace-document-in-archive [name existing document]))
    
    #.None
    (#error.Success (dict.put name document archive))))

(def: #export (merge additions archive)
  (-> Archive Archive (Error Archive))
  (monad.fold error.Monad<Error>
              (function (_ [name' document'] archive')
                (..add name' document' archive'))
              archive
              (dict.entries additions)))