(.module:
  [lux #*
   function]
  [//
   [functor (#+ Contravariant)]
   ["." equivalence (#+ Equivalence)]])

(`` (signature: #export (Order a)
      {#.doc "A signature for types that possess some sense of ordering among their elements."}
      
      (: (Equivalence a)
         &equivalence)
      
      (~~ (template [<name>]
            [(: (-> a a Bit) <name>)]

            [<] [<=] [>] [>=]
            ))
      ))

(def: #export (order equivalence <)
  (All [a]
    (-> (Equivalence a) (-> a a Bit) (Order a)))
  (let [> (flip <)]
    (structure (def: &equivalence equivalence)
               
               (def: < <)
               
               (def: (<= test subject)
                 (or (< test subject)
                     (:: equivalence = test subject)))
               
               (def: > >)
               
               (def: (>= test subject)
                 (or (> test subject)
                     (:: equivalence = test subject))))))

(template [<name> <op>]
  [(def: #export (<name> order x y)
     (All [a]
       (-> (Order a) a a a))
     (if (:: order <op> y x) x y))]

  [min <]
  [max >]
  )

(`` (structure: #export contravariant (Contravariant Order)
      (def: (map-1 f order)
        (structure
         (def: &equivalence (:: equivalence.contravariant map-1 f (:: order &equivalence)))
         
         (~~ (template [<name>]
               [(def: (<name> reference sample)
                  (:: order <name> (f reference) (f sample)))]

               [<] [<=] [>] [>=]
               ))))))