aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/io.jvm.lux
blob: c0c913772a388c44fd39c200ad0f4c8393876822 (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
(.module:
  lux
  (lux (control monad
                ["ex" exception #+ exception:])
       [io #+ Process]
       (data ["e" error]
             [text "text/" Eq<Text>]
             text/format)
       [macro]
       [host]
       (world [file #+ File]
              [blob #+ Blob])))

(host.import: java/lang/String
  (new [(Array byte)]))

(def: host-extension Text ".jvm")
(def: lux-extension Text ".lux")

(do-template [<name>]
  [(exception: #export (<name> {message Text})
     message)]

  [File-Not-Found]
  [Module-Not-Found]
  [Could-Not-Prepare-Module]
  )

(def: sanitize
  (-> Text Text)
  (text.replace-all "/" file.separator))

(def: (find-source dirs path)
  (-> (List File) Text (Process [Text File]))
  (case dirs
    #.Nil
    (io.fail (ex.construct File-Not-Found path))

    (#.Cons dir dirs')
    (do io.Monad<Process>
      [#let [file (format dir file.separator path)]
       ? (file.exists? file)]
      (if ?
        (wrap [path file])
        (find-source dirs' path)))))

(def: (either left right)
  (All [a] (-> (Process a) (Process a) (Process a)))
  (do io.Monad<IO>
    [?output left]
    (case ?output
      (#e.Success output)
      (wrap (#e.Success output))

      (#e.Error error)
      right)))

(def: #export blob-to-text
  (-> Blob Text)
  (|>> [] String::new))

(def: #export (read dirs name)
  (-> (List File) Text (Process [File Text]))
  (do io.Monad<Process>
    [[path file] (: (Process [Text File])
                    ($_ either
                        (find-source dirs (format name host-extension lux-extension))
                        (find-source dirs (format name lux-extension))
                        (io.fail (ex.construct Module-Not-Found name))))
     blob (file.read file)]
    (wrap [path (blob-to-text blob)])))

(def: #export (platform-target root-target)
  (-> File File)
  (format root-target "/" (for {"JVM" "jvm"
                                "JS" "js"})))

(def: #export (prepare-target target-dir)
  (-> File (Process Bool))
  (do io.Monad<Process>
    [_ (file.make-directory (sanitize target-dir))]
    (file.make-directory (sanitize (platform-target target-dir)))))

(def: #export (prepare-module target-dir module-name)
  (-> File Text (Process Any))
  (do io.Monad<Process>
    [#let [module-path (|> module-name
                           (format (platform-target target-dir) "/")
                           sanitize)]
     module-exists? (file.exists? module-path)
     made-dir? (if module-exists?
                 (wrap module-exists?)
                 (file.make-directory module-path))]
    (if made-dir?
      (wrap [])
      (io.fail (ex.construct Could-Not-Prepare-Module
                             (format "Module: " module-name "\n"
                                     "Target: " target-dir "\n"))))))

(def: #export (write target name content)
  (-> File Text Blob (Process Any))
  (|> name
      (format (platform-target target) "/")
      sanitize
      (file.write content)))

(def: #export (module target-dir module-dir)
  (-> File File (Maybe Text))
  (case (text.split-with target-dir module-dir)
    (#.Some ["" post])
    (let [raw (text.replace-all file.separator "/" post)]
      (if (text.starts-with? "/" raw)
        (text.clip' +1 raw)
        (#.Some raw)))
    
    _
    #.None))

(def: #export (file target-dir file-name)
  (-> File Text File)
  (format target-dir file.separator (sanitize file-name)))