... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.

(.using
 [library
  [lux (.except)
   [abstract
    ["[0]" monad]]
   [error
    ["[0]" try (.use "[1]#[0]" functor)]
    ["[0]" exception]]
   [data
    ["[0]" any]
    ["[0]" product]
    ["[0]" text]
    [collection
     ["[0]" list (.use "[1]#[0]" functor monoid)]
     ["[0]" stack (.use "[1]#[0]" functor)]
     ["[0]" set]]]
   [math
    ["[0]" random (.only Random)]
    [number
     [/64
      ["n" natural]]]]
   [macro
    ["[0]" expansion]
    ["[0]" template]]
   ["[0]" type]
   [test
    ["_" property (.only Test)]]
   [compiler
    [language
     [lux
      ["[0]" analysis]
      ["[0]" phase]]]]
   [aspect
    ["[0]" view]]]]
 [\\library
  ["[0]" / (.only)
   ["[0]" // (.use "[1]#[0]" functor)
    ["[0]" static]
    ["[0]" name]
    ["[0]" code]
    ["[0]" provenance]]]])

(expansion.let [,label_0 (static.random_natural)
                ,label_1 (static.random_integer)
                
                ,tag_0 (template.name ["tag_" ,label_0])
                ,tag_1 (template.name ["tag_" ,label_1])
                ,tag_2 (template.name ["tag_" ,label_2])
                
                ,slot_0 (template.name ["slot_" ,label_0])
                ,slot_1 (template.name ["slot_" ,label_1])
                ,slot_2 (template.name ["slot_" ,label_2])

                ,type_0 (template.name ["type_" ,label_0])
                ,type_1 (template.name ["type_" ,label_1])]
  (these (every ,type_0
           (Variant
            {,tag_0 Bit}
            {,tag_1 Natural}))

         (every ,type_1
           (Record
            [,slot_0 Bit
             ,slot_1 Natural]))

         (the (as_name it)
           (-> Name
               Code)
           (` (.name (, (code.name it)))))

         (the singular
           Test
           (<| (_.for [.Label])
               (`` (all _.and
                        (,, (template.with [,type ,query ,0 ,1 ,other ,2
                                            ,cannot_access ,beyond_access ,not_a ,unknown]
                              [(_.coverage [,type ,query]
                                 (and (static.expansion
                                       (monad.let //.monad
                                         [it (,query (name ,0))]
                                         (pure (list (code.bit (same? (as (-> ,type Label) ,0) it))))))
                                      (static.expansion
                                       (monad.let //.monad
                                         [it (,query (name ,1))]
                                         (pure (list (code.bit (same? (as (-> ,type Label) ,1) it))))))))
                               (_.coverage [,cannot_access]
                                 (static.expansion
                                  (monad.let //.monad
                                    [it (<| phase.try
                                            (,query (name ,beyond_access)))]
                                    (pure (list (code.bit (when it
                                                            {try.#Failure error}
                                                            (text.contains? (its exception.#label ,cannot_access) error)

                                                            else
                                                            false)))))))
                               (_.coverage [,not_a]
                                 (static.expansion
                                  (monad.let //.monad
                                    [it (<| phase.try
                                            (,query (name ,other)))]
                                    (pure (list (code.bit (when it
                                                            {try.#Failure error}
                                                            (text.contains? (its exception.#label ,not_a) error)

                                                            else
                                                            false)))))))
                               (_.coverage [,unknown]
                                 (static.expansion
                                  (monad.let //.monad
                                    [it (<| phase.try
                                            (,query (name ,2)))]
                                    (pure (list (code.bit (when it
                                                            {try.#Failure error}
                                                            (text.contains? (its exception.#label ,unknown) error)

                                                            else
                                                            false)))))))]

                              [[.Tag /.tag ,tag_0 ,tag_1 ,slot_0 ,tag_2
                                /.cannot_access_tag .#pure /.not_a_tag /.unknown_tag]
                               [.Slot /.slot ,slot_0 ,slot_1 ,tag_0 ,slot_2
                                /.cannot_access_slot .#pure /.not_a_slot /.unknown_slot]]))))))

         (the plural
           Test
           (let [= (list.equivalence name.equivalence)
                 [this_module _] (name .._)]
             (`` (all _.and
                      (,, (template.with [,query ,type ,tag|slot_0 ,tag|slot_1 ,not_any]
                            [(_.coverage [,query]
                               (= (list [this_module (name.proper (name ,tag|slot_0))]
                                        [this_module (name.proper (name ,tag|slot_1))])
                                  (`` (list (,, (static.expansion
                                                 (//#each (list#each ..as_name)
                                                          (,query (name ,type)))))))))
                             (_.coverage [,not_any]
                               (static.expansion
                                (monad.let //.monad
                                  [it (<| phase.try
                                          (analysis.with_current_module .prelude)
                                          (//#each (list#each ..as_name)
                                                   (,query (name ,type_0))))]
                                  (pure (list (code.bit (when it
                                                          {try.#Failure error}
                                                          (text.contains? (its exception.#label ,not_any) error)

                                                          else
                                                          false)))))))]

                            [[/.tags ,type_0 ,tag_0 ,tag_1 /.not_any_tag]
                             [/.slots ,type_1 ,slot_0 ,slot_1 /.not_any_slot]]))
                      ))))

         (the label_related
           Test
           (monad.let [! random.monad]
             [current_module (random.upper_cased 1)
              label_module (random.upper_cased 2)

              name_0 (random.upper_cased 3)
              name_1 (random.upper_cased 4)

              .let [random_tag (by ! each (|>> [label_module])
                                   (random.upper_cased 1))
                    random_labels (is (-> Natural
                                          (Random [Text (Stack Text)]))
                                      (function (_ size)
                                        (monad.let !
                                          [head (random.lower_cased size)]
                                          (|> (random.lower_cased size)
                                              (random.only (|>> (text.= head) not))
                                              (random.set text.hash 3)
                                              (by ! each (|>> set.as_list (view.as list.stack)))
                                              (random.and (pure head))))))]
              tags_0 (random_labels 5)
              tags_1 (random_labels 6)
              .let [type_0 {.#Named [label_module name_1] {.#Nominal name_0 (list)}}
                    type_1 {.#Named [label_module name_1] {.#Nominal name_1 (list)}}

                    expected_lux
                    (is Lux
                        [.#info [.#target ""
                                 .#version ""
                                 .#mode {.#Build}
                                 .#configuration (list)]
                         .#source [provenance.dummy 0 ""]
                         .#provenance provenance.dummy
                         .#current_module {.#Some current_module}
                         .#modules (list [current_module
                                          [.#module_hash 0
                                           .#module_aliases (list)
                                           .#definitions (list)
                                           .#imports (list label_module)
                                           .#module_state {.#Active}]]
                                         [label_module
                                          [.#module_hash 0
                                           .#module_aliases (list)
                                           .#definitions (all list#composite
                                                              (list [name_0 [true {.#Definition [.Type type_0]}]]
                                                                    [name_1 [true {.#Definition [.Type type_1]}]])
                                                              (let [cohort (is (Stack Name)
                                                                               (stack#each (|>> [label_module])
                                                                                           {.#Top tags_0}))
                                                                    last (-- (stack.size cohort))
                                                                    right? (n.= last)
                                                                    lefts (is (-> Natural Natural)
                                                                              (function (_ index)
                                                                                (if (right? index)
                                                                                    (-- index)
                                                                                    index)))]
                                                                (|> {.#Top tags_0}
                                                                    (view.of list.stack)
                                                                    list.enumeration
                                                                    (list#each (function (_ [index proper])
                                                                                 [proper [true {.#Definition [.Tag
                                                                                                              (|> [{.#Some [(lefts index) (right? index) (view.of list.stack cohort)]} type_0]
                                                                                                                  (as (-> Label .Tag)))]}]]))))
                                                              (let [cohort (is (Stack Name)
                                                                               (stack#each (|>> [label_module])
                                                                                           {.#Top tags_1}))
                                                                    last (-- (stack.size cohort))
                                                                    right? (n.= last)
                                                                    lefts (is (-> Natural Natural)
                                                                              (function (_ index)
                                                                                (if (right? index)
                                                                                    (-- index)
                                                                                    index)))]
                                                                (|> {.#Top tags_1}
                                                                    (view.of list.stack)
                                                                    list.enumeration
                                                                    (list#each (function (_ [index proper])
                                                                                 [proper [true {.#Definition [.Slot
                                                                                                              (|> [{.#Some [(lefts index) (right? index) (view.of list.stack cohort)]} type_1]
                                                                                                                  (as (-> Label .Slot)))]}]])))))
                                           .#imports (list)
                                           .#module_state {.#Active}]])
                         .#scopes (stack)
                         .#type_context [.#ex_counter 0
                                         .#var_counter 0
                                         .#var_bindings (list)]
                         .#expected {.#None}
                         .#seed 0
                         .#eval (as_expected [])])]]
             (all _.and
                  (_.coverage [/.every_slot]
                    (let [equivalence (list.equivalence
                                       (product.equivalence
                                        (list.equivalence name.equivalence)
                                        type.equivalence))]
                      (|> (/.every_slot label_module)
                          (//.value expected_lux)
                          (try#each (by equivalence = (list [(list#each (|>> [label_module])
                                                                        (view.of list.stack {.#Top tags_1}))
                                                             type_1])))
                          (try.else false))))
                  )))

         (the .public test
           Test
           (<| (_.covering /._)
               (monad.let [! random.monad]
                 [])
               (all _.and
                    ..singular
                    ..plural
                    ..label_related
                    )))
         ))
