aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/tool/compiler/meta/io/context.lux
blob: 979edaa765fd5250f346da917709ba4153852dbe (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
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
(.module:
  [library
   [lux (#- Module Code)
    ["@" target]
    [abstract
     [predicate (#+ Predicate)]
     ["." monad (#+ Monad do)]]
    [control
     ["." maybe]
     ["." try (#+ Try)]
     ["." exception (#+ exception:)]
     [concurrency
      ["." async (#+ Async) ("#\." monad)]]]
    [data
     [binary (#+ Binary)]
     ["." text ("#\." hash)
      ["%" format (#+ format)]
      [encoding
       ["." utf8]]]
     [collection
      ["." dictionary (#+ Dictionary)]
      ["." list]]]
    [world
     ["." file]]]]
  [program
   [compositor
    [import (#+ Import)]]]
  ["." // (#+ Context Code)
   ["/#" // #_
    [archive
     [descriptor (#+ Module)]]
    ["/#" // (#+ Input)]]])

(exception: .public (cannot_find_module {importer Module} {module Module})
  (exception.report
   ["Module" (%.text module)]
   ["Importer" (%.text importer)]))

(exception: .public (cannot_read_module {module Module})
  (exception.report
   ["Module" (%.text module)]))

(type: .public Extension
  Text)

(def: lux_extension
  Extension
  ".lux")

(def: .public (path fs context module)
  (All [m] (-> (file.System m) Context Module file.Path))
  (|> module
      (//.safe fs)
      (format context (\ fs separator))))

(def: (find_source_file fs importer contexts module extension)
  (-> (file.System Async) Module (List Context) Module Extension
      (Async (Try file.Path)))
  (case contexts
    #.End
    (async\in (exception.except ..cannot_find_module [importer module]))

    (#.Item context contexts')
    (let [path (format (..path fs context module) extension)]
      (do async.monad
        [? (\ fs file? path)]
        (if ?
          (in (#try.Success path))
          (find_source_file fs importer contexts' module extension))))))

(def: (full_host_extension partial_host_extension)
  (-> Extension Extension)
  (format partial_host_extension ..lux_extension))

(def: (find_local_source_file fs importer import contexts partial_host_extension module)
  (-> (file.System Async) Module Import (List Context) Extension Module
      (Async (Try [file.Path Binary])))
  ... Preference is explicitly being given to Lux files that have a host extension.
  ... Normal Lux files (i.e. without a host extension) are then picked as fallback files.
  (do {! async.monad}
    [outcome (..find_source_file fs importer contexts module (..full_host_extension partial_host_extension))]
    (case outcome
      (#try.Success path)
      (|> path
          (\ fs read)
          (\ (try.with !) map (|>> [path])))

      (#try.Failure _)
      (do {! (try.with !)}
        [path (..find_source_file fs importer contexts module ..lux_extension)]
        (|> path
            (\ fs read)
            (\ ! map (|>> [path])))))))

(def: (find_library_source_file importer import partial_host_extension module)
  (-> Module Import Extension Module (Try [file.Path Binary]))
  (let [path (format module (..full_host_extension partial_host_extension))]
    (case (dictionary.value path import)
      (#.Some data)
      (#try.Success [path data])

      #.None
      (let [path (format module ..lux_extension)]
        (case (dictionary.value path import)
          (#.Some data)
          (#try.Success [path data])

          #.None
          (exception.except ..cannot_find_module [importer module]))))))

(def: (find_any_source_file fs importer import contexts partial_host_extension module)
  (-> (file.System Async) Module Import (List Context) Extension Module
      (Async (Try [file.Path Binary])))
  ... Preference is explicitly being given to Lux files that have a host extension.
  ... Normal Lux files (i.e. without a host extension) are then picked as fallback files.
  (do {! async.monad}
    [outcome (find_local_source_file fs importer import contexts partial_host_extension module)]
    (case outcome
      (#try.Success [path data])
      (in outcome)

      (#try.Failure _)
      (in (..find_library_source_file importer import partial_host_extension module)))))

(def: .public (read fs importer import contexts partial_host_extension module)
  (-> (file.System Async) Module Import (List Context) Extension Module
      (Async (Try Input)))
  (do (try.with async.monad)
    [[path binary] (..find_any_source_file fs importer import contexts partial_host_extension module)]
    (case (\ utf8.codec decode binary)
      (#try.Success code)
      (in {#////.module module
           #////.file path
           #////.hash (text\hash code)
           #////.code code})
      
      (#try.Failure _)
      (async\in (exception.except ..cannot_read_module [module])))))

(type: .public Enumeration
  (Dictionary file.Path Binary))

(def: (context_listing fs context directory enumeration)
  (-> (file.System Async) Context file.Path Enumeration (Async (Try Enumeration)))
  (do {! (try.with async.monad)}
    [enumeration (|> directory
                     (\ fs directory_files)
                     (\ ! map (monad.fold ! (function (_ file enumeration)
                                              (if (text.ends_with? ..lux_extension file)
                                                (do !
                                                  [source_code (\ fs read file)]
                                                  (async\in (dictionary.has' (text.replaced context "" file) source_code enumeration)))
                                                (in enumeration)))
                                          enumeration))
                     (\ ! join))]
    (|> directory
        (\ fs sub_directories)
        (\ ! map (monad.fold ! (context_listing fs context) enumeration))
        (\ ! join))))

(def: Action
  (type (All [a] (Async (Try a)))))

(def: (canonical fs context)
  (-> (file.System Async) Context (Action Context))
  (do (try.with async.monad)
    [subs (\ fs sub_directories context)]
    (in (|> subs
            list.head
            (maybe.else context)
            (file.parent fs)
            (maybe.else context)))))

(def: .public (listing fs contexts)
  (-> (file.System Async) (List Context) (Action Enumeration))
  (let [! (: (Monad Action)
             (try.with async.monad))]
    (monad.fold !
                (function (_ context enumeration)
                  (do !
                    [context (..canonical fs context)]
                    (..context_listing fs
                                       (format context (\ fs separator))
                                       context
                                       enumeration)))
                (: Enumeration
                   (dictionary.empty text.hash))
                contexts)))