(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do)]
    ["." order]
    {[0 #spec]
     [/
      ["$." equivalence]]}]
   [control
    [pipe (#+ case>)]]
   [data
    [number
     ["n" nat]]
    [collection
     ["." set]
     ["." list]]]
   [math
    ["." random (#+ Random)]]]
  {1
   ["." / (#+ Interval) ("#@." equivalence)]})

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

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

(def: #export singleton
  (Random (Interval Nat))
  (do random.monad
    [point random.nat]
    (wrap (/.singleton n.enum point))))

(def: #export interval
  (Random (Interval Nat))
  ($_ random.either
      ..inner
      ..outer
      ..singleton))

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

(def: boundaries
  Test
  (do random.monad
    [bottom random.nat
     top random.nat
     #let [interval (/.between n.enum bottom top)]]
    ($_ _.and
        (_.cover [/.between /.within?]
                 (and (/.within? interval bottom)
                      (/.within? interval top)))
        (_.cover [/.starts-with?]
                 (/.starts-with? bottom interval))
        (_.cover [/.ends-with?]
                 (/.ends-with? top interval))
        (_.cover [/.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]
    ($_ _.and
        (_.test "The union of an interval to itself yields the same interval."
                (/@= some-interval (/.union some-interval some-interval)))
        (_.test "The union of 2 inner intervals is another inner interval."
                (/.inner? (/.union left-inner right-inner)))
        (_.test "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]
    ($_ _.and
        (_.test "The intersection of an interval to itself yields the same interval."
                (/@= some-interval (/.intersection some-interval some-interval)))
        (_.test "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))))
        (_.test "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]
    ($_ _.and
        (_.test "The complement of a complement is the same as the original."
                (/@= some-interval (|> some-interval /.complement /.complement)))
        (_.test "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)
                 (:: @ map (|>> set.to-list
                                (list.sort n.<)
                                (case> (^ (list b t1 t2))
                                       [b t1 t2]

                                       _
                                       (undefined)))))
     #let [left (/.singleton n.enum l)
           right (/.singleton n.enum r)]]
    ($_ _.and
        (_.cover [/.precedes? /.succeeds?]
                 (and (/.precedes? right left)
                      (/.succeeds? left right)))
        (_.cover [/.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)
                   (:: @ map (|>> set.to-list
                                  (list.sort n.<)
                                  (case> (^ (list b t1 t2))
                                         [b t1 t2]

                                         _
                                         (undefined)))))
     #let [int-left (/.between n.enum t1 t2)
           int-right (/.between n.enum b t1)]]
    ($_ _.and
        (_.cover [/.meets?]
                 (/.meets? int-left int-right))
        (_.cover [/.touches?]
                 (/.touches? int-left int-right))
        (_.cover [/.starts?]
                 (/.starts? (/.between n.enum b t2)
                            (/.between n.enum b t1)))
        (_.cover [/.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)
                       (:: @ map (|>> set.to-list
                                      (list.sort n.<)
                                      (case> (^ (list x0 x1 x2 x3))
                                             [x0 x1 x2 x3]

                                             _
                                             (undefined)))))]
    ($_ _.and
        (_.test "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)]
          (_.test "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)]
          (_.test "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)]
          (_.test "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)
                       (:: @ map (|>> set.to-list
                                      (list.sort n.<)
                                      (case> (^ (list x0 x1 x2 x3))
                                             [x0 x1 x2 x3]

                                             _
                                             (undefined)))))]
    ($_ _.and
        (_.test "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)]
          (_.test "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)]
          (_.test "Inners can overlap outers."
                  (and (/.overlaps? outer left-inner)
                       (/.overlaps? outer right-inner))))
        )))

(def: #export test
  Test
  (<| (_.covering /._)
      ($_ _.and
          (_.with-cover [/.equivalence]
            ($equivalence.spec /.equivalence ..interval))
          
          ..types
          ..boundaries
          (_.with-cover [/.union]
            ..union)
          (_.with-cover [/.intersection]
            ..intersection)
          (_.with-cover [/.complement]
            ..complement)
          ..location
          ..touch
          (_.with-cover [/.nested?]
            ..nested)
          (_.with-cover [/.overlaps?]
            ..overlap)
          )))