(.module:
  lux
  (lux (control [monad #+ do]
                ["ex" exception #+ exception:])
       [io]
       (concurrency [atom #+ Atom atom])
       (data ["e" error #+ Error]
             [text "text/" Hash<Text>]
             text/format
             (coll [dict #+ Dict]))
       [macro]
       [host]
       (world [blob #+ Blob]
              [file #+ File]))
  (luxc [lang]
        (lang [".L" variable #+ Register]
              (host ["$" jvm]
                    (jvm ["$t" type]
                         ["$d" def]
                         ["$i" inst])))))

(host.import org/objectweb/asm/Opcodes
  (#static V1_6 int))

(host.import org/objectweb/asm/Label)

(host.import java/lang/Object)

(host.import java/lang/reflect/Field
  (get [#? Object] #try #? Object))

(host.import (java/lang/Class c)
  (getField [String] #try Field))

(host.import java/lang/ClassLoader
  (loadClass [String] (Class Object)))

(type: #export Bytecode Blob)

(type: #export Class-Store (Atom (Dict Text Bytecode)))

(type: #export Artifacts (Dict File Blob))

(type: #export Host
  {#context [Text Nat]
   #anchor (Maybe [Label Register])
   #loader ClassLoader
   #store Class-Store
   #artifacts Artifacts})

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

  [Unknown-Class]
  [Class-Already-Stored]
  [No-Function-Being-Compiled]
  [Cannot-Overwrite-Artifact]
  [Cannot-Load-Definition]
  [Invalid-Definition-Value]
  )

(def: #export (with-artifacts action)
  (All [a] (-> (Meta a) (Meta [Artifacts a])))
  (function (_ compiler)
    (case (action (update@ #.host
                           (|>> (:! Host)
                                (set@ #artifacts (dict.new text.Hash<Text>))
                                (:! Void))
                           compiler))
      (#e.Success [compiler' output])
      (#e.Success [(update@ #.host
                            (|>> (:! Host)
                                 (set@ #artifacts (|> (get@ #.host compiler) (:! Host) (get@ #artifacts)))
                                 (:! Void))
                            compiler')
                   [(|> compiler' (get@ #.host) (:! Host) (get@ #artifacts))
                    output]])
      
      (#e.Error error)
      (#e.Error error))))

(def: #export (record-artifact name content)
  (-> Text Blob (Meta Unit))
  (function (_ compiler)
    (if (|> compiler (get@ #.host) (:! Host) (get@ #artifacts) (dict.contains? name))
      (ex.throw Cannot-Overwrite-Artifact name)
      (#e.Success [(update@ #.host
                            (|>> (:! Host)
                                 (update@ #artifacts (dict.put name content))
                                 (:! Void))
                            compiler)
                   []]))))

(def: #export (store-class name byte-code)
  (-> Text Bytecode (Meta Unit))
  (function (_ compiler)
    (let [store (|> (get@ #.host compiler)
                    (:! Host)
                    (get@ #store))]
      (if (dict.contains? name (|> store atom.read io.run))
        (ex.throw Class-Already-Stored name)
        (exec (io.run (atom.update (dict.put name byte-code) store))
          (#e.Success [compiler []]))))))

(def: #export (load-class name)
  (-> Text (Meta (Class Object)))
  (function (_ compiler)
    (let [host (:! Host (get@ #.host compiler))
          store (|> host (get@ #store) atom.read io.run)]
      (if (dict.contains? name store)
        (#e.Success [compiler (ClassLoader::loadClass [name] (get@ #loader host))])
        (ex.throw Unknown-Class name)))))

(def: #export value-field Text "_value")
(def: #export $Object $.Type ($t.class "java.lang.Object" (list)))

(def: #export (load-definition compiler)
  (-> Compiler
      (-> Ident Blob (Error Top)))
  (function (_ (^@ def-ident [def-module def-name]) def-bytecode)
    (let [normal-name (format (lang.normalize-name def-name) (%n (text/hash def-name)))
          class-name (format (text.replace-all "/" "." def-module) "." normal-name)]
      (<| (macro.run compiler)
          (do macro.Monad<Meta>
            [_ (..store-class class-name def-bytecode)
             class (..load-class class-name)]
            (case (do e.Monad<Error>
                    [field (Class::getField [..value-field] class)]
                    (Field::get [#.None] field))
              (#e.Success (#.Some def-value))
              (wrap def-value)

              (#e.Success #.None)
              (lang.throw Invalid-Definition-Value (%ident def-ident))
              
              (#e.Error error)
              (lang.throw Cannot-Load-Definition
                          (format "Definition: " (%ident def-ident) "\n"
                                  "Error:\n"
                                  error))))))))