aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/tool/compiler/meta/io/context.lux
blob: 2e4b355bdcf81d9bb7fddc08dffc50365af02ad4 (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
(.module:
  [lux (#- Module Code)
   ["@" target]
   [abstract
    [monad (#+ Monad do)]]
   [control
    ["." try (#+ Try)]
    ["ex" exception (#+ Exception exception:)]
    [security
     ["!" capability]]]
   [data
    ["." text ("#;." hash)
     ["%" format (#+ format)]
     ["." encoding]]]
   [world
    ["." file (#+ Path File)]
    [binary (#+ Binary)]]
   [type (#+ :share)]]
  ["." // (#+ Context Code)
   ["#/" // #_
    [archive
     [descriptor (#+ Module)]]
    ["#/" // (#+ Input)]]])

(template [<name>]
  [(exception: #export (<name> {module Module})
     (ex.report ["Module" module]))]

  [cannot-find-module]
  [cannot-read-module]
  )

(type: #export Extension Text)

(def: lux-extension
  Extension
  ".lux")

(def: #export (path system context module)
  (All [m] (-> (file.System m) Context Module Path))
  (|> module
      (//.sanitize system)
      (format context (:: system separator))))

(def: (find-source-file monad system contexts module extension)
  (All [!]
    (-> (Monad !) (file.System !) (List Context) Module Extension
        (! (Try [Path (File !)]))))
  (case contexts
    #.Nil
    (:: monad wrap (ex.throw ..cannot-find-module [module]))

    (#.Cons context contexts')
    (do monad
      [#let [path (format (..path system context module) extension)]
       file (!.use (:: system file) path)]
      (case file
        (#try.Success file)
        (wrap (#try.Success [path file]))

        (#try.Failure _)
        (find-source-file monad system contexts' module extension)))))

(def: #export (find-any-source-file monad system contexts partial-host-extension module)
  (All [!]
    (-> (Monad !) (file.System !) (List Context) Text Module
        (! (Try [Path (File !)]))))
  (let [full-host-extension (format partial-host-extension lux-extension)]
    (do monad
      [outcome (find-source-file monad system contexts module full-host-extension)]
      (case outcome
        (#try.Success output)
        (wrap outcome)

        (#try.Failure _)
        (find-source-file monad system contexts module ..lux-extension)))))

(def: #export (read monad system contexts partial-host-extension module)
  (All [!]
    (-> (Monad !) (file.System !) (List Context) Text Module
        (! (Try Input))))
  (do (try.with monad)
    [## TODO: Get rid of both ":share"s ASAP
     path,file (:share [!]
                       {(Monad !)
                        monad}
                       {(! (Try [Path (File !)]))
                        (find-any-source-file monad system contexts partial-host-extension module)})
     #let [[path file] (:share [!]
                               {(Monad !)
                                monad}
                               {[Path (File !)]
                                path,file})]
     binary (!.use (:: file content) [])]
    (case (encoding.from-utf8 binary)
      (#try.Success code)
      (wrap {#////.module module
             #////.file path
             #////.hash (text;hash code)
             #////.code code})
      
      (#try.Failure _)
      (:: monad wrap (ex.throw ..cannot-read-module [module])))))