(.module:
  lux
  (lux [io #+ IO]
       (control [monad #+ do]
                pipe)
       (data ["e" error]
             text/format
             [number]
             (coll [list "list/" Functor<List>]
                   [set]))
       [math]
       ["r" math/random]
       (macro [code])
       test)
  (luxc (lang [synthesis #+ Synthesis]))
  (test/luxc common))

(def: upper-alpha-ascii
  (r.Random Nat)
  (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65)))))

(def: (test-primitive-identity synthesis)
  (-> Synthesis Bool)
  (|> (run-js (` ("lux is" (~ synthesis) (~ synthesis))))
      (case> (#e.Success valueV)
             (:! Bool valueV)

             _
             false)))

(type: Check (-> (e.Error Top) Bool))

(do-template [<name> <type> <pre> <=>]
  [(def: (<name> angle)
     (-> <type> Check)
     (|>> (case> (#e.Success valueV)
                 (<=> (<pre> angle) (:! <type> valueV))
                 
                 (#e.Error error)
                 false)))]

  [sin-check    Frac math.sin f/=]
  [length-check Nat  id       n/=]
  )

(context: "[JS] Primitives."
  ($_ seq
      (test "Null is equal to itself."
            (test-primitive-identity (` ("js null"))))
      (test "Undefined is equal to itself."
            (test-primitive-identity (` ("js undefined"))))
      (test "Object comparison is by reference, not by value."
            (not (test-primitive-identity (` ("js object")))))
      (test "Values are equal to themselves."
            (test-primitive-identity (` ("js global" "Math"))))
      (<| (times +100)
          (do @
            [value r.int
             #let [frac-value (int-to-frac value)]]
            (test "Can call primitive functions."
                  (|> (run-js (` ("js call" ("js global" "Math.sin") (~ (code.text (%f frac-value))))))
                      (sin-check frac-value)))))
      ))

(context: "[JS] Objects."
  (<| (times +100)
      (do @
        [field (:: @ map code.text (r.text' upper-alpha-ascii +5))
         value r.int
         #let [empty-object (` ("js object"))
               object (` ("js object set" (~ field) (~ (code.int value)) (~ empty-object)))
               frac-value (int-to-frac value)]]
        ($_ seq
            (test "Cannot get non-existing fields from objects."
                  (|> (run-js (` ("js object get" (~ field) (~ empty-object))))
                      (case> (^multi (#e.Success valueV)
                                     [(:! (Maybe Int) valueV) #.None])
                             true

                             _
                             false)))
            (test "Can get fields from objects."
                  (|> (run-js (` ("js object get" (~ field) (~ object))))
                      (case> (^multi (#e.Success valueV)
                                     [(:! (Maybe Int) valueV) (#.Some valueV)])
                             (i/= value (:! Int valueV))

                             _
                             false)))
            (test "Can delete fields from objects."
                  (|> (run-js (let [post-delete (` ("js object delete" (~ field) (~ object)))]
                                (` ("js object get" (~ field) (~ post-delete)))))
                      (case> (^multi (#e.Success valueV)
                                     [(:! (Maybe Int) valueV) #.None])
                             true

                             _
                             false)))
            (test "Can instance new objects."
                  (let [base (` ("js object new" ("js global" "Number") (~ (code.text (%f frac-value)))))]
                    (|> (run-js (` ("lux frac +" (~ base) 0.0)))
                        (case> (#e.Success valueV)
                               (f/= frac-value (:! Frac valueV))

                               (#e.Error error)
                               false))))
            (test "Can call methods on objects."
                  (|> (run-js (` ("js object call" ("js global" "Math") "sin" (~ (code.text (%f frac-value))))))
                      (sin-check frac-value)))
            ))))

(context: "[JS] Arrays."
  (<| (times +100)
      (do @
        [length (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
         idx (|> r.nat (:: @ map (n/% length)))
         overwrite r.nat
         elems (|> (r.set number.Hash<Nat> length r.nat)
                   (:: @ map set.to-list))
         #let [arrayS (` ("js array literal" (~+ (list/map code.nat elems))))]]
        ($_ seq
            (test "Can get the length of an array."
                  (|> (run-js (` ("js array length" (~ arrayS))))
                      (length-check length)))
            (test "Can get an element from an array."
                  (|> (run-js (` ("js array read" (~ (code.nat idx)) (~ arrayS))))
                      (case> (^multi (#e.Success elemV)
                                     [[(list.nth idx elems) (:! (Maybe Nat) elemV)]
                                      [(#.Some reference) (#.Some sample)]])
                             (n/= reference sample)

                             _
                             false)))
            (test "Can write an element into an array."
                  (let [idxS (code.nat idx)
                        overwriteS (code.nat overwrite)]
                    (|> (run-js (` ("js array read" (~ idxS)
                                    ("js array write" (~ idxS) (~ overwriteS) (~ arrayS)))))
                        (case> (^multi (#e.Success elemV)
                                       [(:! (Maybe Nat) elemV)
                                        (#.Some sample)])
                               (n/= overwrite sample)

                               _
                               false))))
            (test "Can delete an element from an array."
                  (let [idxS (code.nat idx)
                        deleteS (` ("js array delete" (~ idxS) (~ arrayS)))]
                    (and (|> (run-js (` ("js array length" (~ deleteS))))
                             (length-check length))
                         (|> (run-js (` ("js array read" (~ idxS) (~ deleteS))))
                             (case> (^multi (#e.Success elemV)
                                            [(:! (Maybe Nat) elemV)
                                             #.None])
                                    true

                                    _
                                    false))
                         )))
            ))))