(.using
 [library
  [lux "*"
   ["_" test {"+" Test}]
   [abstract
    [monad {"+" do}]
    ["[0]" order]
    [\\specification
     ["$[0]" equivalence]]]
   [control
    ["[0]" pipe]]
   [data
    [collection
     ["[0]" set]
     ["[0]" list]]]
   [math
    ["[0]" random {"+" Random}]
    [number
     ["n" nat]]]]]
 [\\library
  ["[0]" / {"+" Interval} ("#[0]" equivalence)]])

(template [<name> <cmp>]
  [(def: .public <name>
     (Random (Interval Nat))
     (do random.monad
       [bottom random.nat
        top (random.only (|>> (n.= bottom) not)
                         random.nat)]
       (if (<cmp> top bottom)
         (in (/.between n.enum bottom top))
         (in (/.between n.enum top bottom)))))]

  [inner n.<]
  [outer n.>]
  )

(def: .public singleton
  (Random (Interval Nat))
  (do random.monad
    [point random.nat]
    (in (/.singleton n.enum point))))

(def: .public interval
  (Random (Interval Nat))
  (all random.either
       ..inner
       ..outer
       ..singleton))

(def: types
  Test
  (do random.monad
    [inner ..inner
     outer ..outer
     singleton ..singleton]
    (all _.and
         (_.coverage [/.inner?]
           (/.inner? inner))
         (_.coverage [/.outer?]
           (/.outer? outer))
         (_.coverage [/.singleton /.singleton?]
           (/.singleton? singleton))
         )))

(def: boundaries
  Test
  (do random.monad
    [bottom random.nat
     top random.nat
     .let [interval (/.between n.enum bottom top)]]
    (all _.and
         (_.coverage [/.between /.within?]
           (and (/.within? interval bottom)
                (/.within? interval top)))
         (_.coverage [/.starts_with?]
           (/.starts_with? bottom interval))
         (_.coverage [/.ends_with?]
           (/.ends_with? top interval))
         (_.coverage [/.borders?]
           (and (/.borders? interval bottom)
                (/.borders? interval top)))
         )))

(def: union
  Test
  (do random.monad
    [some_interval ..interval
     left_inner ..inner
     right_inner ..inner
     left_singleton ..singleton
     right_singleton ..singleton
     left_outer ..outer
     right_outer ..outer]
    (all _.and
         (_.property "The union of an interval to itself yields the same interval."
           (#= some_interval (/.union some_interval some_interval)))
         (_.property "The union of 2 inner intervals is another inner interval."
           (/.inner? (/.union left_inner right_inner)))
         (_.property "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do."
           (if (/.overlaps? (/.complement left_outer) (/.complement right_outer))
             (/.outer? (/.union left_outer right_outer))
             (/.inner? (/.union left_outer right_outer))))
         )))

(def: intersection
  Test
  (do random.monad
    [some_interval ..interval
     left_inner ..inner
     right_inner ..inner
     left_singleton ..singleton
     right_singleton ..singleton
     left_outer ..outer
     right_outer ..outer]
    (all _.and
         (_.property "The intersection of an interval to itself yields the same interval."
           (#= some_interval (/.intersection some_interval some_interval)))
         (_.property "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't."
           (if (/.overlaps? left_inner right_inner)
             (/.inner? (/.intersection left_inner right_inner))
             (/.outer? (/.intersection left_inner right_inner))))
         (_.property "The intersection of 2 outer intervals is another outer interval."
           (/.outer? (/.intersection left_outer right_outer)))
         )))

(def: complement
  Test
  (do random.monad
    [some_interval ..interval]
    (all _.and
         (_.property "The complement of a complement is the same as the original."
           (#= some_interval (|> some_interval /.complement /.complement)))
         (_.property "The complement of an interval does not overlap it."
           (not (/.overlaps? some_interval (/.complement some_interval))))
         )))

(def: location
  Test
  (do [! random.monad]
    [[l m r] (|> (random.set n.hash 3 random.nat)
                 (# ! each (|>> set.list
                                (list.sorted n.<)
                                (pipe.case
                                  (pattern (list b t1 t2))
                                  [b t1 t2]

                                  _
                                  (undefined)))))
     .let [left (/.singleton n.enum l)
           right (/.singleton n.enum r)]]
    (all _.and
         (_.coverage [/.precedes? /.succeeds?]
           (and (/.precedes? right left)
                (/.succeeds? left right)))
         (_.coverage [/.before? /.after?]
           (and (/.before? m left)
                (/.after? m right)))
         )))

(def: touch
  Test
  (do [! random.monad]
    [[b t1 t2] (|> (random.set n.hash 3 random.nat)
                   (# ! each (|>> set.list
                                  (list.sorted n.<)
                                  (pipe.case
                                    (pattern (list b t1 t2))
                                    [b t1 t2]

                                    _
                                    (undefined)))))
     .let [int_left (/.between n.enum t1 t2)
           int_right (/.between n.enum b t1)]]
    (all _.and
         (_.coverage [/.meets?]
           (/.meets? int_left int_right))
         (_.coverage [/.touches?]
           (/.touches? int_left int_right))
         (_.coverage [/.starts?]
           (/.starts? (/.between n.enum b t2)
                      (/.between n.enum b t1)))
         (_.coverage [/.finishes?]
           (/.finishes? (/.between n.enum b t2)
                        (/.between n.enum t1 t2)))
         )))

(def: nested
  Test
  (do [! random.monad]
    [some_interval ..interval
     [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat)
                       (# ! each (|>> set.list
                                      (list.sorted n.<)
                                      (pipe.case
                                        (pattern (list x0 x1 x2 x3))
                                        [x0 x1 x2 x3]

                                        _
                                        (undefined)))))]
    (all _.and
         (_.property "Every interval is nested into itself."
           (/.nested? some_interval some_interval))
         (let [small_inner (/.between n.enum x1 x2)
               large_inner (/.between n.enum x0 x3)]
           (_.property "Inner intervals can be nested inside one another."
             (and (/.nested? large_inner small_inner)
                  (not (/.nested? small_inner large_inner)))))
         (let [small_outer (/.between n.enum x2 x1)
               large_outer (/.between n.enum x3 x0)]
           (_.property "Outer intervals can be nested inside one another."
             (and (/.nested? small_outer large_outer)
                  (not (/.nested? large_outer small_outer)))))
         (let [left_inner (/.between n.enum x0 x1)
               right_inner (/.between n.enum x2 x3)
               outer (/.between n.enum x0 x3)]
           (_.property "Inners can be nested inside outers."
             (and (/.nested? outer left_inner)
                  (/.nested? outer right_inner))))
         )))

(def: overlap
  Test
  (do [! random.monad]
    [some_interval ..interval
     [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat)
                       (# ! each (|>> set.list
                                      (list.sorted n.<)
                                      (pipe.case
                                        (pattern (list x0 x1 x2 x3))
                                        [x0 x1 x2 x3]

                                        _
                                        (undefined)))))]
    (all _.and
         (_.property "No interval overlaps with itself."
           (not (/.overlaps? some_interval some_interval)))
         (let [left_inner (/.between n.enum x0 x2)
               right_inner (/.between n.enum x1 x3)]
           (_.property "Inner intervals can overlap one another."
             (and (/.overlaps? left_inner right_inner)
                  (/.overlaps? right_inner left_inner))))
         (let [left_inner (/.between n.enum x0 x2)
               right_inner (/.between n.enum x1 x3)
               outer (/.between n.enum x1 x2)]
           (_.property "Inners can overlap outers."
             (and (/.overlaps? outer left_inner)
                  (/.overlaps? outer right_inner))))
         )))

(def: .public test
  Test
  (<| (_.covering /._)
      (all _.and
           (_.for [/.equivalence]
                  ($equivalence.spec /.equivalence ..interval))
           
           ..types
           ..boundaries
           (_.for [/.union]
                  ..union)
           (_.for [/.intersection]
                  ..intersection)
           (_.for [/.complement]
                  ..complement)
           ..location
           ..touch
           (_.for [/.nested?]
                  ..nested)
           (_.for [/.overlaps?]
                  ..overlap)
           )))