diff options
| author | Will Thompson <will@willthompson.co.uk> | 2012-01-13 15:36:47 +0000 |
|---|---|---|
| committer | Will Thompson <will@willthompson.co.uk> | 2012-01-13 15:37:17 +0000 |
| commit | 8166e01496aa61b08466d821d7b77e0f87b83012 (patch) | |
| tree | e85951d8e7a8e4f9dda2e6f8511ffb3b5e45687c | |
| parent | 2a2f4846587d79210924263d0f33977ce11b2c6b (diff) | |
Regions: add regionSelectionAppend
| -rw-r--r-- | Bustle/Regions.hs | 15 | ||||
| -rw-r--r-- | Test/Regions.hs | 9 |
2 files changed, 24 insertions, 0 deletions
diff --git a/Bustle/Regions.hs b/Bustle/Regions.hs index 1ad535c..9774b83 100644 --- a/Bustle/Regions.hs +++ b/Bustle/Regions.hs @@ -10,6 +10,7 @@ module Bustle.Regions , RegionSelection (..) , regionSelectionNew + , regionSelectionAppend , regionSelectionUpdate , regionSelectionSelect , regionSelectionUp @@ -79,6 +80,20 @@ regionSelectionNew rs where sorted = sort (map fst rs) +regionSelectionAppend :: Regions a + -> RegionSelection a + -> RegionSelection a +regionSelectionAppend [] old = old +regionSelectionAppend regions@((newFirst, _):_) old = + case rsCurrent (regionSelectionLast old) of + Nothing -> new + Just (oldLast, _) -> + if oldLast < newFirst && nonOverlapping [oldLast, newFirst] + then old { rsAfter = rsAfter old ++ rsAfter new } + else error "regionSelectionAppend: new regions overlap old regions" + where + new = regionSelectionNew regions + regionSelectionUpdate :: Double -> RegionSelection a -> RegionSelection a diff --git a/Test/Regions.hs b/Test/Regions.hs index 447a011..383fb57 100644 --- a/Test/Regions.hs +++ b/Test/Regions.hs @@ -148,6 +148,15 @@ prop_SelectWorks vr@(ValidRegions regions) = forAll (elements regions) $ \ r@(s, x) -> Just r == rsCurrent (regionSelectionSelect x rs) +prop_Append :: (Eq a, Show a) + => ValidRegions a + -> Property +prop_Append vr@(ValidRegions regions) = + forAll (choose (0, length regions - 1)) $ \i -> + let as = take i regions + bs = drop i regions + in regionSelectionAppend bs (regionSelectionNew as) == regionSelectionNew regions + runTests = $quickCheckAll main = do |