(;module:
  lux
  (lux [io]
       (control [monad #+ do]
                pipe)
       (concurrency [atom])
       (data ["e" error]
             [product]
             [maybe]
             [text "text/" Eq<Text>]
             text/format
             (coll [array]
                   [list "list/" Fold<List>]
                   [dict]))
       ["r" math/random "r/" Monad<Random>]
       [meta #+ Monad<Meta>]
       (meta [code]
             [type])
       test)
  (luxc ["&" lang]
        (lang ["&;" scope]
              ["&;" module]
              ["~" analysis]
              (analysis [";A" expression]
                        ["@;" common]
                        ["@" procedure]
                        (procedure ["@;" host]))
              (translation ["@;" runtime])
              [";L" eval]))
  (../.. common)
  (test/luxc common))

(do-template [<name> <success> <failure>]
  [(def: (<name> procedure params output-type)
     (-> Text (List Code) Type Bool)
     (|> (do Monad<Meta>
           [runtime-bytecode @runtime;translate]
           (&;with-scope
             (&;with-type output-type
               (@;analyse-procedure analyse evalL;eval procedure params))))
         (meta;run (init-compiler []))
         (case> (#e;Success _)
                <success>

                (#e;Error error)
                <failure>)))]

  [success true false]
  [failure false true]
  )

(context: "Conversions [double + float]."
  (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
                                    [(test (format <procedure> " SUCCESS")
                                           (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
                                     (test (format <procedure> " FAILURE")
                                           (failure <procedure> (list (' [])) <to>))]

                                    ["jvm convert double-to-float" "java.lang.Double" @host;Float]
                                    ["jvm convert double-to-int" "java.lang.Double" @host;Integer]
                                    ["jvm convert double-to-long" "java.lang.Double" @host;Long]
                                    ["jvm convert float-to-double" "java.lang.Float" @host;Double]
                                    ["jvm convert float-to-int" "java.lang.Float" @host;Integer]
                                    ["jvm convert float-to-long" "java.lang.Float" @host;Long]
                                    )]
    ($_ seq
        <conversions>
        )))

(context: "Conversions [int]."
  (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
                                    [(test (format <procedure> " SUCCESS")
                                           (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
                                     (test (format <procedure> " FAILURE")
                                           (failure <procedure> (list (' [])) <to>))]

                                    ["jvm convert int-to-byte" "java.lang.Integer" @host;Byte]
                                    ["jvm convert int-to-char" "java.lang.Integer" @host;Character]
                                    ["jvm convert int-to-double" "java.lang.Integer" @host;Double]
                                    ["jvm convert int-to-float" "java.lang.Integer" @host;Float]
                                    ["jvm convert int-to-long" "java.lang.Integer" @host;Long]
                                    ["jvm convert int-to-short" "java.lang.Integer" @host;Short]
                                    )]
    ($_ seq
        <conversions>
        )))

(context: "Conversions [long]."
  (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
                                    [(test (format <procedure> " SUCCESS")
                                           (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
                                     (test (format <procedure> " FAILURE")
                                           (failure <procedure> (list (' [])) <to>))]

                                    ["jvm convert long-to-double" "java.lang.Long" @host;Double]
                                    ["jvm convert long-to-float" "java.lang.Long" @host;Float]
                                    ["jvm convert long-to-int" "java.lang.Long" @host;Integer]
                                    ["jvm convert long-to-short" "java.lang.Long" @host;Short]
                                    ["jvm convert long-to-byte" "java.lang.Long" @host;Byte]
                                    )]
    ($_ seq
        <conversions>
        )))

(context: "Conversions [char + byte + short]."
  (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
                                    [(test (format <procedure> " SUCCESS")
                                           (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
                                     (test (format <procedure> " FAILURE")
                                           (failure <procedure> (list (' [])) <to>))]

                                    ["jvm convert char-to-byte" "java.lang.Character" @host;Byte]
                                    ["jvm convert char-to-short" "java.lang.Character" @host;Short]
                                    ["jvm convert char-to-int" "java.lang.Character" @host;Integer]
                                    ["jvm convert char-to-long" "java.lang.Character" @host;Long]
                                    ["jvm convert byte-to-long" "java.lang.Byte" @host;Long]
                                    ["jvm convert short-to-long" "java.lang.Short" @host;Long]
                                    )]
    ($_ seq
        <conversions>
        )))

(do-template [<domain> <boxed> <type>]
  [(context: (format "Arithmetic " "[" <domain> "].")
     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
                                        [(test <procedure>
                                               (success <procedure>
                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
                                                        <output>))]

                                        [(format "jvm " <domain> " +") <boxed> <boxed> <type>]
                                        [(format "jvm " <domain> " -") <boxed> <boxed> <type>]
                                        [(format "jvm " <domain> " *") <boxed> <boxed> <type>]
                                        [(format "jvm " <domain> " /") <boxed> <boxed> <type>]
                                        [(format "jvm " <domain> " %") <boxed> <boxed> <type>]
                                        )]
       ($_ seq
           <instructions>
           )))

   (context: (format "Order " "[" <domain> "].")
     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
                                        [(test <procedure>
                                               (success <procedure>
                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
                                                        <output>))]

                                        [(format "jvm " <domain> " =") <boxed> <boxed> @host;Boolean]
                                        [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean]
                                        )]
       ($_ seq
           <instructions>
           )))

   (context: (format "Bitwise " "[" <domain> "].")
     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
                                        [(test <procedure>
                                               (success <procedure>
                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
                                                        <output>))]

                                        [(format "jvm " <domain> " and") <boxed> <boxed> <type>]
                                        [(format "jvm " <domain> " or") <boxed> <boxed> <type>]
                                        [(format "jvm " <domain> " xor") <boxed> <boxed> <type>]
                                        [(format "jvm " <domain> " shl") <boxed> "java.lang.Integer" <type>]
                                        [(format "jvm " <domain> " shr") <boxed> "java.lang.Integer" <type>]
                                        [(format "jvm " <domain> " ushr") <boxed> "java.lang.Integer" <type>]
                                        )]
       ($_ seq
           <instructions>
           )))]


  ["int" "java.lang.Integer" @host;Integer]
  ["long" "java.lang.Long" @host;Long]
  )

(do-template [<domain> <boxed> <type>]
  [(context: (format "Arithmetic " "[" <domain> "].")
     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
                                        [(test <procedure>
                                               (success <procedure>
                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
                                                        <output>))]

                                        [(format "jvm " <domain> " +") <boxed> <boxed> <type>]
                                        [(format "jvm " <domain> " -") <boxed> <boxed> <type>]
                                        [(format "jvm " <domain> " *") <boxed> <boxed> <type>]
                                        [(format "jvm " <domain> " /") <boxed> <boxed> <type>]
                                        [(format "jvm " <domain> " %") <boxed> <boxed> <type>]
                                        )]
       ($_ seq
           <instructions>
           )))

   (context: (format "Order " "[" <domain> "].")
     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
                                        [(test <procedure>
                                               (success <procedure>
                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
                                                        <output>))]

                                        [(format "jvm " <domain> " =") <boxed> <boxed> @host;Boolean]
                                        [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean]
                                        )]
       ($_ seq
           <instructions>
           )))]


  ["float" "java.lang.Float" @host;Float]
  ["double" "java.lang.Double" @host;Double]
  )

(do-template [<domain> <boxed> <type>]
  [(context: (format "Order " "[" <domain> "].")
     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
                                        [(test <procedure>
                                               (success <procedure>
                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
                                                        <output>))]

                                        [(format "jvm " <domain> " =") <boxed> <boxed> @host;Boolean]
                                        [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean]
                                        )]
       ($_ seq
           <instructions>
           )))]


  ["char" "java.lang.Character" @host;Character]
  )

(def: array-type
  (r;Random [Text Text])
  (let [entries (dict;entries @host;boxes)
        num-entries (list;size entries)]
    (do r;Monad<Random>
      [choice (|> r;nat (:: @ map (n.% (n.inc num-entries))))
       #let [[unboxed boxed] (: [Text Text]
                                (|> entries
                                    (list;nth choice)
                                    (maybe;default ["java.lang.Object" "java.lang.Object"])))]]
      (wrap [unboxed boxed]))))

(context: "Array."
  (<| (times +100)
      (do @
        [#let [cap (|>. (n.% +10) (n.max +1))]
         [unboxed boxed] array-type
         size (|> r;nat (:: @ map cap))
         idx (|> r;nat (:: @ map (n.% size)))
         level (|> r;nat (:: @ map cap))
         #let [unboxedT (#;Primitive unboxed (list))
               arrayT (#;Primitive "#Array" (list unboxedT))
               arrayC (`' ("lux check" (+0 "#Array" (+1 (+0 (~ (code;text unboxed)) (+0)) (+0)))
                           ("jvm array new" (~ (code;nat size)))))
               boxedT (#;Primitive boxed (list))
               boxedTC (` (+0 (~ (code;text boxed)) (+0)))
               multi-arrayT (list/fold (function [_ innerT]
                                         (|> innerT (list) (#;Primitive "#Array")))
                                       boxedT
                                       (list;n.range +1 level))]]
        ($_ seq
            (test "jvm array new"
                  (success "jvm array new"
                           (list (code;nat size))
                           arrayT))
            (test "jvm array new (no nesting)"
                  (failure "jvm array new"
                           (list (code;nat size))
                           unboxedT))
            (test "jvm array new (nested/multi-level)"
                  (success "jvm array new"
                           (list (code;nat size))
                           multi-arrayT))
            (test "jvm array length"
                  (success "jvm array length"
                           (list arrayC)
                           Nat))
            (test "jvm array read"
                  (success "jvm array read"
                           (list arrayC (code;nat idx))
                           boxedT))
            (test "jvm array write"
                  (success "jvm array write"
                           (list arrayC (code;nat idx) (`' ("lux coerce" (~ boxedTC) [])))
                           arrayT))
            ))))

(def: throwables
  (List Text)
  (list "java.lang.Throwable"
        "java.lang.Error"
        "java.io.IOError"
        "java.lang.VirtualMachineError"
        "java.lang.Exception"
        "java.io.IOException"
        "java.lang.RuntimeException"))

(context: "Object."
  (<| (times +100)
      (do @
        [[unboxed boxed] array-type
         [!unboxed !boxed] (|> array-type
                               (r;filter (function [[!unboxed !boxed]]
                                           (not (text/= boxed !boxed)))))
         #let [boxedT (#;Primitive boxed (list))
               boxedC (`' ("lux check" (+0 (~ (code;text boxed)) (+0))
                           ("jvm object null")))
               !boxedC (`' ("lux check" (+0 (~ (code;text !boxed)) (+0))
                            ("jvm object null")))
               unboxedC (`' ("lux check" (+0 (~ (code;text unboxed)) (+0))
                             ("jvm object null")))]
         throwable (|> r;nat
                       (:: @ map (n.% (n.inc (list;size throwables))))
                       (:: @ map (function [idx]
                                   (|> throwables
                                       (list;nth idx)
                                       (maybe;default "java.lang.Object")))))
         #let [throwableC (`' ("lux check" (+0 (~ (code;text throwable)) (+0))
                               ("jvm object null")))]]
        ($_ seq
            (test "jvm object null"
                  (success "jvm object null"
                           (list)
                           (#;Primitive boxed (list))))
            (test "jvm object null (no primitives)"
                  (or (text/= "java.lang.Object" boxed)
                      (failure "jvm object null"
                               (list)
                               (#;Primitive unboxed (list)))))
            (test "jvm object null?"
                  (success "jvm object null?"
                           (list boxedC)
                           Bool))
            (test "jvm object synchronized"
                  (success "jvm object synchronized"
                           (list boxedC boxedC)
                           boxedT))
            (test "jvm object synchronized (no primitives)"
                  (or (text/= "java.lang.Object" boxed)
                      (failure "jvm object synchronized"
                               (list unboxedC boxedC)
                               boxedT)))
            (test "jvm object throw"
                  (or (text/= "java.lang.Object" throwable)
                      (success "jvm object throw"
                               (list throwableC)
                               Bottom)))
            (test "jvm object class"
                  (success "jvm object class"
                           (list (code;text boxed))
                           (#;Primitive "java.lang.Class" (list boxedT))))
            (test "jvm object instance?"
                  (success "jvm object instance?"
                           (list (code;text boxed)
                                 boxedC)
                           Bool))
            (test "jvm object instance? (lineage)"
                  (success "jvm object instance?"
                           (list (' "java.lang.Object")
                                 boxedC)
                           Bool))
            (test "jvm object instance? (no lineage)"
                  (or (text/= "java.lang.Object" boxed)
                      (failure "jvm object instance?"
                               (list (code;text boxed)
                                     !boxedC)
                               Bool)))
            ))))

(context: "Member [Static Field]."
  ($_ seq
      (test "jvm member static get"
            (success "jvm member static get"
                     (list (code;text "java.lang.System")
                           (code;text "out"))
                     (#;Primitive "java.io.PrintStream" (list))))
      (test "jvm member static get (inheritance out)"
            (success "jvm member static get"
                     (list (code;text "java.lang.System")
                           (code;text "out"))
                     (#;Primitive "java.lang.Object" (list))))
      (test "jvm member static put"
            (success "jvm member static put"
                     (list (code;text "java.awt.datatransfer.DataFlavor")
                           (code;text "allHtmlFlavor")
                           (`' ("lux check" (+0 "java.awt.datatransfer.DataFlavor" (+0))
                                ("jvm object null"))))
                     Unit))
      (test "jvm member static put (final)"
            (failure "jvm member static put"
                     (list (code;text "java.lang.System")
                           (code;text "out")
                           (`' ("lux check" (+0 "java.io.PrintStream" (+0))
                                ("jvm object null"))))
                     Unit))
      (test "jvm member static put (inheritance in)"
            (success "jvm member static put"
                     (list (code;text "java.awt.datatransfer.DataFlavor")
                           (code;text "allHtmlFlavor")
                           (`' ("lux check" (+0 "javax.activation.ActivationDataFlavor" (+0))
                                ("jvm object null"))))
                     Unit))
      ))

(context: "Member [Virtual Field]."
  ($_ seq
      (test "jvm member virtual get"
            (success "jvm member virtual get"
                     (list (code;text "org.omg.CORBA.ValueMember")
                           (code;text "id")
                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
                                ("jvm object null"))))
                     (#;Primitive "java.lang.String" (list))))
      (test "jvm member virtual get (inheritance out)"
            (success "jvm member virtual get"
                     (list (code;text "org.omg.CORBA.ValueMember")
                           (code;text "id")
                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
                                ("jvm object null"))))
                     (#;Primitive "java.lang.Object" (list))))
      (test "jvm member virtual put"
            (success "jvm member virtual put"
                     (list (code;text "org.omg.CORBA.ValueMember")
                           (code;text "id")
                           (`' ("lux check" (+0 "java.lang.String" (+0))
                                ("jvm object null")))
                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
                                ("jvm object null"))))
                     (primitive org.omg.CORBA.ValueMember)))
      (test "jvm member virtual put (final)"
            (failure "jvm member virtual put"
                     (list (code;text "javax.swing.text.html.parser.DTD")
                           (code;text "applet")
                           (`' ("lux check" (+0 "javax.swing.text.html.parser.Element" (+0))
                                ("jvm object null")))
                           (`' ("lux check" (+0 "javax.swing.text.html.parser.DTD" (+0))
                                ("jvm object null"))))
                     (primitive javax.swing.text.html.parser.DTD)))
      (test "jvm member virtual put (inheritance in)"
            (success "jvm member virtual put"
                     (list (code;text "java.awt.GridBagConstraints")
                           (code;text "insets")
                           (`' ("lux check" (+0 "javax.swing.plaf.InsetsUIResource" (+0))
                                ("jvm object null")))
                           (`' ("lux check" (+0 "java.awt.GridBagConstraints" (+0))
                                ("jvm object null"))))
                     (primitive java.awt.GridBagConstraints)))
      ))

(context: "Boxing/Unboxing."
  ($_ seq
      (test "jvm member static get"
            (success "jvm member static get"
                     (list (code;text "java.util.GregorianCalendar")
                           (code;text "AD"))
                     (#;Primitive "java.lang.Integer" (list))))
      (test "jvm member virtual get"
            (success "jvm member virtual get"
                     (list (code;text "javax.accessibility.AccessibleAttributeSequence")
                           (code;text "startIndex")
                           (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0))
                                ("jvm object null"))))
                     (#;Primitive "java.lang.Integer" (list))))
      (test "jvm member virtual put"
            (success "jvm member virtual put"
                     (list (code;text "javax.accessibility.AccessibleAttributeSequence")
                           (code;text "startIndex")
                           (`' ("lux check" (+0 "java.lang.Integer" (+0))
                                ("jvm object null")))
                           (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0))
                                ("jvm object null"))))
                     (primitive javax.accessibility.AccessibleAttributeSequence)))
      ))

(context: "Member [Method]."
  (let [longC (' ("lux coerce" (+0 "java.lang.Long" (+0))
                  +123))
        intC (`' ("jvm convert long-to-int" (~ longC)))
        objectC (`' ("lux check" (+0 "java.util.ArrayList" (+1 (+0 "java.lang.Long" (+0)) (+0)))
                     ("jvm member invoke constructor" "java.util.ArrayList"
                      ["int" (~ intC)])))]
    ($_ seq
        (test "jvm member invoke static"
              (success "jvm member invoke static"
                       (list (code;text "java.lang.Long")
                             (code;text "decode")
                             (code;tuple (list (' "java.lang.String")
                                               (' ("lux coerce" (+0 "java.lang.String" (+0))
                                                   "YOLO")))))
                       (#;Primitive "java.lang.Long" (list))))
        (test "jvm member invoke virtual"
              (success "jvm member invoke virtual"
                       (list (code;text "java.lang.Object")
                             (code;text "equals")
                             longC
                             (code;tuple (list (' "java.lang.Object")
                                               longC)))
                       (#;Primitive "java.lang.Boolean" (list))))
        (test "jvm member invoke special"
              (success "jvm member invoke special"
                       (list (code;text "java.lang.Long")
                             (code;text "equals")
                             longC
                             (code;tuple (list (' "java.lang.Object")
                                               longC)))
                       (#;Primitive "java.lang.Boolean" (list))))
        (test "jvm member invoke interface"
              (success "jvm member invoke interface"
                       (list (code;text "java.util.Collection")
                             (code;text "add")
                             objectC
                             (code;tuple (list (' "java.lang.Object")
                                               longC)))
                       (#;Primitive "java.lang.Boolean" (list))))
        (test "jvm member invoke constructor"
              (success "jvm member invoke constructor"
                       (list (code;text "java.util.ArrayList")
                             (code;tuple (list (' "int") intC)))
                       (All [a] (#;Primitive "java.util.ArrayList" (list a)))))
        )))