(.module:
  [library
   [lux "*"
    ["_" test {"+" Test}]
    [abstract
     [monad {"+" do}]
     ["[0]" order]
     [\\specification
      ["$[0]" equivalence]]]
    [control
     [pipe {"+" case>}]]
    [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))
  ($_ 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)
                 (# ! each (|>> set.list
                                (list.sorted 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)
                   (# ! each (|>> set.list
                                  (list.sorted 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)
                       (# ! each (|>> set.list
                                      (list.sorted 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)
                       (# ! each (|>> set.list
                                      (list.sorted 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: .public test
  Test
  (<| (_.covering /._)
      ($_ _.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)
          )))