closed-intervals 0.1.1.0 → 0.2.0.0

raw patch · 5 files changed

+471/−330 lines, 5 filesdep +filtrablePVP ok

version bump matches the API change (PVP)

Dependencies added: filtrable

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• closed-intervals.cabal +2/−1
• doctest/Test/Data/Interval.hs +236/−191
• src/Data/Interval.hs +203/−122
• test/Data/IntervalTest.hs +23/−16

@@ -7,4 +7,11 @@   because the QuickCheck generator generated data which    did not meet the assumptions made by hullSeqNonOverlap. +- 0.2.0.0 The bugfix in 0.1.0.1 made the IntersectionQuery instance +  of Seq unbearably slow. It can be as fast as before when placing +  stronger assumptions on the sequence of intervals. +  this is reflected by the newtype NonNestedSeq. +  Removed the low-level functions findSeq and existsSeq+  from the API because they do not suggest the assumptions made.+ ## Unreleased changes

@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           closed-intervals-version:        0.1.1.0+version:        0.2.0.0 synopsis:       Closed intervals of totally ordered types description:    see README.md author:         Olaf Klinke, Henning Thielemann@@ -27,6 +27,7 @@   build-depends:       base >=4.7 && <5      ,containers >= 0.5.4.0+     ,filtrable >= 0.1.6      ,time < 1.12   ghc-options:         -Wall   default-language: Haskell2010

@@ -1,5 +1,5 @@ -- Do not edit! Automatically created with doctest-extract from src/Data/Interval.hs-{-# LINE 107 "src/Data/Interval.hs" #-}+{-# LINE 109 "src/Data/Interval.hs" #-}  module Test.Data.Interval where @@ -7,273 +7,318 @@ import Test.DocTest.Base import qualified Test.DocTest.Driver as DocTest -{-# LINE 108 "src/Data/Interval.hs" #-}+{-# LINE 110 "src/Data/Interval.hs" #-} import     Data.IntervalTest import     qualified Data.Sequence as Seq import     qualified Data.List as List import     Data.Function (on) import     Data.Maybe (isJust, fromJust, catMaybes) import     Data.Foldable (toList)-import     qualified Test.QuickCheck as QC import     Test.QuickCheck ((==>)) without'     :: (Int,Int) -> (Int,Int) -> [(Int,Int)]; without' = without  test :: DocTest.T () test = do- DocTest.printPrefix "Data.Interval:189: "-{-# LINE 189 "src/Data/Interval.hs" #-}- DocTest.property-{-# LINE 189 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> overlapTime i i == intervalDuration i)- DocTest.printPrefix "Data.Interval:190: "-{-# LINE 190 "src/Data/Interval.hs" #-}- DocTest.property-{-# LINE 190 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> not (i `properlyIntersects` j) ==> overlapTime i j == 0)- DocTest.printPrefix "Data.Interval:191: "-{-# LINE 191 "src/Data/Interval.hs" #-}- DocTest.property-{-# LINE 191 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> overlapTime i j == (sum $ fmap intervalDuration $ maybeIntersection i j))- DocTest.printPrefix "Data.Interval:201: "-{-# LINE 201 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:181: "+{-# LINE 181 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 201 "src/Data/Interval.hs" #-}-        (genInterval /\ \i c -> prevailing i (Seq.singleton (c,i)) == Just (c::Char))- DocTest.printPrefix "Data.Interval:202: "-{-# LINE 202 "src/Data/Interval.hs" #-}+{-# LINE 181 "src/Data/Interval.hs" #-}+        (forevery genNonNestedIntervalSeq $ \xs -> propSplit (\subseq -> hullSeqNonNested subseq == hullSeq subseq) (splitSeq xs))+ DocTest.printPrefix "Data.Interval:176: "+{-# LINE 176 "src/Data/Interval.hs" #-}+ DocTest.example+{-# LINE 176 "src/Data/Interval.hs" #-}+      (propSplit (\xs -> hullSeqNonNested xs == hullSeq xs) . splitSeq . sortByRight $ Seq.fromList ([(1,3),(2,4),(4,5),(3,6)] :: [(Int,Int)]))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Data.Interval:229: "+{-# LINE 229 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 202 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> genLabeledSeq /\ \js -> isJust (prevailing i js) == any (intersects i . snd) js)- DocTest.printPrefix "Data.Interval:203: "-{-# LINE 203 "src/Data/Interval.hs" #-}+{-# LINE 229 "src/Data/Interval.hs" #-}+        (forevery genInterval     $ \i -> overlapTime i i == intervalDuration i)+ DocTest.printPrefix "Data.Interval:230: "+{-# LINE 230 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 203 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> genLabeledSeq /\* \js ks -> all (flip elem $ catMaybes [prevailing i js, prevailing i ks]) $ prevailing i (js<>ks))- DocTest.printPrefix "Data.Interval:226: "-{-# LINE 226 "src/Data/Interval.hs" #-}+{-# LINE 230 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> not (i `properlyIntersects` j) ==> overlapTime i j == 0)+ DocTest.printPrefix "Data.Interval:231: "+{-# LINE 231 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 226 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> isJust (maybeUnion i j) ==> fromJust (maybeUnion i j) `contains` i && fromJust (maybeUnion i j) `contains` j)- DocTest.printPrefix "Data.Interval:227: "-{-# LINE 227 "src/Data/Interval.hs" #-}+{-# LINE 231 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> overlapTime i j == (sum $ fmap intervalDuration $ maybeIntersection i j))+ DocTest.printPrefix "Data.Interval:241: "+{-# LINE 241 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 227 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> i `intersects` j ==> (maybeUnion i j >>= maybeIntersection i) == Just i)- DocTest.printPrefix "Data.Interval:235: "-{-# LINE 235 "src/Data/Interval.hs" #-}+{-# LINE 241 "src/Data/Interval.hs" #-}+        (forevery genInterval $ \i c -> prevailing i (Seq.singleton (c,i)) == Just (c::Char))+ DocTest.printPrefix "Data.Interval:242: "+{-# LINE 242 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 235 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> i `intersects` j ==> i `contains` fromJust (maybeIntersection i j))+{-# LINE 242 "src/Data/Interval.hs" #-}+        (foreveryPairOf genInterval genLabeledSeq $ \i js -> isJust (prevailing i js) == any (intersects i . snd) js)  DocTest.printPrefix "Data.Interval:243: " {-# LINE 243 "src/Data/Interval.hs" #-}  DocTest.property {-# LINE 243 "src/Data/Interval.hs" #-}+        (forevery genInterval $ \i -> foreveryPair genLabeledSeq $ \js ks -> all (flip elem $ catMaybes [prevailing i js, prevailing i ks]) $ prevailing i (js<>ks))+ DocTest.printPrefix "Data.Interval:266: "+{-# LINE 266 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 266 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> isJust (maybeUnion i j) ==> fromJust (maybeUnion i j) `contains` i && fromJust (maybeUnion i j) `contains` j)+ DocTest.printPrefix "Data.Interval:267: "+{-# LINE 267 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 267 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> i `intersects` j ==> (maybeUnion i j >>= maybeIntersection i) == Just i)+ DocTest.printPrefix "Data.Interval:275: "+{-# LINE 275 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 275 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> i `intersects` j ==> i `contains` fromJust (maybeIntersection i j))+ DocTest.printPrefix "Data.Interval:283: "+{-# LINE 283 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 283 "src/Data/Interval.hs" #-}         (\xs -> isJust (hull xs) ==> all (\x -> fromJust (hull xs) `contains` x) (xs :: [(Int,Int)]))- DocTest.printPrefix "Data.Interval:260: "-{-# LINE 260 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:300: "+{-# LINE 300 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 260 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> length (i `without` j) <= 2)- DocTest.printPrefix "Data.Interval:261: "-{-# LINE 261 "src/Data/Interval.hs" #-}+{-# LINE 300 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> length (i `without` j) <= 2)+ DocTest.printPrefix "Data.Interval:301: "+{-# LINE 301 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 261 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> i `without` i == [])- DocTest.printPrefix "Data.Interval:262: "-{-# LINE 262 "src/Data/Interval.hs" #-}+{-# LINE 301 "src/Data/Interval.hs" #-}+        (forevery     genInterval $ \i -> i `without` i == [])+ DocTest.printPrefix "Data.Interval:302: "+{-# LINE 302 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 262 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> all (contains i) (i `without` j))- DocTest.printPrefix "Data.Interval:263: "-{-# LINE 263 "src/Data/Interval.hs" #-}+{-# LINE 302 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> all (contains i) (i `without` j))+ DocTest.printPrefix "Data.Interval:303: "+{-# LINE 303 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 263 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> not $ any (properlyIntersects j) (i `without` j))- DocTest.printPrefix "Data.Interval:251: "-{-# LINE 251 "src/Data/Interval.hs" #-}+{-# LINE 303 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> not $ any (properlyIntersects j) (i `without` j))+ DocTest.printPrefix "Data.Interval:291: "+{-# LINE 291 "src/Data/Interval.hs" #-}  DocTest.example-{-# LINE 251 "src/Data/Interval.hs" #-}+{-# LINE 291 "src/Data/Interval.hs" #-}       (without' (1,5) (4,5))   [ExpectedLine [LineChunk "[(1,4)]"]]- DocTest.printPrefix "Data.Interval:253: "-{-# LINE 253 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:293: "+{-# LINE 293 "src/Data/Interval.hs" #-}  DocTest.example-{-# LINE 253 "src/Data/Interval.hs" #-}+{-# LINE 293 "src/Data/Interval.hs" #-}       (without' (1,5) (2,3))   [ExpectedLine [LineChunk "[(1,2),(3,5)]"]]- DocTest.printPrefix "Data.Interval:255: "-{-# LINE 255 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:295: "+{-# LINE 295 "src/Data/Interval.hs" #-}  DocTest.example-{-# LINE 255 "src/Data/Interval.hs" #-}+{-# LINE 295 "src/Data/Interval.hs" #-}       (without' (1,5) (1,5))   [ExpectedLine [LineChunk "[]"]]- DocTest.printPrefix "Data.Interval:257: "-{-# LINE 257 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:297: "+{-# LINE 297 "src/Data/Interval.hs" #-}  DocTest.example-{-# LINE 257 "src/Data/Interval.hs" #-}+{-# LINE 297 "src/Data/Interval.hs" #-}       (without' (1,5) (0,1))   [ExpectedLine [LineChunk "[(1,5)]"]]- DocTest.printPrefix "Data.Interval:279: "-{-# LINE 279 "src/Data/Interval.hs" #-}- DocTest.property-{-# LINE 279 "src/Data/Interval.hs" #-}-        (genSortedIntervals /\ all (\xs -> and $ List.zipWith intersects xs (tail xs)) . contiguous)- DocTest.printPrefix "Data.Interval:294: "-{-# LINE 294 "src/Data/Interval.hs" #-}- DocTest.property-{-# LINE 294 "src/Data/Interval.hs" #-}-        (genSortedIntervals /\ \xs -> all (\i -> any (flip contains i) (components xs)) xs)- DocTest.printPrefix "Data.Interval:305: "-{-# LINE 305 "src/Data/Interval.hs" #-}- DocTest.property-{-# LINE 305 "src/Data/Interval.hs" #-}-        (genSortedIntervals /\ \xs -> componentsSeq (Seq.fromList xs) == Seq.fromList (components xs))- DocTest.printPrefix "Data.Interval:318: "-{-# LINE 318 "src/Data/Interval.hs" #-}- DocTest.property-{-# LINE 318 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> genIntervalSeq /\ \js -> all (contains i) (covered i js))  DocTest.printPrefix "Data.Interval:319: " {-# LINE 319 "src/Data/Interval.hs" #-}  DocTest.property {-# LINE 319 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> genIntervalSeq /\ \js -> covered i (covered i js) == covered i js)- DocTest.printPrefix "Data.Interval:327: "-{-# LINE 327 "src/Data/Interval.hs" #-}- DocTest.property-{-# LINE 327 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> j `contains` i == i `coveredBy` [j])- DocTest.printPrefix "Data.Interval:328: "-{-# LINE 328 "src/Data/Interval.hs" #-}- DocTest.property-{-# LINE 328 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> genSortedIntervals /\ \js -> i `coveredBy` js ==> any (flip contains i) (components js))- DocTest.printPrefix "Data.Interval:334: "-{-# LINE 334 "src/Data/Interval.hs" #-}+        (forevery genSortedIntervals $ all (\xs -> and $ List.zipWith intersects xs (tail xs)) . contiguous)+ DocTest.printPrefix "Data.Interval:320: "+{-# LINE 320 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 334 "src/Data/Interval.hs" #-}-        (genNonEmptyInterval /\ \i -> genIntervalSeq /\ \js -> i `coveredBy` js == (fractionCovered i js >= (1::Rational)))+{-# LINE 320 "src/Data/Interval.hs" #-}+        (forevery genSortedIntervals $ all ((1==).length.components) . contiguous)  DocTest.printPrefix "Data.Interval:335: " {-# LINE 335 "src/Data/Interval.hs" #-}  DocTest.property {-# LINE 335 "src/Data/Interval.hs" #-}-        (genNonEmptyInterval /\ \i -> genNonEmptyIntervalSeq /\ \js -> any (properlyIntersects i) js == (fractionCovered i js > (0::Rational)))- DocTest.printPrefix "Data.Interval:354: "-{-# LINE 354 "src/Data/Interval.hs" #-}+        (forevery genSortedIntervals $ \xs -> all (\i -> any (flip contains i) (components xs)) xs)+ DocTest.printPrefix "Data.Interval:336: "+{-# LINE 336 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 354 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> i `intersects` j  ==  (overlap i j == EQ))- DocTest.printPrefix "Data.Interval:372: "-{-# LINE 372 "src/Data/Interval.hs" #-}+{-# LINE 336 "src/Data/Interval.hs" #-}+        (forevery genSortedIntervals $ \xs -> let cs = components xs in all (\(i,j) -> i == j || not (i `intersects` j)) [(c1,c2) | c1 <- cs, c2 <- cs])+ DocTest.printPrefix "Data.Interval:355: "+{-# LINE 355 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 372 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> i `properlyIntersects` j  ==  (properOverlap i j == EQ))- DocTest.printPrefix "Data.Interval:384: "-{-# LINE 384 "src/Data/Interval.hs" #-}+{-# LINE 355 "src/Data/Interval.hs" #-}+        (forevery genSortedIntervals   $ \xs -> componentsSeq (Seq.fromList xs) == Seq.fromList (components xs))+ DocTest.printPrefix "Data.Interval:356: "+{-# LINE 356 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 384 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> (lb i <= ub i && lb j <= ub j && i `intersects` j)  ==  (max (lb i) (lb j) <= min (ub i) (ub j)))- DocTest.printPrefix "Data.Interval:381: "-{-# LINE 381 "src/Data/Interval.hs" #-}- DocTest.example-{-# LINE 381 "src/Data/Interval.hs" #-}-      (((1,2)::(Int,Int)) `intersects` ((2,3)::(Int,Int)))-  [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Data.Interval:395: "-{-# LINE 395 "src/Data/Interval.hs" #-}+{-# LINE 356 "src/Data/Interval.hs" #-}+        (forevery genSortedIntervalSeq $ \xs -> let cs = componentsSeq xs in all (\(i,j) -> i == j || not (i `intersects` j)) $ do {c1 <- cs; c2 <- cs; return (c1,c2)})+ DocTest.printPrefix "Data.Interval:369: "+{-# LINE 369 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 395 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> ((i `intersects` j) && not (i `properlyIntersects` j))  ==  (ub i == lb j || ub j == lb i))- DocTest.printPrefix "Data.Interval:401: "-{-# LINE 401 "src/Data/Interval.hs" #-}+{-# LINE 369 "src/Data/Interval.hs" #-}+        (foreveryPairOf genInterval genIntervalSeq $ \i js -> all (contains i) (covered i js))+ DocTest.printPrefix "Data.Interval:370: "+{-# LINE 370 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 401 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> i `contains` i)- DocTest.printPrefix "Data.Interval:402: "-{-# LINE 402 "src/Data/Interval.hs" #-}+{-# LINE 370 "src/Data/Interval.hs" #-}+        (foreveryPairOf genInterval genIntervalSeq $ \i js -> covered i (covered i js) == covered i js)+ DocTest.printPrefix "Data.Interval:376: "+{-# LINE 376 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 402 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> (i `contains` j && j `contains` i) == (i==j))+{-# LINE 376 "src/Data/Interval.hs" #-}+        (foreveryPair   genInterval $ \i j -> j `contains` i == i `coveredBy` [j])+ DocTest.printPrefix "Data.Interval:377: "+{-# LINE 377 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 377 "src/Data/Interval.hs" #-}+        (foreveryPairOf genInterval genSortedIntervals $ \i js -> i `coveredBy` js ==> any (flip contains i) (components js))+ DocTest.printPrefix "Data.Interval:383: "+{-# LINE 383 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 383 "src/Data/Interval.hs" #-}+        (foreveryPairOf genNonEmptyInterval genIntervalSeq         $ \i js -> i `coveredBy` js == (fractionCovered i js >= (1::Rational)))+ DocTest.printPrefix "Data.Interval:384: "+{-# LINE 384 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 384 "src/Data/Interval.hs" #-}+        (foreveryPairOf genNonEmptyInterval genNonEmptyIntervalSeq $ \i js -> any (properlyIntersects i) js == (fractionCovered i js > (0::Rational)))  DocTest.printPrefix "Data.Interval:403: " {-# LINE 403 "src/Data/Interval.hs" #-}  DocTest.property {-# LINE 403 "src/Data/Interval.hs" #-}-        (genInterval /\* \i j -> i `contains` j == (maybeUnion i j == Just i))- DocTest.printPrefix "Data.Interval:415: "-{-# LINE 415 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> i `intersects` j  ==  (overlap i j == EQ))+ DocTest.printPrefix "Data.Interval:421: "+{-# LINE 421 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 415 "src/Data/Interval.hs" #-}-        (genSortedList /\ \xs -> (components $ toList $ fromEndPoints xs) == if length xs < 2 then [] else [(head xs, last xs)])- DocTest.printPrefix "Data.Interval:428: "-{-# LINE 428 "src/Data/Interval.hs" #-}+{-# LINE 421 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> i `properlyIntersects` j  ==  (properOverlap i j == EQ))+ DocTest.printPrefix "Data.Interval:433: "+{-# LINE 433 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 428 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> genSortedIntervalSeq /\ \js -> toList (getIntersects i js) `List.isSubsequenceOf` toList js)- DocTest.printPrefix "Data.Interval:445: "-{-# LINE 445 "src/Data/Interval.hs" #-}+{-# LINE 433 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> (lb i <= ub i && lb j <= ub j && i `intersects` j)  ==  (max (lb i) (lb j) <= min (ub i) (ub j)))+ DocTest.printPrefix "Data.Interval:430: "+{-# LINE 430 "src/Data/Interval.hs" #-}+ DocTest.example+{-# LINE 430 "src/Data/Interval.hs" #-}+      (((1,2)::(Int,Int)) `intersects` ((2,3)::(Int,Int)))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Data.Interval:444: "+{-# LINE 444 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 445 "src/Data/Interval.hs" #-}-        (genSortedIntervalSeq /\ \xs -> hullSeq xs == hull (toList xs))+{-# LINE 444 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> ((i `intersects` j) && not (i `properlyIntersects` j))  ==  (ub i == lb j || ub j == lb i))+ DocTest.printPrefix "Data.Interval:450: "+{-# LINE 450 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 450 "src/Data/Interval.hs" #-}+        (forevery     genInterval $ \i -> i `contains` i)+ DocTest.printPrefix "Data.Interval:451: "+{-# LINE 451 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 451 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> (i `contains` j && j `contains` i) == (i==j))+ DocTest.printPrefix "Data.Interval:452: "+{-# LINE 452 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 452 "src/Data/Interval.hs" #-}+        (foreveryPair genInterval $ \i j -> i `contains` j == (maybeUnion i j == Just i))  DocTest.printPrefix "Data.Interval:464: " {-# LINE 464 "src/Data/Interval.hs" #-}  DocTest.property {-# LINE 464 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> genSortedIntervals /\ \js -> fst (splitIntersecting i js) == filter (intersects i) js)+        (forevery genSortedList $ \xs -> (components $ toList $ fromEndPoints xs) == if length xs < 2 then [] else [(head xs, last xs)])  DocTest.printPrefix "Data.Interval:465: " {-# LINE 465 "src/Data/Interval.hs" #-}  DocTest.property {-# LINE 465 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> genSortedIntervals /\ \js -> all (\j -> not (ub j < ub i)) (snd (splitIntersecting i js)))- DocTest.printPrefix "Data.Interval:461: "-{-# LINE 461 "src/Data/Interval.hs" #-}+        (forevery genSortedList $ \xs -> hullSeqNonNested (fromEndPoints xs) == if length xs < 2 then Nothing else Just (head xs,last xs))+ DocTest.printPrefix "Data.Interval:478: "+{-# LINE 478 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 478 "src/Data/Interval.hs" #-}+        (foreveryPairOf genInterval genSortedIntervalSeq $ \i js -> toList (getIntersects i (FromSortedSeq js)) `List.isSubsequenceOf` toList js)+ DocTest.printPrefix "Data.Interval:479: "+{-# LINE 479 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 479 "src/Data/Interval.hs" #-}+        (forevery genSortedIntervalSeq $ \xs -> propSplit (\subseq -> subseq == sortByRight subseq) (splitSeq xs))+ DocTest.printPrefix "Data.Interval:496: "+{-# LINE 496 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 496 "src/Data/Interval.hs" #-}+        (forevery genSortedIntervalSeq $ \xs -> hullSeq xs == if Seq.null xs then Nothing else Just (minimum (fmap lb xs),maximum (fmap ub xs)))+ DocTest.printPrefix "Data.Interval:497: "+{-# LINE 497 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 497 "src/Data/Interval.hs" #-}+        (forevery genSortedIntervalSeq $ \xs -> hullSeq xs == hull (toList xs))+ DocTest.printPrefix "Data.Interval:516: "+{-# LINE 516 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 516 "src/Data/Interval.hs" #-}+        (foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js' -> let js = toList js' in fst (splitIntersecting i js) == filter (intersects i) js)+ DocTest.printPrefix "Data.Interval:517: "+{-# LINE 517 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 517 "src/Data/Interval.hs" #-}+        (foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js' -> let js = toList js' in all (\j -> not (ub j < ub i)) (snd (splitIntersecting i js)))+ DocTest.printPrefix "Data.Interval:513: "+{-# LINE 513 "src/Data/Interval.hs" #-}  DocTest.example-{-# LINE 461 "src/Data/Interval.hs" #-}-      (splitIntersecting ((2,5) :: (Int,Int)) ([(0,1),(2,3),(2,2),(3,6),(6,7)] :: [(Int,Int)]))-  [ExpectedLine [LineChunk "([(2,3),(2,2),(3,6)],[(3,6),(6,7)])"]]- DocTest.printPrefix "Data.Interval:485: "-{-# LINE 485 "src/Data/Interval.hs" #-}+{-# LINE 513 "src/Data/Interval.hs" #-}+      (splitIntersecting ((2,5) :: (Int,Int)) ([(0,1),(2,2),(2,3),(3,6),(6,7)] :: [(Int,Int)]))+  [ExpectedLine [LineChunk "([(2,2),(2,3),(3,6)],[(3,6),(6,7)])"]]+ DocTest.printPrefix "Data.Interval:537: "+{-# LINE 537 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 485 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> genSortedIntervals /\ \js -> fst (splitProperlyIntersecting i js) == filter (properlyIntersects i) js)- DocTest.printPrefix "Data.Interval:486: "-{-# LINE 486 "src/Data/Interval.hs" #-}+{-# LINE 537 "src/Data/Interval.hs" #-}+        (foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js' -> let js = toList js' in fst (splitProperlyIntersecting i js) == filter (properlyIntersects i) js)+ DocTest.printPrefix "Data.Interval:538: "+{-# LINE 538 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 486 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> genSortedIntervals /\ \js -> all (not.contains i) (snd (splitProperlyIntersecting i js)))- DocTest.printPrefix "Data.Interval:482: "-{-# LINE 482 "src/Data/Interval.hs" #-}+{-# LINE 538 "src/Data/Interval.hs" #-}+        (foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js' -> let js = toList js' in all (not.properlyContains i) (snd (splitProperlyIntersecting i js)))+ DocTest.printPrefix "Data.Interval:534: "+{-# LINE 534 "src/Data/Interval.hs" #-}  DocTest.example-{-# LINE 482 "src/Data/Interval.hs" #-}+{-# LINE 534 "src/Data/Interval.hs" #-}       (splitProperlyIntersecting ((2,5) :: (Int,Int))  ([(0,1),(2,3),(2,2),(3,5),(5,6),(6,7)] :: [(Int,Int)]))   [ExpectedLine [LineChunk "([(2,3),(3,5)],[(5,6),(6,7)])"]]- DocTest.printPrefix "Data.Interval:523: "-{-# LINE 523 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:570: "+{-# LINE 570 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 523 "src/Data/Interval.hs" #-}-        (invariant . itree 4 . fmap (\(x,y) -> (x, x + QC.getNonNegative y :: Integer)))- DocTest.printPrefix "Data.Interval:533: "-{-# LINE 533 "src/Data/Interval.hs" #-}+{-# LINE 570 "src/Data/Interval.hs" #-}+        (forevery genSortedIntervalSeq $ \xs -> hullSeq xs == hullOfTree (itree 4 xs))+ DocTest.printPrefix "Data.Interval:581: "+{-# LINE 581 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 533 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> genIntervalSeq /\ \t -> on (==) sortByLeft (getIntersectsIT i $ itree 2 t) (i `intersecting` t))- DocTest.printPrefix "Data.Interval:544: "-{-# LINE 544 "src/Data/Interval.hs" #-}+{-# LINE 581 "src/Data/Interval.hs" #-}+        (forevery genIntervalSeq $ \xs -> invariant . itree 4 $ xs)+ DocTest.printPrefix "Data.Interval:591: "+{-# LINE 591 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 544 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> genIntervalSeq /\ \t -> on (==) sortByLeft (getProperIntersectsIT i $ itree 2 t) (i `intersectingProperly` t))- DocTest.printPrefix "Data.Interval:649: "-{-# LINE 649 "src/Data/Interval.hs" #-}+{-# LINE 591 "src/Data/Interval.hs" #-}+        (foreveryPairOf genInterval genIntervalSeq $ \i t -> on (==) sortByRight (getIntersects i $ itree 2 t) (i `intersecting` t))+ DocTest.printPrefix "Data.Interval:602: "+{-# LINE 602 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 649 "src/Data/Interval.hs" #-}-        (genIntervalSeq /\ \is -> joinSeq (splitSeq is) == is)- DocTest.printPrefix "Data.Interval:706: "-{-# LINE 706 "src/Data/Interval.hs" #-}+{-# LINE 602 "src/Data/Interval.hs" #-}+        (foreveryPairOf genInterval genIntervalSeq $ \i t -> on (==) sortByRight (getProperIntersects i $ itree 2 t) (i `intersectingProperly` t))+ DocTest.printPrefix "Data.Interval:734: "+{-# LINE 734 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 706 "src/Data/Interval.hs" #-}-        (genDisjointIntervalSeq /\ \xs -> hullSeqNonOverlap xs == hullSeq xs)- DocTest.printPrefix "Data.Interval:732: "-{-# LINE 732 "src/Data/Interval.hs" #-}+{-# LINE 734 "src/Data/Interval.hs" #-}+        (forevery genIntervalSeq $ \is -> joinSeq (splitSeq is) == is)+ DocTest.printPrefix "Data.Interval:796: "+{-# LINE 796 "src/Data/Interval.hs" #-}  DocTest.property-{-# LINE 732 "src/Data/Interval.hs" #-}-        (genInterval /\ \i -> genDisjointIntervalSeq /\ \js -> findSeq intersects i js == intersecting i js)+{-# LINE 796 "src/Data/Interval.hs" #-}+        (forevery genNonNestedIntervalSeq $ \xs -> hullSeqNonNested xs == hullSeq xs)+ DocTest.printPrefix "Data.Interval:813: "+{-# LINE 813 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 813 "src/Data/Interval.hs" #-}+        (foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js -> getIntersects i (FromSortedSeq js) == intersecting i js)

@@ -40,25 +40,31 @@ Checks were implemented by Henning Thielemann. 
 -}
 {-# LANGUAGE FlexibleInstances,FlexibleContexts,FunctionalDependencies,MultiParamTypeClasses,CPP #-}
+{-# LANGUAGE DeriveFoldable, DeriveFunctor, DeriveTraversable #-}
 module Data.Interval (
-    -- * Type classes
+    -- * Types and type classes
     Interval(..),
     IntersectionQuery(..),
     Adjust(..),
     TimeDifference(..),
+    NonNestedSeq(..),
     -- * Comparing intervals
     intersects,properlyIntersects,contains,properlyContains,
-    covered,coveredBy,overlapTime,prevailing,fractionCovered,
-    overlap,
-    properOverlap,
+    covered,coveredBy,
+    overlap,properOverlap,
+    -- * Time intervals
+    overlapTime,
+    fractionCovered,
+    prevailing,
     intervalDuration,
     -- * Operations on intervals
     maybeUnion,maybeIntersection,
     hull,
     hullSeq,
+    hullSeqNonNested,
     without,
     contiguous,components,componentsSeq,
-    sortByLeft,
+    sortByRight,
     fromEndPoints,
     -- * Streaming intervals
     splitIntersecting,
@@ -69,30 +75,26 @@     emptyITree,
     insert,
     hullOfTree,
-    intersecting,getIntersectsIT,getProperIntersectsIT,
-    someIntersectsIT,someProperlyIntersectsIT,
-    leftmostInterval,
-    -- * Non-overlapping intervals
-    findSeq, existsSeq, hullSeqNonOverlap,
-    -- * Debug
+    -- ** Debug
     invariant, toTree,
     -- * Testing
-    intersectingProperly,
+    intersecting,intersectingProperly,
     filterM,
     joinSeq,
-    splitSeq,
+    propSplit,
+    splitSeq
     ) where
 
 import Data.Tree (Tree)
 import qualified Data.Tree as Tree
 import qualified Data.Sequence as Seq
 import qualified Data.Monoid ((<>))
+import Data.Filtrable (Filtrable(..))
 import Data.Traversable (Traversable)
 import Data.Foldable (toList, maximumBy, foldl', foldr')
 import Data.Sequence (Seq, ViewL(EmptyL,(:<)), ViewR(EmptyR,(:>)), (><), (<|))
 import Data.Function (on)
 import Data.Functor.Identity (Identity(Identity, runIdentity))
-import Data.Maybe (catMaybes)
 import Data.Time (UTCTime, addUTCTime, diffUTCTime, utc, NominalDiffTime)
 #if MIN_VERSION_time(1,9,0)
 import Data.Time (LocalTime, utcToLocalTime, zonedTimeToLocalTime, diffLocalTime, addLocalTime)
@@ -111,7 +113,6 @@ -- >>> import Data.Function (on)
 -- >>> import Data.Maybe (isJust, fromJust, catMaybes)
 -- >>> import Data.Foldable (toList)
--- >>> import qualified Test.QuickCheck as QC
 -- >>> import Test.QuickCheck ((==>))
 -- >>> without' :: (Int,Int) -> (Int,Int) -> [(Int,Int)]; without' = without
 
@@ -146,19 +147,58 @@     -- ^ does any interval properly intersect the first one?
     maybeBounds :: Interval e i => t i -> Maybe (e,e)
     -- ^ the convex hull of the contents
+    storedIntervals :: Interval e i => t i -> f i
+    -- ^ dump the entire search structure's content
 instance Ord e => IntersectionQuery (ITree e) e Seq where
-    getIntersects = getIntersectsIT
-    getProperIntersects = getProperIntersectsIT
-    someIntersects = someIntersectsIT
+    getIntersects          = getIntersectsIT
+    getProperIntersects    = getProperIntersectsIT
+    someIntersects         = someIntersectsIT
     someProperlyIntersects = someProperlyIntersectsIT
-    maybeBounds = hullOfTree 
-instance Ord e => IntersectionQuery Seq e Seq where
-    getIntersects = findSeq intersects
-    getProperIntersects = findSeq properlyIntersects
-    someIntersects = existsSeq intersects
-    someProperlyIntersects = existsSeq properlyIntersects
-    maybeBounds = hullSeqNonOverlap 
+    maybeBounds            = hullOfTree
+    storedIntervals        = iTreeContents 
+instance Ord e => IntersectionQuery NonNestedSeq e Seq where
+    getIntersects          = (.getSeq) . findSeq intersects
+    getProperIntersects    = (.getSeq) . findSeq properlyIntersects
+    someIntersects         = (.getSeq) . existsSeq intersects
+    someProperlyIntersects = (.getSeq) . existsSeq properlyIntersects
+    maybeBounds            = hullSeqNonNested . getSeq
+    storedIntervals        = getSeq
 
+-- | 'Seq'uences support 'IntersectionQuery' efficiently only in the case 
+-- when the sequence has the property that for 
+-- any split @xs = ys <> zs@ into non-empty parts the convex hull 
+-- of each part is the 'lb' and 'ub' of the leftmost and rightmost element, 
+-- respectively. 
+-- This property is guaranteed by 'fromEndPoints' 
+-- but does not hold in the case where the sequence contains 
+-- nested intervals:
+--
+-- >>> propSplit (\xs -> hullSeqNonNested xs == hullSeq xs) . splitSeq . sortByRight $ Seq.fromList ([(1,3),(2,4),(4,5),(3,6)] :: [(Int,Int)])
+-- False
+--
+-- Thus, when querying against a set of intervals with nesting, you must use an 'ITree' instead. 
+--
+-- prop> forevery genNonNestedIntervalSeq $ \xs -> propSplit (\subseq -> hullSeqNonNested subseq == hullSeq subseq) (splitSeq xs) 
+newtype NonNestedSeq a = FromSortedSeq {getSeq :: Seq a} deriving (Eq,Ord,Show,Functor,Foldable,Traversable)
+instance Semigroup (NonNestedSeq a) where
+    (FromSortedSeq xs) <> (FromSortedSeq ys) = FromSortedSeq (xs <> ys)
+instance Monoid (NonNestedSeq a) where
+    mempty = FromSortedSeq mempty
+    mappend = (<>)
+instance Applicative NonNestedSeq where
+    pure = FromSortedSeq . pure
+    (FromSortedSeq fs) <*> (FromSortedSeq xs) = FromSortedSeq (fs <*> xs)
+-- | Beware that using @<*>@ may destroy non-nestedness.
+instance Alternative NonNestedSeq where
+    empty = mempty
+    (<|>) = (<>)
+-- | Beware that using @>>=@ may destroy non-nestedness.
+instance Monad NonNestedSeq where
+    return = pure
+    (FromSortedSeq xs) >>= k = FromSortedSeq (xs >>= (getSeq.k))
+instance Filtrable NonNestedSeq where
+    mapMaybe f (FromSortedSeq xs) = FromSortedSeq (mapMaybe f xs)
+
 -- | Time types supporting differences
 class TimeDifference t where
     diffTime :: t -> t -> NominalDiffTime
@@ -186,9 +226,9 @@ 
 -- | Find out the overlap of two time intervals.
 --
--- prop> genInterval /\ \i -> overlapTime i i == intervalDuration i
--- prop> genInterval /\* \i j -> not (i `properlyIntersects` j) ==> overlapTime i j == 0
--- prop> genInterval /\* \i j -> overlapTime i j == (sum $ fmap intervalDuration $ maybeIntersection i j)
+-- prop> forevery genInterval     $ \i -> overlapTime i i == intervalDuration i
+-- prop> foreveryPair genInterval $ \i j -> not (i `properlyIntersects` j) ==> overlapTime i j == 0
+-- prop> foreveryPair genInterval $ \i j -> overlapTime i j == (sum $ fmap intervalDuration $ maybeIntersection i j)
 overlapTime :: (TimeDifference t, Interval t i, Interval t j) =>
     i -> j -> NominalDiffTime
 overlapTime i j = let
@@ -198,9 +238,9 @@ 
 -- | Prevailing annotation in the first time interval
 --
--- prop> genInterval /\ \i c -> prevailing i (Seq.singleton (c,i)) == Just (c::Char)
--- prop> genInterval /\ \i -> genLabeledSeq /\ \js -> isJust (prevailing i js) == any (intersects i . snd) js
--- prop> genInterval /\ \i -> genLabeledSeq /\* \js ks -> all (flip elem $ catMaybes [prevailing i js, prevailing i ks]) $ prevailing i (js<>ks)
+-- prop> forevery genInterval $ \i c -> prevailing i (Seq.singleton (c,i)) == Just (c::Char)
+-- prop> foreveryPairOf genInterval genLabeledSeq $ \i js -> isJust (prevailing i js) == any (intersects i . snd) js
+-- prop> forevery genInterval $ \i -> foreveryPair genLabeledSeq $ \js ks -> all (flip elem $ catMaybes [prevailing i js, prevailing i ks]) $ prevailing i (js<>ks)
 prevailing :: (Interval t i, Interval t j, TimeDifference t) =>
     i -> Seq (a,j) -> Maybe a
 prevailing i js =
@@ -223,8 +263,8 @@ 
 -- | the union of two intervals is an interval if they intersect.
 --
--- prop> genInterval /\* \i j -> isJust (maybeUnion i j) ==> fromJust (maybeUnion i j) `contains` i && fromJust (maybeUnion i j) `contains` j
--- prop> genInterval /\* \i j -> i `intersects` j ==> (maybeUnion i j >>= maybeIntersection i) == Just i
+-- prop> foreveryPair genInterval $ \i j -> isJust (maybeUnion i j) ==> fromJust (maybeUnion i j) `contains` i && fromJust (maybeUnion i j) `contains` j
+-- prop> foreveryPair genInterval $ \i j -> i `intersects` j ==> (maybeUnion i j >>= maybeIntersection i) == Just i
 maybeUnion :: (Interval e j, Interval e i, Adjust e i) => j -> i -> Maybe i
 maybeUnion j i = if j `intersects` i
     then Just (adjustBounds (min (lb j)) (max (ub j)) i)
@@ -232,13 +272,13 @@ 
 -- | the intersection of two intervals is either empty or an interval.
 --
--- prop> genInterval /\* \i j -> i `intersects` j ==> i `contains` fromJust (maybeIntersection i j)
+-- prop> foreveryPair genInterval $ \i j -> i `intersects` j ==> i `contains` fromJust (maybeIntersection i j)
 maybeIntersection :: (Interval e j, Interval e i, Adjust e i) => j -> i -> Maybe i
 maybeIntersection j i = if j `intersects` i
     then Just (adjustBounds (max (lb j)) (min (ub j)) i)
     else Nothing
 
--- | convex hull
+-- | /O(n)/ convex hull
 --
 -- prop> \xs -> isJust (hull xs) ==> all (\x -> fromJust (hull xs) `contains` x) (xs :: [(Int,Int)])
 hull :: (Interval e i,Foldable f,Functor f) => f i -> Maybe (e,e)
@@ -257,10 +297,10 @@ -- >>> without' (1,5) (0,1)
 -- [(1,5)]
 --
--- prop> genInterval /\* \i j -> length (i `without` j) <= 2
--- prop> genInterval /\ \i -> i `without` i == []
--- prop> genInterval /\* \i j -> all (contains i) (i `without` j)
--- prop> genInterval /\* \i j -> not $ any (properlyIntersects j) (i `without` j)
+-- prop> foreveryPair genInterval $ \i j -> length (i `without` j) <= 2
+-- prop> forevery     genInterval $ \i -> i `without` i == []
+-- prop> foreveryPair genInterval $ \i j -> all (contains i) (i `without` j)
+-- prop> foreveryPair genInterval $ \i j -> not $ any (properlyIntersects j) (i `without` j)
 without :: (Adjust e i,Interval e j) => i -> j -> [i]
 without i j = if j `contains` i then [] else
     if ub j <= lb i || lb j >= ub i
@@ -276,7 +316,8 @@ -- This function does the expected and groups overlapping intervals
 -- into contiguous blocks.
 --
--- prop> genSortedIntervals /\ all (\xs -> and $ List.zipWith intersects xs (tail xs)) . contiguous
+-- prop> forevery genSortedIntervals $ all (\xs -> and $ List.zipWith intersects xs (tail xs)) . contiguous
+-- prop> forevery genSortedIntervals $ all ((1==).length.components) . contiguous 
 contiguous :: Interval e i => [i] -> [[i]]
 contiguous [] = []
 contiguous (i:is) = (i:js) : contiguous ks where
@@ -287,52 +328,60 @@         else ([],ls)
     go _ [] = ([],[])
 
--- | Connected components of a list sorted by 'sortByLeft',
+-- | Connected components of a list sorted by 'sortByRight',
 -- akin to 'groupBy' 'intersects'.
 -- The precondition is not checked.
 --
--- prop> genSortedIntervals /\ \xs -> all (\i -> any (flip contains i) (components xs)) xs
+-- prop> forevery genSortedIntervals $ \xs -> all (\i -> any (flip contains i) (components xs)) xs
+-- prop> forevery genSortedIntervals $ \xs -> let cs = components xs in all (\(i,j) -> i == j || not (i `intersects` j)) [(c1,c2) | c1 <- cs, c2 <- cs]
 components :: (Interval e i, Adjust e i) => [i] -> [i]
 components [] = []
+-- right-to-left union
+components (x:xs) = let cs = components xs in case cs of
+    [] -> [x]
+    (c:cs') -> case maybeUnion x c of
+        Nothing -> x:cs
+        Just c' -> c':cs'
+{-- left-to-right union
 components (i:is) = c i is where
     c x [] = [x]
     c x (y:ys) = case maybeUnion x y of
         Nothing -> x : c y ys
         Just z  -> c z ys
+--}
 
 -- | same as 'components'. Is there a way to unify both?
 --
--- prop> genSortedIntervals /\ \xs -> componentsSeq (Seq.fromList xs) == Seq.fromList (components xs)
+-- prop> forevery genSortedIntervals   $ \xs -> componentsSeq (Seq.fromList xs) == Seq.fromList (components xs)
+-- prop> forevery genSortedIntervalSeq $ \xs -> let cs = componentsSeq xs in all (\(i,j) -> i == j || not (i `intersects` j)) $ do {c1 <- cs; c2 <- cs; return (c1,c2)}
 componentsSeq :: (Interval e i, Adjust e i) => Seq i -> Seq i
-componentsSeq ys = case Seq.viewl ys of
-    EmptyL  -> empty
-    x :< xs -> c x xs where
-        c a bs = case Seq.viewl bs of
-            EmptyL  -> Seq.singleton a
-            b :< bs' -> case maybeUnion a b of
-                Nothing -> a <| c b bs'
-                Just ab -> c ab bs'
+componentsSeq ys = case Seq.viewr ys of
+    EmptyR  -> empty
+    xs :> x -> c xs x where
+        c bs a = case Seq.viewr bs of
+            EmptyR  -> Seq.singleton a
+            bs' :> b -> case maybeUnion b a of
+                Nothing -> c bs' b Seq.|> a
+                Just ab -> c bs' ab
 
 -- | compute the components of the part of @i@ covered by the intervals.
 --
--- prop> genInterval /\ \i -> genIntervalSeq /\ \js -> all (contains i) (covered i js)
--- prop> genInterval /\ \i -> genIntervalSeq /\ \js -> covered i (covered i js) == covered i js
+-- prop> foreveryPairOf genInterval genIntervalSeq $ \i js -> all (contains i) (covered i js)
+-- prop> foreveryPairOf genInterval genIntervalSeq $ \i js -> covered i (covered i js) == covered i js
 covered :: (Interval e i,Interval e j,Adjust e j) => i -> Seq j -> Seq j
-covered i =
-    let mapMaybe f = foldMap (foldMap Seq.singleton . f)
-    in  componentsSeq . sortByLeft . mapMaybe (maybeIntersection i)
+covered i = componentsSeq . sortByRight . mapMaybe (maybeIntersection i)
 
 -- | 'True' if the first interval is completely covered by the given intervals
 --
--- prop> genInterval /\* \i j -> j `contains` i == i `coveredBy` [j]
--- prop> genInterval /\ \i -> genSortedIntervals /\ \js -> i `coveredBy` js ==> any (flip contains i) (components js)
+-- prop> foreveryPair   genInterval $ \i j -> j `contains` i == i `coveredBy` [j]
+-- prop> foreveryPairOf genInterval genSortedIntervals $ \i js -> i `coveredBy` js ==> any (flip contains i) (components js)
 coveredBy :: (Interval e i, Interval e j, Foldable f) => i -> f j -> Bool
 i `coveredBy` js = null $ foldl (\remains j -> flip without j =<< remains) [endPoints i] js
 
 -- | percentage of coverage of the first interval by the second sequence of intervals
 --
--- prop> genNonEmptyInterval /\ \i -> genIntervalSeq /\ \js -> i `coveredBy` js == (fractionCovered i js >= (1::Rational))
--- prop> genNonEmptyInterval /\ \i -> genNonEmptyIntervalSeq /\ \js -> any (properlyIntersects i) js == (fractionCovered i js > (0::Rational))
+-- prop> foreveryPairOf genNonEmptyInterval genIntervalSeq         $ \i js -> i `coveredBy` js == (fractionCovered i js >= (1::Rational))
+-- prop> foreveryPairOf genNonEmptyInterval genNonEmptyIntervalSeq $ \i js -> any (properlyIntersects i) js == (fractionCovered i js > (0::Rational))
 fractionCovered :: (TimeDifference t, Interval t i, Interval t j, Fractional a) =>
     j -> Seq i -> a
 fractionCovered i xs = let
@@ -351,7 +400,7 @@ --
 -- i.e., 'overlap' is not transitive.
 --
--- prop> genInterval /\* \i j -> i `intersects` j  ==  (overlap i j == EQ)
+-- prop> foreveryPair genInterval $ \i j -> i `intersects` j  ==  (overlap i j == EQ)
 overlap :: (Interval e i, Interval e j) => i -> j -> Ordering
 overlap i j = case (compare (ub i) (lb j),compare (ub j) (lb i)) of
     (LT,_) -> LT
@@ -369,7 +418,7 @@ --
 -- i.e., 'properOverlap' is not transitive.
 --
--- prop> genInterval /\* \i j -> i `properlyIntersects` j  ==  (properOverlap i j == EQ)
+-- prop> foreveryPair genInterval $ \i j -> i `properlyIntersects` j  ==  (properOverlap i j == EQ)
 properOverlap :: (Interval e i, Interval e j) => i -> j -> Ordering
 properOverlap i j = case ((ub i) <= (lb j),(ub j) <= (lb i)) of
     (True,_) -> LT
@@ -381,7 +430,7 @@ -- >>> ((1,2)::(Int,Int)) `intersects` ((2,3)::(Int,Int))
 -- True
 --
--- prop> genInterval /\* \i j -> (lb i <= ub i && lb j <= ub j && i `intersects` j)  ==  (max (lb i) (lb j) <= min (ub i) (ub j))
+-- prop> foreveryPair genInterval $ \i j -> (lb i <= ub i && lb j <= ub j && i `intersects` j)  ==  (max (lb i) (lb j) <= min (ub i) (ub j))
 intersects :: (Interval e i,Interval e j) => i -> j -> Bool
 i `intersects` j = not (ub i < lb j || ub j < lb i)
 -- The definition of 'intersects' yields the following algorithm
@@ -392,15 +441,15 @@ 
 -- | proper intersection.
 --
--- prop> genInterval /\* \i j -> ((i `intersects` j) && not (i `properlyIntersects` j))  ==  (ub i == lb j || ub j == lb i)
+-- prop> foreveryPair genInterval $ \i j -> ((i `intersects` j) && not (i `properlyIntersects` j))  ==  (ub i == lb j || ub j == lb i)
 properlyIntersects :: (Interval e i,Interval e j) => i -> j -> Bool
 i `properlyIntersects` j = not (ub i <= lb j || ub j <= lb i)
 
 -- | subset containment
 --
--- prop> genInterval /\ \i -> i `contains` i
--- prop> genInterval /\* \i j -> (i `contains` j && j `contains` i) == (i==j)
--- prop> genInterval /\* \i j -> i `contains` j == (maybeUnion i j == Just i)
+-- prop> forevery     genInterval $ \i -> i `contains` i
+-- prop> foreveryPair genInterval $ \i j -> (i `contains` j && j `contains` i) == (i==j)
+-- prop> foreveryPair genInterval $ \i j -> i `contains` j == (maybeUnion i j == Just i)
 contains :: (Interval e i,Interval e j) => i -> j -> Bool
 i `contains` j = lb i <= lb j && ub j <= ub i
 
@@ -408,11 +457,12 @@ properlyContains :: (Interval e i,Interval e j) => i -> j -> Bool
 i `properlyContains` j = lb i < lb j && ub i > ub j
 
--- | construct a sorted sequence of intervals
+-- | construct a sorted 'contiguous' sequence of intervals
 -- from a sorted sequence of bounds.
 -- Fails if the input sequence is not sorted.
 --
--- prop> genSortedList /\ \xs -> (components $ toList $ fromEndPoints xs) == if length xs < 2 then [] else [(head xs, last xs)]
+-- prop> forevery genSortedList $ \xs -> (components $ toList $ fromEndPoints xs) == if length xs < 2 then [] else [(head xs, last xs)]
+-- prop> forevery genSortedList $ \xs -> hullSeqNonNested (fromEndPoints xs) == if length xs < 2 then Nothing else Just (head xs,last xs)
 fromEndPoints :: (Ord e) => [e] -> Seq (e,e)
 fromEndPoints [] = empty
 fromEndPoints [_] = empty
@@ -421,48 +471,50 @@     (y,_) :< _ -> (x,y) <| s
     EmptyL     -> error "Intervals.fromEndPoints: this should never happen"
 
--- | lexicographical sort by 'lb', then inverse 'ub'.
+-- | lexicographical sort by 'ub', then inverse 'lb'.
 -- In the resulting list, the intervals intersecting
 -- a given interval form a contiguous sublist.
 --
--- prop> genInterval /\ \i -> genSortedIntervalSeq /\ \js -> toList (getIntersects i js) `List.isSubsequenceOf` toList js
-sortByLeft :: (Interval e i) => Seq i -> Seq i
-sortByLeft = Seq.sortBy (\i j -> compare (lb i) (lb j) <> compare (ub j) (ub i))
+-- prop> foreveryPairOf genInterval genSortedIntervalSeq $ \i js -> toList (getIntersects i (FromSortedSeq js)) `List.isSubsequenceOf` toList js
+-- prop> forevery genSortedIntervalSeq $ \xs -> propSplit (\subseq -> subseq == sortByRight subseq) (splitSeq xs)
+sortByRight :: (Interval e i) => Seq i -> Seq i
+sortByRight = Seq.sortBy (\i j -> compare (ub i) (ub j) <> compare (lb j) (lb i))
 
--- | extract all intervals intersecting a given one.
+-- | /O(n)/ Extract all intervals intersecting a given one.
 intersecting :: (Interval e i,Interval e j) => j -> Seq i -> Seq i
 intersecting j = Seq.filter (intersects j)
 
--- | extract all intervals properly intersecting a given one.
+-- | /O(n)/ Extract all intervals properly intersecting a given one.
 intersectingProperly :: (Interval e i,Interval e j) => j -> Seq i -> Seq i
 intersectingProperly j = Seq.filter (properlyIntersects j)
 --intersectingProperly j = (takeWhileL (properlyIntersects j)).(dropWhileL (not.(properlyIntersects j)))
 
--- | convex hull of a sorted sequence of intervals.
--- the lower bound is guaranteed to be in the leftmost interval,
--- but we have no guarantee of the upper bound.
+-- | /O(n)/ convex hull of a sorted ('sortByRight') sequence of intervals.
+-- the upper bound is guaranteed to be in the rightmost interval,
+-- but we have no guarantee of the lower bound.
 --
--- prop> genSortedIntervalSeq /\ \xs -> hullSeq xs == hull (toList xs)
+-- prop> forevery genSortedIntervalSeq $ \xs -> hullSeq xs == if Seq.null xs then Nothing else Just (minimum (fmap lb xs),maximum (fmap ub xs))
+-- prop> forevery genSortedIntervalSeq $ \xs -> hullSeq xs == hull (toList xs)
 hullSeq :: Interval e i => Seq i -> Maybe (e,e)
-hullSeq xs = case Seq.viewl xs of
-    EmptyL -> Nothing
-    leftmost :< _others -> Just (lb leftmost, maximum (fmap ub xs))
+hullSeq xs = case Seq.viewr xs of
+    EmptyR -> Nothing
+    _others :> rightmost -> Just (minimum (fmap lb xs),ub rightmost)
 
 -- | When you face the problem of matching two series of intervals against each other, 
 -- a streaming approach might be more efficient than transforming 
 -- one of the streams into a search structure. 
 -- This function drops intervals from the list until 
--- the (contiguous, see 'sortByLeft') block of intersecting intervals 
+-- the (contiguous) block of intersecting intervals 
 -- is found. This block (except intervals containing the 'ub' of the query) 
 -- is removed from the stream. 
 -- When used as a state transformer on a stream @[i]@ of non-properly overlapping intervals, 
 -- then one obtains the stream of blocks intersecting the stream of queries. 
 -- 
--- >>> splitIntersecting ((2,5) :: (Int,Int)) ([(0,1),(2,3),(2,2),(3,6),(6,7)] :: [(Int,Int)])
--- ([(2,3),(2,2),(3,6)],[(3,6),(6,7)])
+-- >>> splitIntersecting ((2,5) :: (Int,Int)) ([(0,1),(2,2),(2,3),(3,6),(6,7)] :: [(Int,Int)])
+-- ([(2,2),(2,3),(3,6)],[(3,6),(6,7)])
 --
--- prop> genInterval /\ \i -> genSortedIntervals /\ \js -> fst (splitIntersecting i js) == filter (intersects i) js
--- prop> genInterval /\ \i -> genSortedIntervals /\ \js -> all (\j -> not (ub j < ub i)) (snd (splitIntersecting i js))
+-- prop> foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js' -> let js = toList js' in fst (splitIntersecting i js) == filter (intersects i) js
+-- prop> foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js' -> let js = toList js' in all (\j -> not (ub j < ub i)) (snd (splitIntersecting i js))
 splitIntersecting :: (Interval e i, Interval e j) => i -> [j] -> ([j],[j])
 splitIntersecting _ [] = ([],[])
 splitIntersecting i js@(j:js') = case i `overlap` j of
@@ -482,8 +534,8 @@ -- >>> splitProperlyIntersecting ((2,5) :: (Int,Int))  ([(0,1),(2,3),(2,2),(3,5),(5,6),(6,7)] :: [(Int,Int)])
 -- ([(2,3),(3,5)],[(5,6),(6,7)])
 --
--- prop> genInterval /\ \i -> genSortedIntervals /\ \js -> fst (splitProperlyIntersecting i js) == filter (properlyIntersects i) js
--- prop> genInterval /\ \i -> genSortedIntervals /\ \js -> all (not.contains i) (snd (splitProperlyIntersecting i js))
+-- prop> foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js' -> let js = toList js' in fst (splitProperlyIntersecting i js) == filter (properlyIntersects i) js
+-- prop> foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js' -> let js = toList js' in all (not.properlyContains i) (snd (splitProperlyIntersecting i js))
 splitProperlyIntersecting :: (Interval e i, Interval e j) => i -> [j] -> ([j],[j])
 splitProperlyIntersecting _ [] = ([],[])
 splitProperlyIntersecting i js@(j:js') = case i `properOverlap` j of
@@ -514,13 +566,19 @@ emptyITree = Bin empty
 
 -- | smallest interval covering the entire tree. 'Nothing' if the tree is empty.
+-- 
+-- prop> forevery genSortedIntervalSeq $ \xs -> hullSeq xs == hullOfTree (itree 4 xs)
 hullOfTree :: (Interval e i) => ITree e i -> Maybe (e,e)
-hullOfTree (Bin xs) = hullSeq xs
+hullOfTree (Bin xs) = if Seq.null xs then Nothing else Just (minimum (fmap lb xs),maximum (fmap ub xs))
 hullOfTree (Split _ x _ y _ _) = Just (x,y)
 
+iTreeContents :: ITree e i -> Seq i
+iTreeContents (Bin xs) = xs
+iTreeContents (Split cross _ _ _ left right) = (iTreeContents left) <> cross <> (iTreeContents right)
+
 -- | invariant to be maintained for proper intersection queries
 --
--- prop> invariant . itree 4 . fmap (\(x,y) -> (x, x + QC.getNonNegative y :: Integer))
+-- prop> forevery genIntervalSeq $ \xs -> invariant . itree 4 $ xs
 invariant :: Interval e i => ITree e i -> Bool
 invariant (Bin _) = True
 invariant (Split up x y z left right) = x <= y && y <= z && invUp && invLeft && invRight where
@@ -530,7 +588,7 @@ 
 -- | Intersection query. O(binsize+log(n/binsize)).
 --
--- prop> genInterval /\ \i -> genIntervalSeq /\ \t -> on (==) sortByLeft (getIntersectsIT i $ itree 2 t) (i `intersecting` t)
+-- prop> foreveryPairOf genInterval genIntervalSeq $ \i t -> on (==) sortByRight (getIntersects i $ itree 2 t) (i `intersecting` t)
 getIntersectsIT :: (Interval e i, Interval e j) => i -> ITree e j -> Seq j
 getIntersectsIT i (Bin bin) = i `intersecting` bin
 getIntersectsIT i (Split up x y z left right) = let
@@ -541,7 +599,7 @@ 
 -- | Intersection query. O(binsize+log(n/binsize)).
 --
--- prop> genInterval /\ \i -> genIntervalSeq /\ \t -> on (==) sortByLeft (getProperIntersectsIT i $ itree 2 t) (i `intersectingProperly` t)
+-- prop> foreveryPairOf genInterval genIntervalSeq $ \i t -> on (==) sortByRight (getProperIntersects i $ itree 2 t) (i `intersectingProperly` t)
 getProperIntersectsIT :: (Interval e i, Interval e j) => i -> ITree e j -> Seq j
 getProperIntersectsIT i (Bin bin) = i `intersectingProperly` bin
 getProperIntersectsIT i (Split up x y z left right) = let
@@ -560,7 +618,7 @@ someProperlyIntersectsIT :: (Interval e i, Interval e j) => i -> ITree e j -> Bool
 someProperlyIntersectsIT i = not . null . getProperIntersectsIT i
 
--- | retrieve the left-most interval from the tree, or 'Nothing' if it is empty.
+{-- | retrieve the left-most interval from the tree, or 'Nothing' if it is empty.
 leftmostInterval :: (Interval e i) => ITree e i -> Maybe i
 leftmostInterval (Bin bin) = case Seq.viewl bin of
     EmptyL -> Nothing
@@ -569,7 +627,8 @@     headl xs = case Seq.viewl xs of
         EmptyL -> Nothing
         i :< _ -> Just i
-    in (headl . sortByLeft . Seq.fromList . catMaybes) [leftmostInterval left,headl up,leftmostInterval right]
+    in (headl . sortByRight . Seq.fromList . catMaybes) [leftmostInterval left,headl up,leftmostInterval right]
+--}
 
 -- | transform the interval tree into the tree of hulls
 toTree :: Interval e i => ITree e i -> Tree (e,e)
@@ -582,11 +641,15 @@         (Bin _) -> Tree.Node {Tree.rootLabel = (y,z), Tree.subForest = []}
         _ -> toTree right
 
--- ExtPkg: non-empty allows NonEmpty Seq - makes blockstart total
+-- The only invariant required of a Block is that
+-- its leftmost interval has the same 'lb' as the 
+-- convex hull of the entire Block 
 newtype Block e i = Block (Seq i)
+
+-- ExtPkg: non-empty allows NonEmpty Seq - makes blockstart total
 blockstart :: Interval e i => Block e i -> e
 blockstart (Block xs) = case Seq.viewl xs of
-    EmptyL -> error "empty Block"
+    EmptyL -> error "blockstart: empty Block"
     x :< _ -> lb x
 blocknull :: Block e i -> Bool
 blocknull (Block xs) = null xs
@@ -603,6 +666,9 @@ instance Monoid (Block e i) where
     mempty = Block empty
     mappend = (<>)
+instance Interval e i => Interval e (Block e i) where
+    lb = blockstart
+    ub = maximum . fmap ub
 instance Show i => Show (Block e i) where
     show (Block xs) = "Block "++(show (toList xs))
 
@@ -619,7 +685,7 @@         then (Seq.singleton i,False)
         else return True
 
--- foldr over the list of blocks and gather all intervals
+-- fold over the list of blocks and gather all intervals
 -- overlapping block boundaries. Remove blocks that are rendered empty by this.
 gatherCrossers :: Interval e i => Seq (Block e i) -> (Seq i,Seq (Block e i))
 gatherCrossers blks = case Seq.viewl blks of
@@ -629,24 +695,43 @@         cons = if blocknull block' then id else ((<|) block')
         in (crossers' >< crossers,cons blocks')
     EmptyL -> (empty,empty)
--- after applying gatherCrossers to a sorted list of sorted blocks,
+
+{-- after applying gatherCrossers to a sorted list of sorted blocks,
 -- all intervals within the blocks are contained in the interval
 -- from the blockstart to the blockstart of the next block.
 -- Hence we can use these blocks to build an interval tree,
 -- where the crossers go into certain 'up' components.
+-- 
+-- prop> forevery genIntervalSeq $ invariantCrossers . snd . gatherCrossers . blocksOf 4 . blocksort
+invariantCrossers :: Interval e i => Seq (Block e i) -> Bool
+invariantCrossers blocks = all inv (Seq.zip blocks (Seq.drop 1 blocks)) where
+    inv :: Interval e j => (Block e j,Block e j) -> Bool
+    inv (this,next) = let h = (blockstart this,blockstart next) in all (contains h) this
+-- We checked this property individually but it is subsumed by 'invariant'. 
+--}
 
+
 blocksOf :: Int -> Seq i -> Seq (Block e i)
 blocksOf n = fmap Block . Seq.chunksOf n
 
+-- | The result of 'splitSeq', either the empty sequence, 
+-- a singleton
+-- or two subsequences of roughly the same size
 data SplitSeq a = EmptySeq | SingletonSeq a | TwoSeqs (Seq a) (Seq a) deriving (Show)
 
+-- | re-assemble a split into a sequence
 joinSeq :: SplitSeq a -> Seq a
 joinSeq EmptySeq = empty
 joinSeq (SingletonSeq a) = pure a
 joinSeq (TwoSeqs xs ys) = xs <> ys
 
--- | Split a Sequence in half, needed for the IntersectionQuery instances.  
--- prop> genIntervalSeq /\ \is -> joinSeq (splitSeq is) == is
+-- | test if a sequence property holds for each sequence in the split.
+propSplit :: (Seq a -> Bool) -> SplitSeq a -> Bool
+propSplit p (TwoSeqs xs ys) = p xs && p ys
+propSplit p s = p (joinSeq s)
+
+-- | Split a Sequence in half, needed for the 'IntersectionQuery' instance.  
+-- prop> forevery genIntervalSeq $ \is -> joinSeq (splitSeq is) == is
 splitSeq :: Seq a -> SplitSeq a
 splitSeq xs = let (l,r) = Seq.splitAt (length xs `div` 2) xs in case (null l,null r) of
     (_,True) -> EmptySeq
@@ -695,32 +780,28 @@ -- the resulting tree is a pure binary search tree with bins of
 -- given size as leaves.
 itree :: Interval e i => Int -> Seq i -> ITree e i
-itree n = uncurry ($).(f *** buildFromSeq).gatherCrossers.blocksOf n.srt where
-    srt = Seq.unstableSortBy (compare `on` endPoints)
+itree n = uncurry ($).(f *** buildFromSeq).gatherCrossers.blocksOf n.blocksort where
     f = flip (foldr' insert)
 
+-- We must sort so that 'blockstart' 
+-- yields the 'lb' of the convex hull of the block. 
+-- The rest is not important. 
+blocksort :: Interval e i => Seq i -> Seq i
+blocksort = Seq.unstableSortBy (compare `on` lb)
+
 -- * Non-overlapping intervals
 
--- | /O(log n)/ bounds of an ordered sequence of intervals. 'Nothing', if empty.
+-- | /O(1)/ bounds of an ordered, non-nested sequence of intervals. 'Nothing', if empty.
 --
--- prop> genDisjointIntervalSeq /\ \xs -> hullSeqNonOverlap xs == hullSeq xs
-hullSeqNonOverlap :: Interval e i => Seq i -> Maybe (e,e)
-hullSeqNonOverlap xs = case Seq.viewl xs of
+-- prop> forevery genNonNestedIntervalSeq $ \xs -> hullSeqNonNested xs == hullSeq xs
+hullSeqNonNested :: Interval e i => Seq i -> Maybe (e,e)
+hullSeqNonNested xs = case Seq.viewl xs of
     EmptyL -> Nothing
     leftmost :< others -> Just (lb leftmost, case Seq.viewr others of
-        _ :> rightmost -> maybe (ub rightmost) ub (findLeftmost ((lb rightmost ==).lb) xs)
+        _ :> rightmost -> ub rightmost
         EmptyR         -> ub leftmost)
 
-findLeftmost :: (i -> Bool) -> Seq i -> Maybe i
-findLeftmost p = go where 
-    go xs = case splitSeq xs of
-        EmptySeq           -> Nothing
-        SingletonSeq i     -> if p i then Just i else Nothing
-        TwoSeqs left right -> case go left of
-            foundLeftmost@(Just _) -> foundLeftmost
-            Nothing -> go right
-
--- | Query an ordered 'Seq'uence of non-overlapping intervals
+-- | Query an ordered 'Seq'uence of non-nested intervals
 -- for a predicate @p@ that has the property
 --
 -- @
@@ -729,9 +810,9 @@ --
 -- and return all elements satisfying the predicate.
 --
--- prop> genInterval /\ \i -> genDisjointIntervalSeq /\ \js -> findSeq intersects i js == intersecting i js
+-- prop> foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js -> getIntersects i (FromSortedSeq js) == intersecting i js
 findSeq :: (Interval e i, Interval e j) => (i -> (e,e) -> Bool) -> i -> Seq j -> Seq j
-findSeq p i js = case hullSeqNonOverlap js of
+findSeq p i js = case hullSeqNonNested js of
     Nothing -> empty
     Just h -> if p i h
         then case splitSeq js of
@@ -740,14 +821,14 @@             EmptySeq -> empty -- should never happen
         else empty
 
--- | Query an ordered 'Seq'uence of non-overlapping intervals
+-- | Query an ordered 'Seq'uence of non-nested intervals
 -- for a predicate @p@ that has the property
 --
 -- @
 -- j `contains` k && p i k ==> p i j
 -- @
 existsSeq :: (Interval e i, Interval e j) => (i -> (e,e) -> Bool) -> i -> Seq j -> Bool
-existsSeq p i js = case hullSeqNonOverlap js of
+existsSeq p i js = case hullSeqNonNested js of
     Nothing -> False
     Just h -> if p i h
         then case splitSeq js of

@@ -1,5 +1,5 @@ module Data.IntervalTest (-    genDisjointIntervalSeq,+    genNonNestedIntervalSeq,     genInterval,     genIntervalSeq,     genLabeledSeq,@@ -8,8 +8,9 @@     genSortedIntervals,     genSortedIntervalSeq,     genSortedList,-    (/\),-    (/\*),+    forevery,+    foreveryPair,+    foreveryPairOf     ) where  import Data.Interval@@ -19,7 +20,6 @@ import qualified Data.List as List import Data.Foldable (toList) import Data.Sequence (Seq)-import Data.Function (on) import Data.Time (UTCTime)  import Control.Arrow (first)@@ -30,20 +30,25 @@  type Intv = (UTCTime,UTCTime) -infixr 0 /\, /\*--(/\) :: (Show a, QC.Testable test) => Gen a -> (a -> test) -> QC.Property-(/\) = uncurry QC.forAllShrink+forevery :: (Show a, QC.Testable test) => Gen a -> (a -> test) -> QC.Property+forevery = uncurry QC.forAllShrink -(/\*) ::+foreveryPair ::     (Show a, QC.Testable test) =>     Gen a -> (a -> a -> test) -> QC.Property-(/\*) (gen,shrink) =+foreveryPair (gen,shrink) =     QC.forAllShrink        (liftA2 (,) gen gen)        (\(a,b) -> map (flip (,) b) (shrink a) ++ map ((,) a) (shrink b)) .     uncurry +foreveryPairOf :: (Show a, Show b, QC.Testable test) =>+    Gen a -> Gen b -> (a -> b -> test) -> QC.Property+foreveryPairOf (genA,shrinkA) (genB,shrinkB) = +    QC.forAllShrink+       (liftA2 (,) genA genB)+       (\(a,b) -> map (flip (,) b) (shrinkA a) ++ map ((,) a) (shrinkB b)) .+    uncurry  type Gen a = (QC.Gen a, a -> [a]) @@ -84,12 +89,14 @@ genIntervalSeq =     withShrinkSeq $ fmap Seq.fromList $ QC.listOf $ fst genInterval --- | generate a Sequence of intervals sorted by 'sortByLeft'-genDisjointIntervalSeq :: Gen (Seq Intv)-genDisjointIntervalSeq =+-- | generate a Sequence of non-nested intervals by means of 'fromEndPoints'+genNonNestedIntervalSeq :: Gen (Seq Intv)+genNonNestedIntervalSeq =     withShrinkSeq $-    filterM (const QC.arbitrary) . sortByLeft . fromEndPoints . List.sort+    filterM (const QC.arbitrary) . fromEndPoints . List.sort         =<< QC.listOf genUTCTime+-- TODO: these are also non-properly-overlapping, but we wish to include +-- non-containment overlaps in the tests.  genNonEmptyIntervalSeq :: Gen (Seq Intv) genNonEmptyIntervalSeq =@@ -104,10 +111,10 @@ genSortedIntervals :: Gen [Intv] genSortedIntervals =     withShrinkList $-    fmap (List.sortBy (compare `on` fst)) $ QC.listOf $ fst genInterval+    fmap (List.sortBy (\i j -> compare (ub i) (ub j) <> compare (lb j) (lb i))) $ QC.listOf $ fst genInterval  genSortedIntervalSeq :: Gen (Seq Intv)-genSortedIntervalSeq = first (fmap sortByLeft) genIntervalSeq+genSortedIntervalSeq = first (fmap sortByRight) genIntervalSeq  genSortedList :: Gen [Int] genSortedList = withShrinkList $ fmap List.sort QC.arbitrary