aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/compositor.lux
blob: a92aea013616213c08bfabfe4d4391e6030dc84d (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
(.module:
  [lux #*
   [type (#+ :share)]
   [abstract
    [monad (#+ do)]]
   [control
    [cli (#+ program:)]
    ["." io (#+ IO io)]
    [security
     ["!" capability]]]
   [data
    ["." product]
    ["." error (#+ Error)]
    ["." text
     format]
    [collection
     ["." dictionary]
     ["." row]
     ["." list ("#@." functor fold)]]]
   [time
    ["." instant (#+ Instant)]]
   [host
    ["_" js]]
   [world
    ["." file (#+ File)]
    ["." console]]
   [tool
    [compiler
     ["." statement]
     ["." phase
      [macro (#+ Expander)]
      ["." generation]]
     [default
      ["." platform (#+ Platform)]
      ["." syntax]]
     [meta
      ["." archive (#+ Archive)]
      [packager
       ["." script]]]]
    ## ["." interpreter]
    ]]
  [/
   ["." cli (#+ Service)]])

(def: (or-crash! failure-description action)
  (All [a]
    (-> Text (IO (Error a)) (IO a)))
  (do io.monad
    [?output action]
    (case ?output
      (#error.Failure error)
      (exec (log! (format text.new-line
                          failure-description text.new-line
                          error text.new-line))
        (io.exit +1))

      (#error.Success output)
      (wrap output))))

(def: (save-artifacts! system state)
  (All [anchor expression statement]
    (-> (file.System IO)
        (statement.State+ anchor expression statement)
        (IO (Error Any))))
  (let [?outcome (phase.run' state
                             (:share [anchor expression statement]
                                     {(statement.State+ anchor expression statement)
                                      state}
                                     {(statement.Operation anchor expression statement
                                                           (generation.Output statement))
                                      (statement.lift-generation generation.output)}))]
    (case ?outcome
      (#error.Success [state output])
      (do (error.with io.monad)
        [file (: (IO (Error (File IO)))
                 (file.get-file io.monad system "program.js"))]
        (!.use (:: file over-write) (script.package output)))

      (#error.Failure error)
      (:: io.monad wrap (#error.Failure error)))))

(def: #export (compiler expander platform bundle program service)
  (All [anchor expression statement]
    (-> Expander
        (IO (Platform IO anchor expression statement))
        (generation.Bundle anchor expression statement)
        (-> expression statement)
        Service
        (IO Any)))
  (do io.monad
    [platform platform
     console (:: @ map error.assume console.system)]
    (case service
      (#cli.Compilation configuration)
      (<| (or-crash! "Compilation failed:")
          (do (error.with io.monad)
            [state (:share [anchor expression statement]
                           {(Platform IO anchor expression statement)
                            platform}
                           {(IO (Error (statement.State+ anchor expression statement)))
                            (platform.initialize expander platform bundle program)})
             [archive state] (:share [anchor expression statement]
                                     {(Platform IO anchor expression statement)
                                      platform}
                                     {(IO (Error [Archive (statement.State+ anchor expression statement)]))
                                      (platform.compile expander platform configuration archive.empty state)})
             _ (save-artifacts! (get@ #platform.&file-system platform) state)
             ## _ (cache/io.clean target ...)
             ]
            (wrap (log! "Compilation complete!"))))
      
      (#cli.Interpretation configuration)
      ## TODO: Fix the interpreter...
      (undefined)
      ## (<| (or-crash! "Interpretation failed:")
      ##     (interpreter.run (error.with io.monad) console platform configuration bundle))
      )))