(.module:
  lux
  (lux (data [text]
             text/format
             [product]
             (coll ["a" array]
                   [list "list/" Functor<List>]))
       [host #+ do-to]
       [function])
  ["$" //]
  (// ["$t" type]))

## [Host]
(host.import: #long java/lang/Object)
(host.import: #long java/lang/String)

(host.import: org/objectweb/asm/Opcodes
  (#static ACC_PUBLIC int)
  (#static ACC_PROTECTED int)
  (#static ACC_PRIVATE int)

  (#static ACC_TRANSIENT int)
  (#static ACC_VOLATILE int)

  (#static ACC_ABSTRACT int)
  (#static ACC_FINAL int)
  (#static ACC_STATIC int)
  (#static ACC_SYNCHRONIZED int)
  (#static ACC_STRICT int)

  (#static ACC_SUPER int)
  (#static ACC_INTERFACE int)

  (#static V1_1 int)
  (#static V1_2 int)
  (#static V1_3 int)
  (#static V1_4 int)
  (#static V1_5 int)
  (#static V1_6 int)
  (#static V1_7 int)
  (#static V1_8 int)
  )

(host.import: org/objectweb/asm/FieldVisitor
  (visitEnd [] void))

(host.import: org/objectweb/asm/MethodVisitor
  (visitCode [] void)
  (visitMaxs [int int] void)
  (visitEnd [] void))

(host.import: org/objectweb/asm/ClassWriter
  (#static COMPUTE_MAXS int)
  (#static COMPUTE_FRAMES int)
  (new [int])
  (visit [int int String String String (Array String)] void)
  (visitEnd [] void)
  (visitField [int String String String Object] FieldVisitor)
  (visitMethod [int String String String (Array String)] MethodVisitor)
  (toByteArray [] (Array byte)))

## [Defs]
(def: (string-array values)
  (-> (List Text) (Array Text))
  (let [output (host.array String (list.size values))]
    (exec (list/map (function (_ [idx value])
                      (host.array-write idx value output))
                    (list.enumerate values))
      output)))

(def: exceptions-array
  (-> $.Method (Array Text))
  (|>> (get@ #$.exceptions)
       (list/map (|>> #$.Generic $t.descriptor))
       string-array))

(def: (version-flag version)
  (-> $.Version Int)
  (case version
    #$.V1_1 Opcodes::V1_1
    #$.V1_2 Opcodes::V1_2
    #$.V1_3 Opcodes::V1_3
    #$.V1_4 Opcodes::V1_4
    #$.V1_5 Opcodes::V1_5
    #$.V1_6 Opcodes::V1_6
    #$.V1_7 Opcodes::V1_7
    #$.V1_8 Opcodes::V1_8))

(def: (visibility-flag visibility)
  (-> $.Visibility Int)
  (case visibility
    #$.Public    Opcodes::ACC_PUBLIC
    #$.Protected Opcodes::ACC_PROTECTED
    #$.Private   Opcodes::ACC_PRIVATE
    #$.Default   0))

(def: (class-flags config)
  (-> $.Class-Config Int)
  ($_ i/+
      (if (get@ #$.finalC config) Opcodes::ACC_FINAL 0)))

(def: (method-flags config)
  (-> $.Method-Config Int)
  ($_ i/+
      (if (get@ #$.staticM config) Opcodes::ACC_STATIC 0)
      (if (get@ #$.finalM config) Opcodes::ACC_FINAL 0)
      (if (get@ #$.synchronizedM config) Opcodes::ACC_SYNCHRONIZED 0)
      (if (get@ #$.strictM config) Opcodes::ACC_STRICT 0)))

(def: (field-flags config)
  (-> $.Field-Config Int)
  ($_ i/+
      (if (get@ #$.staticF config) Opcodes::ACC_STATIC 0)
      (if (get@ #$.finalF config) Opcodes::ACC_FINAL 0)
      (if (get@ #$.transientF config) Opcodes::ACC_TRANSIENT 0)
      (if (get@ #$.volatileF config) Opcodes::ACC_VOLATILE 0)))

(def: class-to-type
  (-> $.Class $.Type)
  (|>> #$.Class #$.Generic))

(def: param-signature
  (-> $.Class Text)
  (|>> class-to-type $t.signature (format ":")))

(def: (formal-param [name super interfaces])
  (-> $.Parameter Text)
  (format name
          (param-signature super)
          (|> interfaces
              (list/map param-signature)
              (text.join-with ""))))

(def: (parameters-signature parameters super interfaces)
  (-> (List $.Parameter) $.Class (List $.Class)
      Text)
  (let [formal-params (if (list.empty? parameters)
                        ""
                        (format "<"
                                (|> parameters
                                    (list/map formal-param)
                                    (text.join-with ""))
                                ">"))]
    (format formal-params
            (|> super class-to-type $t.signature)
            (|> interfaces
                (list/map (|>> class-to-type $t.signature))
                (text.join-with "")))))

(def: class-computes
  Int
  ($_ i/+
      ClassWriter::COMPUTE_MAXS
      ## ClassWriter::COMPUTE_FRAMES
      ))

(do-template [<name> <flag>]
  [(def: #export (<name> version visibility config name parameters super interfaces
                         definitions)
     (-> $.Version $.Visibility $.Class-Config Text (List $.Parameter) $.Class (List $.Class) $.Def
         (host.type (Array byte)))
     (let [writer (|> (do-to (ClassWriter::new class-computes)
                        (ClassWriter::visit [(version-flag version)
                                             ($_ i/+
                                                 Opcodes::ACC_SUPER
                                                 <flag>
                                                 (visibility-flag visibility)
                                                 (class-flags config))
                                             ($t.binary-name name)
                                             (parameters-signature parameters super interfaces)
                                             (|> super product.left $t.binary-name)
                                             (|> interfaces
                                                 (list/map (|>> product.left $t.binary-name))
                                                 string-array)]))
                      definitions)
           _ (ClassWriter::visitEnd [] writer)]
       (ClassWriter::toByteArray [] writer)))]

  [class     0]
  [abstract  Opcodes::ACC_ABSTRACT]
  )

(def: $Object $.Class ["java.lang.Object" (list)])

(def: #export (interface version visibility config name parameters interfaces
                         definitions)
  (-> $.Version $.Visibility $.Class-Config Text (List $.Parameter) (List $.Class) $.Def
      (host.type (Array byte)))
  (let [writer (|> (do-to (ClassWriter::new class-computes)
                     (ClassWriter::visit [(version-flag version)
                                          ($_ i/+
                                              Opcodes::ACC_SUPER
                                              Opcodes::ACC_INTERFACE
                                              (visibility-flag visibility)
                                              (class-flags config))
                                          ($t.binary-name name)
                                          (parameters-signature parameters $Object interfaces)
                                          (|> $Object product.left $t.binary-name)
                                          (|> interfaces
                                              (list/map (|>> product.left $t.binary-name))
                                              string-array)]))
                   definitions)
        _ (ClassWriter::visitEnd [] writer)]
    (ClassWriter::toByteArray [] writer)))

(def: #export (method visibility config name type then)
  (-> $.Visibility $.Method-Config Text $.Method $.Inst
      $.Def)
  (function (_ writer)
    (let [=method (ClassWriter::visitMethod [($_ i/+
                                                 (visibility-flag visibility)
                                                 (method-flags config))
                                             ($t.binary-name name)
                                             ($t.method-descriptor type)
                                             ($t.method-signature type)
                                             (exceptions-array type)]
                                            writer)
          _ (MethodVisitor::visitCode [] =method)
          _ (then =method)
          _ (MethodVisitor::visitMaxs [0 0] =method)
          _ (MethodVisitor::visitEnd [] =method)]
      writer)))

(def: #export (abstract-method visibility config name type)
  (-> $.Visibility $.Method-Config Text $.Method
      $.Def)
  (function (_ writer)
    (let [=method (ClassWriter::visitMethod [($_ i/+
                                                 (visibility-flag visibility)
                                                 (method-flags config)
                                                 Opcodes::ACC_ABSTRACT)
                                             ($t.binary-name name)
                                             ($t.method-descriptor type)
                                             ($t.method-signature type)
                                             (exceptions-array type)]
                                            writer)
          _ (MethodVisitor::visitEnd [] =method)]
      writer)))

(def: #export (field visibility config name type)
  (-> $.Visibility $.Field-Config Text $.Type $.Def)
  (function (_ writer)
    (let [=field (do-to (ClassWriter::visitField [($_ i/+
                                                      (visibility-flag visibility)
                                                      (field-flags config))
                                                  ($t.binary-name name)
                                                  ($t.descriptor type)
                                                  ($t.signature type)
                                                  (host.null)] writer)
                   (FieldVisitor::visitEnd []))]
      writer)))

(do-template [<name> <lux-type> <jvm-type> <prepare>]
  [(def: #export (<name> visibility config name value)
     (-> $.Visibility $.Field-Config Text <lux-type> $.Def)
     (function (_ writer)
       (let [=field (do-to (ClassWriter::visitField [($_ i/+
                                                         (visibility-flag visibility)
                                                         (field-flags config))
                                                     ($t.binary-name name)
                                                     ($t.descriptor <jvm-type>)
                                                     ($t.signature <jvm-type>)
                                                     (<prepare> value)]
                                                    writer)
                      (FieldVisitor::visitEnd []))]
         writer)))]

  [boolean-field Bool $t.boolean id]
  [byte-field    Int  $t.byte    host.long-to-byte]
  [short-field   Int  $t.short   host.long-to-short]
  [int-field     Int  $t.int     host.long-to-int]
  [long-field    Int  $t.long    id]
  [float-field   Frac $t.float   host.double-to-float]
  [double-field  Frac $t.double  id]
  [char-field    Nat  $t.char    (|>> .int host.long-to-int host.int-to-char)]
  [string-field  Text ($t.class "java.lang.String" (list)) id]
  )

(def: #export (fuse defs)
  (-> (List $.Def) $.Def)
  (case defs
    #.Nil
    id

    (#.Cons singleton #.Nil)
    singleton

    (#.Cons head tail)
    (function.compose (fuse tail) head)))