path: root/licentia/source/test/licentia.lux

(.require
 [library
  [lux (.except)
   [program (.only program)]
   [abstract
    [monad (.only do)]]
   [control
    ["[0]" io]
    ["[0]" maybe (.use "[1]#[0]" functor)]]
   [data
    ["[0]" bit (.use "[1]#[0]" equivalence)]
    ["[0]" text]
    [collection
     ["[0]" list (.use "[1]#[0]" functor)]]]
   [math
    ["[0]" random (.only Random)]
    [number
     ["n" nat (.use "[1]#[0]" interval)]]]
   [test
    ["_" property (.only Test)]]]]
 [\\program
  ["[0]" output]
  ["[0]" license (.only Identification
                        Termination
                        Liability
                        Distribution
                        Commercial
                        Extension
                        Entity Black_List
                        URL Attribution
                        Addendum
                        License)
   ["[0]" time (.only Period)]
   ["[0]" copyright]
   ["[0]" notice]
   ["[0]" definition]
   ["[0]" grant]
   ["[0]" limitation]
   ["[0]" submission]
   ["[0]" liability]
   ["[0]" distribution]
   ["[0]" commercial]
   ["[0]" extension]
   ["[0]" miscellaneous]
   ["[0]" black_list]
   ["[0]" addendum]]])

(def period
  (Random (Period Nat))
  (do [! random.monad]
    [start (random.filter (|>> (n.= n#top) not)
                          random.nat)
     #let [wiggle_room (n.- start n#top)]
     end (at ! each
             (|>> (n.% wiggle_room) (n.max 1))
             random.nat)]
    (wrap [time.#start start
           time.#end end])))

(def copyright_holder
  (Random copyright.Holder)
  (all random.and
       (random.ascii 10)
       ..period))

(def identification
  (Random Identification)
  (all random.and
       (random.ascii 10)
       (random.ascii 10)))

(def termination
  (Random Termination)
  (all random.and
       random.bit
       random.nat
       random.nat))

(def liability
  (Random Liability)
  (all random.and
       random.bit
       random.bit))

(def distribution
  (Random Distribution)
  (all random.and
       random.bit
       random.bit))

(def commercial
  (Random Commercial)
  (all random.and
       random.bit
       random.bit
       random.bit))

(def extension
  (Random Extension)
  (all random.and
       random.bit
       random.bit
       (random.maybe ..period)
       random.bit))

(def entity
  (Random Entity)
  (random.ascii 10))

(def (variable_list max_size gen_element)
  (All (_ a) (-> Nat (Random a) (Random (List a))))
  (do [! random.monad]
    [amount (at ! each (n.% (n.max 1 max_size))
                random.nat)]
    (random.list amount gen_element)))

(def black_list
  (Random Black_List)
  (all random.and
       (random.maybe (random.ascii 10))
       (variable_list 10 ..entity)))

(def url
  (Random URL)
  (random.ascii 10))

(def attribution
  (Random Attribution)
  (all random.and
       (random.ascii 10)
       (random.maybe (random.ascii 10))
       ..url
       (random.maybe ..url)))

(def addendum
  (Random Addendum)
  (all random.and
       random.bit
       ))

(def license
  (Random License)
  (all random.and
       (random.list 2 ..copyright_holder)
       (random.maybe ..identification)
       ..termination
       ..liability
       ..distribution
       ..commercial
       ..extension
       (variable_list 3 ..black_list)
       (random.maybe attribution)
       ..addendum
       ))

(type (Concern a)
  (-> (-> Text Bit) a Test))

(def (about_grant present? termination)
  (Concern Termination)
  (all _.and
       (_.test "Copyright grant is present."
         (present? grant.copyright))
       (_.test "Patent grant is present."
         (present? (grant.patent (the license.#patent_retaliation? termination))))
       (_.test "Effective date for the grants is present."
         (present? grant.date))
       (_.test "Patent grant is present."
         (present? (grant.termination (the license.#termination_period termination)
                                      (the license.#grace_period termination))))
       (_.test "The termination period is accurately conveyed."
         (present? (grant.grant_restoration_clause (the license.#termination_period termination))))
       (_.test "The grace period is accurately conveyed."
         (present? (grant.grace_period_clause (the license.#grace_period termination))))
       (_.test "The grants are not retro-actively terminated."
         (present? grant.no_retroactive_termination))
       ))

(def (about_liability present? liability)
  (Concern Liability)
  (all _.and
       (_.test "Warranty liability disclaimer is present."
         (present? liability.warranty))
       (_.test "Limitation of liability is present."
         (present? liability.limitation))
       (_.test "Litigation conditions are present."
         (present? liability.litigation))
       (_.test "Liability acceptance conditions may be present."
         (bit#= (the license.#can_accept? liability)
                (present? liability.can_accept)))
       (_.test "Liability acceptance conditions may be present."
         (bit#= (the license.#disclaim_high_risk? liability)
                (present? liability.disclaim_high_risk)))
       ))

(def (about_distribution present? distribution)
  (Concern Distribution)
  (all _.and
       (_.test "Conditions for source-code distribution are present."
         (present? distribution.source_code_form))
       (_.test "Conditions for object-code distribution are present."
         (present? distribution.object_form))
       (_.test "Conditions for extension distribution are present."
         (present? (distribution.extension distribution)))
       ))

(def (about_commercial present? commercial)
  (Concern Commercial)
  (all _.and
       (_.test "Non-commercial clause is present."
         (bit#= (not (the license.#can_sell? commercial))
                (present? commercial.cannot_sell)))
       (_.test "Contributor credit condition is present."
         (bit#= (the license.#require_contributor_credit? commercial)
                (present? commercial.require_contributor_attribution)))
       (_.test "Anti-endorsement condition is present."
         (bit#= (not (the license.#allow_contributor_endorsement? commercial))
                (present? commercial.disallow_contributor_endorsement)))
       ))

(def (about_extension present? extension)
  (Concern Extension)
  (all _.and
       (_.test "The license is viral."
         (bit#= (the license.#same_license? extension)
                (and (list.every? present? extension.sharing_requirement)
                     (list.every? present? extension.license_conflict_resolution))))
       (_.test "Extensions must be distinguishable from the original work."
         (bit#= (the license.#must_be_distinguishable? extension)
                (present? extension.distinctness_requirement)))
       (_.test "The community must be notified of new extensions."
         (when (the license.#notification_period extension)
           {.#Some period}
           (present? (extension.notification_requirement period))

           {.#None}
           true))
       (_.test "Must describe modifications."
         (bit#= (the license.#must_describe_modifications? extension)
                (present? extension.description_requirement)))
       ))

(def (about_attribution present? attribution)
  (Concern Attribution)
  (all _.and
       (_.test "The attribution copyright notice is present."
         (present? (the license.#copyright_notice attribution)))
       (_.test "The attribution phrase is present."
         (|> attribution
             (the license.#phrase)
             (maybe#each present?)
             (maybe.default true)))
       (_.test "The attribution URL is present."
         (present? (the license.#url attribution)))
       (_.test "The attribution image is present."
         (|> attribution
             (the license.#image)
             (maybe#each present?)
             (maybe.default true)))
       ))

(def (about_miscellaneous present?)
  (-> (-> Text Bit) Test)
  (all _.and
       (_.test "License constitutes the entire agreement."
         (present? miscellaneous.entire_agreement))
       (_.test "Disclaims relationship of parties."
         (present? miscellaneous.relationship_of_parties))
       (_.test "Explicitly allows independent development."
         (present? miscellaneous.independent_development))
       (_.test "Clarifies consent to breach does not waiver."
         (present? miscellaneous.not_waiver))
       (_.test "Provides severability."
         (present? miscellaneous.severability))
       (_.test "Covers export restrictions."
         (present? miscellaneous.export_restrictions))
       ))

(def (about_addendum present? value)
  (Concern Addendum)
  (all _.and
       (_.test "Commons clause"
         (bit#= (the license.#commons_clause? value)
                (present? addendum.commons_clause)))
       ))

(def test
  Test
  (do random.monad
    [license ..license
     #let [writ (output.license license)
           present? (is (-> Text Bit)
                        (function (_ snippet)
                          (text.contains? snippet writ)))]]
    (all _.and
         (_.test "Copyright notices are present."
           (list.every? (|>> notice.copyright_holder present?)
                        (the license.#copyright_holders license)))
         
         (_.test "Identification is present (if the license is identified)."
           (when (the license.#identification license)
             {.#Some identification}
             (and (present? (output.identification identification))
                  (present? miscellaneous.new_versions))

             {.#None}
             (not (present? miscellaneous.new_versions))))

         (_.test "Black-lists (if wanted by licensor) are explicitly enumerated and justified."
           (list.every? (function (_ black_list)
                          (let [black_list_is_justified? (when (the license.#justification black_list)
                                                           {.#Some justification}
                                                           (present? justification)

                                                           {.#None}
                                                           bit.yes)
                                every_entity_is_mentioned? (|> black_list
                                                               (the license.#entities)
                                                               (list#each black_list.entity)
                                                               (list.every? present?))]
                            (and black_list_is_justified?
                                 every_entity_is_mentioned?)))
                        (the license.#black_lists license)))
         
         (_.test "All definitions are present."
           (list.every? (|>> output.definition present?)
                        definition.all))

         (_.test "Acceptance of the license is demanded."
           (present? limitation.acceptance))
         
         (..about_grant present? (the license.#termination license))
         
         (_.test "All limitations are present."
           (present? output.limitation))
         
         (_.test "All assurances are present."
           (present? output.assurance))
         
         (_.test "The terms of submission are present."
           (present? submission.contribution))
         
         (..about_liability present? (the license.#liability license))

         (..about_distribution present? (the license.#distribution license))

         (..about_commercial present? (the license.#commercial license))

         (..about_extension present? (the license.#extension license))

         (when (the license.#attribution license)
           {.#Some attribution}
           (..about_attribution present? attribution)

           {.#None}
           (_.test "Attribution is missing."
             bit.yes))

         (..about_miscellaneous present?)

         (..about_addendum present? (the license.#addendum license))

         (_.test "License ending footer is present."
           (present? notice.end_of_license))
         )))

(def _
  (program args
    (<| io.io
        _.run!
        (_.times 100)
        ..test)))