git.iko.soy/typeable/bloodhound
on master help sign in
Merge pull request #150 from bitemyapp/149-qc-failure

Fix quickcheck failure due to ambiguous parse

commit0027a4550669e69b10d81e592ee2243de7a68d14 authorChris Allen <cma@bitemyapp.com> dateThu 3 Nov 2016, 17:04 (10 years ago) parent8930ea1076f69c
1 file changed+35−9
tests/tests.hs+35−9
tests/tests.hs+35−9
@@ -1,5 +1,6 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE DeriveDataTypeable #-}
34{-# LANGUAGE DeriveGeneric #-}
45{-# LANGUAGE FlexibleContexts #-}
56{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -143,8 +144,8 @@ is v = getServerVersion >>= \x -> return $ x == Just v
143144when' :: Monad m => m Bool -> m () -> m ()
144145when' b f = b >>= \x -> when x f
145146
146−(==~) :: (ApproxEq a, Show a) => a -> a -> Property
147−a ==~ b = counterexample (show a ++ " !=~ " ++ show b) (a =~ b)
147+(==~) :: (ApproxEq a) => a -> a -> Property
148+a ==~ b = counterexample (showApproxEq a ++ " !=~ " ++ showApproxEq b) (a =~ b)
148149
149150propJSON :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, ApproxEq a, Typeable a) => Proxy a -> Spec
150151propJSON _ = prop testName $ \(a :: a) ->
@@ -451,14 +452,18 @@ class ApproxEq a where
451452 default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool
452453 a =~ b = gApproxEq (G.from a) (G.from b)
453454
455+ showApproxEq :: a -> String
456+ default showApproxEq :: (Show a) => a -> String
457+ showApproxEq = show
458+
454459instance ApproxEq NominalDiffTime where (=~) = (==)
455460instance ApproxEq UTCTime where (=~) = (==)
456461instance ApproxEq Text where (=~) = (==)
457462instance ApproxEq Bool where (=~) = (==)
458463instance ApproxEq Int where (=~) = (==)
459464instance ApproxEq Double where (=~) = (==)
460−instance ApproxEq a => ApproxEq (NonEmpty a)
461−instance ApproxEq a => ApproxEq (Maybe a)
465+instance (ApproxEq a, Show a) => ApproxEq (NonEmpty a)
466+instance (ApproxEq a, Show a) => ApproxEq (Maybe a)
462467instance ApproxEq GeoPoint
463468instance ApproxEq Regexp
464469instance ApproxEq RangeValue
@@ -575,12 +580,14 @@ instance ApproxEq AllocationPolicy
575580instance ApproxEq Char
576581instance ApproxEq Vers.Version where
577582 (=~) = (==)
578−instance ApproxEq a => ApproxEq [a] where
583+instance (ApproxEq a, Show a) => ApproxEq [a] where
579584 as =~ bs = and (zipWith (=~) as bs)
580−instance (ApproxEq l, ApproxEq r) => ApproxEq (Either l r) where
585+instance (ApproxEq l, Show l, ApproxEq r, Show r) => ApproxEq (Either l r) where
581586 Left a =~ Left b = a =~ b
582587 Right a =~ Right b = a =~ b
583588 _ =~ _ = False
589+ showApproxEq (Left x) = "Left " <> showApproxEq x
590+ showApproxEq (Right x) = "Right " <> showApproxEq x
584591instance ApproxEq NodeAttrFilter
585592instance ApproxEq NodeAttrName
586593instance ApproxEq BuildHash
@@ -595,6 +602,10 @@ instance ApproxEq UpdatableIndexSetting where
595602 RoutingAllocationRequire a =~ RoutingAllocationRequire b =
596603 NE.sort a =~ NE.sort b
597604 a =~ b = a == b
605+ showApproxEq (RoutingAllocationInclude xs) = show (RoutingAllocationInclude (NE.sort xs))
606+ showApproxEq (RoutingAllocationExclude xs) = show (RoutingAllocationExclude (NE.sort xs))
607+ showApproxEq (RoutingAllocationRequire xs) = show (RoutingAllocationRequire (NE.sort xs))
608+ showApproxEq x = show x
598609
599610
600611noDuplicates :: Eq a => [a] -> Bool
@@ -655,8 +666,8 @@ getSource = fmap _source . foundResult
655666grabFirst :: Either EsError (SearchResult a) -> Either EsError a
656667grabFirst r =
657668 case fmap (hitSource . head . hits . searchHits) r of
658− (Left e) -> Left e
659− (Right Nothing) -> Left (EsError 500 "Source was missing")
669+ (Left e) -> Left e
670+ (Right Nothing) -> Left (EsError 500 "Source was missing")
660671 (Right (Just x)) -> Right x
661672
662673-------------------------------------------------------------------------------
@@ -892,6 +903,21 @@ $(derive makeArbitrary ''CompoundFormat)
892903$(derive makeArbitrary ''FsSnapshotRepo)
893904$(derive makeArbitrary ''SnapshotRepoName)
894905
906+newtype UpdatableIndexSetting' = UpdatableIndexSetting' UpdatableIndexSetting
907+ deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)
908+
909+instance Arbitrary UpdatableIndexSetting' where
910+ arbitrary = do
911+ settings <- arbitrary
912+ return $ UpdatableIndexSetting' $ case settings of
913+ RoutingAllocationInclude xs -> RoutingAllocationInclude (dropDuplicateAttrNames xs)
914+ RoutingAllocationExclude xs -> RoutingAllocationExclude (dropDuplicateAttrNames xs)
915+ RoutingAllocationRequire xs -> RoutingAllocationRequire (dropDuplicateAttrNames xs)
916+ x -> x
917+ where
918+ dropDuplicateAttrNames = NE.fromList . L.nubBy sameAttrName . NE.toList
919+ sameAttrName a b = nodeAttrFilterName a == nodeAttrFilterName b
920+
895921main :: IO ()
896922main = hspec $ do
897923
@@ -1808,7 +1834,7 @@ main = hspec $ do
18081834 propJSON (Proxy :: Proxy Term)
18091835 propJSON (Proxy :: Proxy MultiMatchQuery)
18101836 propJSON (Proxy :: Proxy IndexSettings)
1811− propJSON (Proxy :: Proxy UpdatableIndexSetting)
1837+ propJSON (Proxy :: Proxy UpdatableIndexSetting')
18121838 propJSON (Proxy :: Proxy ReplicaBounds)
18131839 propJSON (Proxy :: Proxy Bytes)
18141840 propJSON (Proxy :: Proxy AllocationPolicy)