summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRossPaterson <>2018-12-06 14:48:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-12-06 14:48:00 (GMT)
commit2b598a9fbe202e2b809ec0dc8fea5c40771930e1 (patch)
tree7c20db11652ce6fdf48f497623dd6f33b550f218
parent119448ac76767a089fe71d13972da78911ad16ca (diff)
version 0.1.4.2HEAD0.1.4.2master
-rw-r--r--Data/FingerTree.hs2
-rw-r--r--changelog3
-rw-r--r--fingertree.cabal4
-rw-r--r--tests/ft-properties.hs32
4 files changed, 38 insertions, 3 deletions
diff --git a/Data/FingerTree.hs b/Data/FingerTree.hs
index ee4b316..a0b85aa 100644
--- a/Data/FingerTree.hs
+++ b/Data/FingerTree.hs
@@ -966,7 +966,7 @@ searchTree p vl (Deep _ pr m sf) vr
| p vlpm vsr = let Split ml xs mr = searchTree p vlp m vsr
Split l x r = searchNode p (vlp `mappend` measure ml) xs (measure mr `mappend` vsr)
in Split (deepR pr ml l) x (deepL r mr sf)
- | otherwise = let Split l x r = searchDigit p vm sf vr
+ | otherwise = let Split l x r = searchDigit p vlpm sf vr
in Split (deepR pr m l) x (maybe Empty digitToTree r)
where
vlp = vl `mappend` measure pr
diff --git a/changelog b/changelog
index 78bad06..16133a6 100644
--- a/changelog
+++ b/changelog
@@ -1,5 +1,8 @@
-*-change-log-*-
+0.1.4.2 Ross Paterson <R.Paterson@city.ac.uk> Dec 2018
+ * Fixed bug in search
+
0.1.4.1 Ross Paterson <R.Paterson@city.ac.uk> Mar 2018
* Disabled Generic instances for GHC <= 7.6
diff --git a/fingertree.cabal b/fingertree.cabal
index 97bebed..fcca371 100644
--- a/fingertree.cabal
+++ b/fingertree.cabal
@@ -1,6 +1,6 @@
Name: fingertree
-Version: 0.1.4.1
-Cabal-Version: >= 1.18
+Version: 0.1.4.2
+Cabal-Version: 1.18
Copyright: (c) 2006 Ross Paterson, Ralf Hinze
License: BSD3
License-File: LICENSE
diff --git a/tests/ft-properties.hs b/tests/ft-properties.hs
index 7c0ef30..d2b2204 100644
--- a/tests/ft-properties.hs
+++ b/tests/ft-properties.hs
@@ -22,6 +22,7 @@ import Data.Foldable (Foldable(foldMap, foldl, foldr), toList, all)
import Data.Functor ((<$>))
import Data.Traversable (traverse)
import Data.List (inits)
+import Data.Maybe (listToMaybe)
import Data.Monoid (Monoid(..))
main :: IO ()
@@ -40,6 +41,8 @@ main = defaultMainWithOpts
, testProperty "null" prop_null
, testProperty "viewl" prop_viewl
, testProperty "viewr" prop_viewr
+ , testCase "search" test_search
+ , testProperty "search" prop_search
, testProperty "split" prop_split
, testProperty "takeUntil" prop_takeUntil
, testProperty "dropUntil" prop_dropUntil
@@ -154,6 +157,35 @@ prop_viewr xs =
EmptyR -> Prelude.null (toList xs)
xs' :> x -> valid xs' && toList xs == toList xs' ++ [x]
+prop_search :: Int -> Seq A -> Bool
+prop_search n xs =
+ case search p xs of
+ Position _ b _ -> Just b == indexFromEnd n (toList xs)
+ OnLeft -> n >= len || null xs
+ OnRight -> n < 0
+ Nowhere -> error "impossible: the predicate is monotonic"
+ where p vl vr = Prelude.length vl >= len - n && Prelude.length vr <= n
+
+ len = length xs
+
+ indexFromEnd :: Int -> [a] -> Maybe a
+ indexFromEnd i = listToMaybe . drop i . Prelude.reverse
+
+
+test_search :: Assertion
+test_search = do
+ lookupByIndexFromEnd xs1 1 @?= Just (A 4)
+ lookupByIndexFromEnd xs2 1 @?= Just (A 4)
+ where
+ xs1 = Deep (map A [1..5]) (Four (A 1) (A 2) (A 3) (A 4)) Empty (One (A 5))
+ xs2 = Deep (map A [1..5]) (One (A 1)) Empty (Four (A 2) (A 3) (A 4) (A 5))
+ lookupByIndexFromEnd xs n =
+ let len = length xs
+ p vl vr = Prelude.length vl >= len - n && Prelude.length vr <= n
+ in case search p xs of
+ Position _ x _ -> Just x
+ _ -> Nothing
+
prop_split :: Int -> Seq A -> Bool
prop_split n xs =
toListPair' (split p xs) ~= Prelude.splitAt n (toList xs)