aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux
blob: 426a6858926498cb2cb307a6e543826789c81ecf (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
(.using
 [library
  [lux "*"
   ["@" target]
   [abstract
    ["[0]" monad {"+" Monad do}]]
   [control
    ["[0]" pipe]
    ["[0]" try {"+" Try}]
    ["[0]" exception {"+" exception:}]]
   [data
    [binary {"+" Binary}]
    ["[0]" product]
    ["[0]" text ("[1]#[0]" equivalence)
     ["%" format {"+" format}]]
    [collection
     ["[0]" list ("[1]#[0]" functor)]
     ["[0]" dictionary {"+" Dictionary}]]]
   [world
    ["[0]" file]]]]
 ["[0]" //
  [//
   [context {"+" Context}]
   [archive
    ["[0]" module]]]])

(exception: .public (cannot_enable [archive file.Path
                                    @module module.ID
                                    error Text])
  (exception.report
   "Archive" archive
   "Module ID" (%.nat @module)
   "Error" error))

(def: .public (path fs context @module)
  (All (_ !) (-> (file.System !) Context module.ID file.Path))
  (format (//.path fs context)
          (# fs separator)
          (%.nat @module)))

(def: .public (enabled? fs context @module)
  (All (_ !) (-> (file.System !) Context module.ID (! Bit)))
  (# fs directory? (..path fs context @module)))

(def: .public (enable! ! fs context @module)
  (All (_ !) (-> (Monad !) (file.System !) Context module.ID (! (Try Any))))
  (do !
    [.let [path (..path fs context @module)]
     module_exists? (# fs directory? path)]
    (if module_exists?
      (in {try.#Success []})
      (with_expansions [<failure> (exception.except ..cannot_enable [(//.path fs context)
                                                                     @module
                                                                     error])]
        (do !
          [? (//.enable! ! fs context)]
          (case ?
            {try.#Failure error}
            (in <failure>)
            
            success
            (|> path
                (# fs make_directory)
                (# ! each (|>> (pipe.case
                                 {try.#Failure error}
                                 <failure>

                                 success
                                 success))))))))))

(def: file
  file.Path
  "descriptor")

(def: .public (descriptor fs context @module)
  (All (_ !) (-> (file.System !) Context module.ID file.Path))
  (format (..path fs context @module)
          (# fs separator)
          ..file))

(def: .public (cache! fs context @module content)
  (All (_ !) (-> (file.System !) Context module.ID Binary (! (Try Any))))
  (# fs write (..descriptor fs context @module) content))

(def: .public (cache fs context @module)
  (All (_ !) (-> (file.System !) Context module.ID (! (Try Binary))))
  (# fs read (..descriptor fs context @module)))

(def: .public (artifacts ! fs context @module)
  (All (_ !) (-> (Monad !) (file.System !) Context module.ID (! (Try (Dictionary Text Binary)))))
  (do [! (try.with !)]
    [files (# fs directory_files (..path fs context @module))
     pairs (|> files
               (list#each (function (_ file)
                            [(file.name fs file) file]))
               (list.only (|>> product.left (text#= ..file) not))
               (monad.each ! (function (_ [name path])
                               (|> path
                                   (# fs read)
                                   (# ! each (|>> [name]))))))]
    (in (dictionary.of_list text.hash (for @.old (as (List [Text Binary]) pairs)
                                           pairs)))))