a72311a · typeable/bloodhound

git.iko.soy/typeable/bloodhound

WIP: fix several bugs with parsers, more to go

Also caught a bug in one of the existing ToJSON instances

commita72311a60b427ae541b926e6022ea60b28b3063b authorMichael Xavier <michael@michaelxavier.net> dateFri 23 Oct 2015, 22:05 (11 years ago) parente2f991e

3 files changed+323−72

compare with master

unifiedsplit

bloodhound.cabal+5−2 src/Database/Bloodhound/Types.hs+79−39 tests/tests.hs+239−31

bloodhound.cabal+5−2

@@ -45,7 +45,8 @@ library

4545 data-default-class,

4646 blaze-builder,

4747 unordered-containers,

48− mtl-compat

48+ mtl-compat,

49+ hashable

4950 default-language: Haskell2010

5051

5152test-suite tests

@@ -68,7 +69,9 @@ test-suite tests

6869 vector,

6970 unordered-containers >= 0.2.5.0 && <0.3,

7071 mtl,

71− quickcheck-properties

72+ quickcheck-properties,

73+ derive,

74+ quickcheck-instances

7275 default-language: Haskell2010

7376

7477test-suite doctests

src/Database/Bloodhound/Types.hs+79−39

@@ -251,6 +251,7 @@ import Data.Aeson.Types (Pair, Parser, emptyObject,

251251 parseMaybe)

252252import qualified Data.ByteString.Lazy.Char8 as L

253253import Data.Char

254+import Data.Hashable (Hashable)

254255import qualified Data.HashMap.Strict as HM

255256import Data.List (foldl', nub)

256257import Data.List.NonEmpty (NonEmpty (..), toList)

@@ -266,6 +267,8 @@ import GHC.Generics (Generic)

266267import Network.HTTP.Client

267268import qualified Network.HTTP.Types.Method as NHTM

268269

270+import Debug.Trace

271+

269272import Database.Bloodhound.Types.Class

270273

271274-- $setup

@@ -711,8 +714,6 @@ newtype BoostTerms =

711714-}

712715newtype MinimumMatch =

713716 MinimumMatch Int deriving (Eq, Show, Generic, ToJSON, FromJSON)

714−newtype MinimumMatchText =

715− MinimumMatchText Text deriving (Eq, Show, ToJSON, FromJSON)

716717newtype DisableCoord =

717718 DisableCoord Bool deriving (Eq, Show, Generic, ToJSON, FromJSON)

718719newtype IgnoreTermFrequency =

@@ -1722,18 +1723,24 @@ instance FromJSON Filter where

17221723 <*> o .:? "_cache" .!= defaultCache

17231724 orFilter o = OrFilter <$> o .: "filters"

17241725 <*> o .:? "_cache" .!= defaultCache

1725− notFilter o = NotFilter <$> o .: "filters"

1726+ notFilter o = NotFilter <$> o .: "filter"

17261727 <*> o .: "_cache" .!= defaultCache

1727− identityFilter () = pure IdentityFilter

1728+ identityFilter :: Object -> Parser Filter

1729+ identityFilter m

1730+ | HM.null m = pure IdentityFilter

1731+ | otherwise = fail ("Identityfilter expected empty object but got " <> show m)

17281732 boolFilter = pure . BoolFilter

17291733 existsFilter o = ExistsFilter <$> o .: "field"

17301734 geoBoundingBoxFilter = pure . GeoBoundingBoxFilter

1731− geoDistanceFilter o = flip fieldTagged o $ \fn o' -> do

1732− gp <- GeoPoint fn <$> parseJSON (Object o')

1733− GeoDistanceFilter gp <$> o .: "distance"

1734− <*> o .: "distance_type"

1735− <*> o .: "optimize_bbox"

1736− <*> o .:? "_cache" .!= defaultCache

1735+ geoDistanceFilter o = do

1736+ case HM.toList (deleteSeveral ["distance", "distance_type", "optimize_bbox", "_cache"] o) of

1737+ [(fn, v)] -> do

1738+ gp <- GeoPoint (FieldName fn) <$> parseJSON v

1739+ GeoDistanceFilter gp <$> o .: "distance"

1740+ <*> o .: "distance_type"

1741+ <*> o .: "optimize_bbox"

1742+ <*> o .:? "_cache" .!= defaultCache

1743+ _ -> fail "Could not find GeoDistanceFilter field name"

17371744 geoDistanceRangeFilter o = flip fieldTagged o $ \fn o' -> do

17381745 gp <- GeoPoint fn <$> parseJSON (Object o')

17391746 rng <- DistanceRange <$> o .: "from" <*> o .: "to"

@@ -1745,21 +1752,27 @@ instance FromJSON Filter where

17451752 missingFilter o = MissingFilter <$> o .: "field"

17461753 <*> o .: "existence"

17471754 <*> o .: "null_value"

1748− prefixFilter o = flip fieldTagged o $ \fn o' -> PrefixFilter fn <$> parseJSON (Object o')

1749− <*> o .:? "_cache" .!= defaultCache

1755+ prefixFilter o = case HM.toList (HM.delete "_cache" o) of

1756+ [(fn, String v)] -> PrefixFilter (FieldName fn) v <$> o .:? "_cache" .!= defaultCache

1757+ _ -> fail "Could not parse PrefixFilter"

1758+

17501759 queryFilter q = pure (QueryFilter q False)

17511760 fqueryFilter o = QueryFilter <$> o .: "query" <*> pure True

1752− rangeFilter o = flip fieldTagged o $ \fn o' -> RangeFilter fn <$> parseJSON (Object o')

1753− <*> o .: "execution"

1754− <*> o .:? "_cache" .!= defaultCache

1761+ rangeFilter o = case HM.toList (deleteSeveral ["execution", "_cache"] o) of

1762+ [(fn, v)] -> RangeFilter (FieldName fn)

1763+ <$> parseJSON v

1764+ <*> o .: "execution"

1765+ <*> o .:? "_cache" .!= defaultCache

1766+ _ -> fail "Could not find field name for RangeFilter"

17551767 regexpFilter = fieldTagged $ \fn o -> RegexpFilter fn <$> o .: "value"

17561768 <*> o .: "flags"

17571769 <*> o .: "_name"

17581770 <*> o .:? "_cache" .!= defaultCache

17591771 <*> o .: "_cache_key"

1760− termFilter o = flip fieldTagged o $ \(FieldName fn) o' -> do

1761− trm <- Term fn <$> parseJSON (Object o')

1762− TermFilter trm <$> o .: "_cache" .!= defaultCache

1772+ termFilter o = case HM.toList (HM.delete "_cache" o) of

1773+ [(termField, String termVal)] -> TermFilter (Term termField termVal)

1774+ <$> o .:? "_cache" .!= defaultCache

1775+ _ -> fail "Could not find term field for TermFilter"

17631776

17641777fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a

17651778fieldTagged f o = case HM.toList o of

@@ -1866,13 +1879,13 @@ instance ToJSON Query where

18661879 object [ "simple_query_string" .= query ]

18671880

18681881instance FromJSON Query where

1869− parseJSON = withObject "Query" parse

1882+ parseJSON v = withObject "Query" parse v

18701883 where parse o = termQuery `taggedWith` "term"

18711884 <|> termsQuery `taggedWith` "terms"

18721885 <|> idsQuery `taggedWith` "ids"

18731886 <|> queryQueryStringQuery `taggedWith` "query_string"

18741887 <|> queryMatchQuery `taggedWith` "match"

1875− <|> queryMultiMatchQuery o --TODO: is this a precedence issue?

1888+ <|> queryMultiMatchQuery --TODO: is this a precedence issue?

18761889 <|> queryBoolQuery `taggedWith` "bool"

18771890 <|> queryBoostingQuery `taggedWith` "boosting"

18781891 <|> queryCommonTermsQuery `taggedWith` "common"

@@ -1895,8 +1908,8 @@ instance FromJSON Query where

18951908 <|> queryRegexpQuery `taggedWith` "regexp"

18961909 <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"

18971910 where taggedWith parser k = parser =<< o .: k

1898− termQuery o = TermQuery <$> parseJSON (Object o)

1899− <*> o .:? "boost"

1911+ termQuery = fieldTagged $ \(FieldName fn) o ->

1912+ TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"

19001913 termsQuery o = case HM.toList o of

19011914 [(fn, vs)] -> do vals <- parseJSON vs

19021915 case vals of

@@ -1907,7 +1920,7 @@ instance FromJSON Query where

19071920 <*> o .: "values"

19081921 queryQueryStringQuery = pure . QueryQueryStringQuery

19091922 queryMatchQuery = pure . QueryMatchQuery

1910− queryMultiMatchQuery = undefined

1923+ queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v

19111924 queryBoolQuery = pure . QueryBoolQuery

19121925 queryBoostingQuery = pure . QueryBoostingQuery

19131926 queryCommonTermsQuery = pure . QueryCommonTermsQuery

@@ -2071,7 +2084,7 @@ instance FromJSON QueryStringQuery where

20712084

20722085instance ToJSON RangeQuery where

20732086 toJSON (RangeQuery (FieldName fieldName) range boost) =

2074− object [ fieldName .= conjoined ]

2087+ object [ fieldName .= object conjoined ]

20752088 where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)

20762089

20772090instance FromJSON RangeQuery where

@@ -2312,7 +2325,7 @@ instance ToJSON FuzzyLikeThisQuery where

23122325instance FromJSON FuzzyLikeThisQuery where

23132326 parseJSON = withObject "FuzzyLikeThisQuery" parse

23142327 where parse o = FuzzyLikeThisQuery

2315− <$> o .: "fields"

2328+ <$> o .:? "fields" .!= []

23162329 <*> o .: "like_text"

23172330 <*> o .: "max_query_terms"

23182331 <*> o .: "ignore_tf"

@@ -2342,7 +2355,7 @@ instance ToJSON DisMaxQuery where

23422355instance FromJSON DisMaxQuery where

23432356 parseJSON = withObject "DisMaxQuery" parse

23442357 where parse o = DisMaxQuery

2345− <$> o .: "queries"

2358+ <$> o .:? "queries" .!= []

23462359 <*> o .: "tie_breaker"

23472360 <*> o .:? "boost"

23482361

@@ -2467,6 +2480,20 @@ instance ToJSON MultiMatchQuery where

24672480 , "max_expansions" .= maxEx

24682481 , "lenient" .= lenient ]

24692482

2483+instance FromJSON MultiMatchQuery where

2484+ parseJSON = withObject "MultiMatchQuery" parse

2485+ where parse raw = do o <- raw .: "multi_match"

2486+ MultiMatchQuery

2487+ <$> o .:? "fields" .!= []

2488+ <*> o .: "query"

2489+ <*> o .: "operator"

2490+ <*> o .: "zero_terms_query"

2491+ <*> o .:? "tiebreaker"

2492+ <*> o .:? "type"

2493+ <*> o .:? "cutoff_frequency"

2494+ <*> o .:? "analyzer"

2495+ <*> o .:? "max_expansions"

2496+ <*> o .:? "lenient"

24702497

24712498instance ToJSON MultiMatchQueryType where

24722499 toJSON MultiMatchBestFields = "best_fields"

@@ -2603,12 +2630,16 @@ instance FromJSON AliasRouting where

26032630 parseJSON = withObject "AliasRouting" parse

26042631 where parse o = parseAll o <|> parseGranular o

26052632 parseAll o = AllAliasRouting <$> o .: "routing"

2606− parseGranular o = GranularAliasRouting <$> o .:? "search_routing"

2607− <*> o .:? "index_routing"

2633+ parseGranular o = do

2634+ sr <- o .:? "search_routing"

2635+ ir <- o .:? "index_routing"

2636+ if isNothing sr && isNothing ir

2637+ then fail "Both search_routing and index_routing can't be blank"

2638+ else return (GranularAliasRouting sr ir)

26082639

26092640instance FromJSON IndexAliasCreate where

26102641 parseJSON v = withObject "IndexAliasCreate" parse v

2611− where parse o = IndexAliasCreate <$> parseJSON v

2642+ where parse o = IndexAliasCreate <$> optional (parseJSON v)

26122643 <*> o .:? "filter"

26132644

26142645instance ToJSON SearchAliasRouting where

@@ -2700,6 +2731,9 @@ fastVectorHighPairs (Just

27002731 ++ commonHighlightPairs fvCom

27012732 ++ nonPostingsToPairs fvNonPostSettings

27022733

2734+deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v

2735+deleteSeveral ks hm = foldr HM.delete hm ks

2736+

27032737commonHighlightPairs :: Maybe CommonHighlight -> [Pair]

27042738commonHighlightPairs Nothing = []

27052739commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder

@@ -2778,10 +2812,10 @@ instance ToJSON ScoreType where

27782812

27792813instance FromJSON ScoreType where

27802814 parseJSON = withText "ScoreType" parse

2781− where parse "max" = pure ScoreTypeMax

2782− parse "avg" = pure ScoreTypeAvg

2783− parse "sum" = pure ScoreTypeSum

2784− parse "non" = pure ScoreTypeNone

2815+ where parse "max" = pure ScoreTypeMax

2816+ parse "avg" = pure ScoreTypeAvg

2817+ parse "sum" = pure ScoreTypeSum

2818+ parse "none" = pure ScoreTypeNone

27852819 parse t = fail ("Unexpected ScoreType: " <> show t)

27862820

27872821instance ToJSON Distance where

@@ -2795,7 +2829,12 @@ instance FromJSON Distance where

27952829 parseJSON = withText "Distance" parse

27962830 where parse t = Distance <$> parseCoeff nT

27972831 <*> parseJSON (String unitT)

2798− where (nT, unitT) = T.span isNumber t

2832+ where (nT, unitT) = T.span validForNumber t

2833+ -- may be a better way to do this

2834+ validForNumber '-' = True

2835+ validForNumber '.' = True

2836+ validForNumber 'e' = True

2837+ validForNumber c = isNumber c

27992838 parseCoeff "" = fail "Empty string cannot be parsed as number"

28002839 parseCoeff s = return (read (T.unpack s))

28012840

@@ -2857,11 +2896,12 @@ instance ToJSON GeoBoundingBoxConstraint where

28572896

28582897instance FromJSON GeoBoundingBoxConstraint where

28592898 parseJSON = withObject "GeoBoundingBoxConstraint" parse

2860− where parse o = flip fieldTagged o $ \fn o' ->

2861− GeoBoundingBoxConstraint fn

2862− <$> parseJSON (Object o')

2863− <*> o .:? "cache" .!= defaultCache

2864− <*> o .: "type"

2899+ where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of

2900+ [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)

2901+ <$> parseJSON v

2902+ <*> o .:? "_cache" .!= defaultCache

2903+ <*> o .: "type"

2904+ _ -> fail "Could not find field name for GeoBoundingBoxConstraint"

28652905

28662906instance ToJSON GeoFilterType where

28672907 toJSON GeoFilterMemory = String "memory"

tests/tests.hs+239−31

@@ -1,6 +1,7 @@

11{-# LANGUAGE DeriveGeneric #-}

22{-# LANGUAGE OverloadedStrings #-}

33{-# LANGUAGE ScopedTypeVariables #-}

4+{-# LANGUAGE TemplateHaskell #-}

45{-# OPTIONS_GHC -fno-warn-orphans #-}

56module Main where

@@ -9,21 +10,25 @@ import Control.Exception

910import Control.Monad

1011import Control.Monad.Reader

1112import Data.Aeson

13+import Data.Aeson.Types (parseEither)

14+import Data.DeriveTH

1215import qualified Data.HashMap.Strict as HM

1316import Data.List (nub)

1417import Data.List.NonEmpty (NonEmpty (..))

1518import qualified Data.List.NonEmpty as NE

1619import qualified Data.Map.Strict as M

1720import Data.Monoid

21+import Data.Proxy

1822import Data.Text (Text)

1923import qualified Data.Text as T

2024import Data.Time.Calendar (Day (..))

2125import Data.Time.Clock (UTCTime (..),

2226 secondsToDiffTime)

27+import Data.Typeable

2328import qualified Data.Vector as V

2429import Database.Bloodhound

2530import GHC.Generics (Generic)

26−import Network.HTTP.Client

31+import Network.HTTP.Client hiding (Proxy)

2732import qualified Network.HTTP.Types.Status as NHTS

2833import Prelude hiding (filter)

2934import Test.Hspec

@@ -31,6 +36,7 @@ import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)

3136

3237import Test.Hspec.QuickCheck (prop)

3338import Test.QuickCheck

39+import Test.QuickCheck.Instances ()

3440

3541testServer :: Server

3642testServer = Server "http://localhost:9200"

@@ -101,6 +107,12 @@ is v = testServerBranch >>= \x -> return $ x == Just (serverBranch v)

101107when' :: Monad m => m Bool -> m () -> m ()

102108when' b f = b >>= \x -> when x f

103109

110+propJSON :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, Eq a, Typeable a) => Proxy a -> Spec

111+propJSON _ = prop testName $ \(a :: a) ->

112+ parseEither parseJSON (toJSON a) === Right a

113+ where testName = show ty <> " FromJSON/ToJSON roundtrips"

114+ ty = typeOf (undefined :: a)

115+

104116data Location = Location { lat :: Double

105117 , lon :: Double } deriving (Eq, Generic, Show)

106118

@@ -265,42 +277,12 @@ instance ToJSON BulkTest where

265277noDuplicates :: Eq a => [a] -> Bool

266278noDuplicates xs = nub xs == xs

267279

268−instance Arbitrary RegexpFlags where

269− arbitrary = oneof [ pure AllRegexpFlags

270− , pure NoRegexpFlags

271− , SomeRegexpFlags <$> arbitrary

272− ]

273−

274280instance Arbitrary a => Arbitrary (NonEmpty a) where

275281 arbitrary = liftA2 (:|) arbitrary arbitrary

276282

277−instance Arbitrary RegexpFlag where

278− arbitrary = oneof [ pure AnyString

279− , pure Automaton

280− , pure Complement

281− , pure Empty

282− , pure Intersection

283− , pure Interval

284− ]

285−

286283arbitraryScore :: Gen Score

287284arbitraryScore = fmap getPositive <$> arbitrary

288285

289−instance Arbitrary Text where

290− arbitrary = T.pack <$> arbitrary

291−

292−instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (M.Map k v) where

293− arbitrary = M.fromList <$> arbitrary

294−

295−instance Arbitrary IndexName where

296− arbitrary = IndexName <$> arbitrary

297−

298−instance Arbitrary MappingName where

299− arbitrary = MappingName <$> arbitrary

300−

301−instance Arbitrary DocId where

302− arbitrary = DocId <$> arbitrary

303−

304286instance Arbitrary a => Arbitrary (Hit a) where

305287 arbitrary = Hit <$> arbitrary

306288 <*> arbitrary

@@ -327,6 +309,135 @@ grabFirst r =

327309 (Right Nothing) -> Left "Source was missing"

328310 (Right (Just x)) -> Right x

329311

312+-------------------------------------------------------------------------------

313+arbitraryAlphaNum :: Gen Char

314+arbitraryAlphaNum = oneof [choose ('a', 'z')

315+ ,choose ('A','Z')

316+ , choose ('0', '9')]

317+

318+instance Arbitrary RoutingValue where

319+ arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum

320+

321+instance Arbitrary AliasRouting where

322+ arbitrary = oneof [allAlias

323+ ,one

324+ ,theOther

325+ ,both]

326+ where one = GranularAliasRouting

327+ <$> (Just <$> arbitrary)

328+ <*> pure Nothing

329+ theOther = GranularAliasRouting Nothing

330+ <$> (Just <$> arbitrary)

331+ both = GranularAliasRouting

332+ <$> (Just <$> arbitrary)

333+ <*> (Just <$> arbitrary)

334+ allAlias = AllAliasRouting <$> arbitrary

335+

336+$(derive makeArbitrary ''IndexName)

337+$(derive makeArbitrary ''FieldName)

338+$(derive makeArbitrary ''MappingName)

339+$(derive makeArbitrary ''DocId)

340+$(derive makeArbitrary ''Version)

341+$(derive makeArbitrary ''IndexAliasRouting)

342+$(derive makeArbitrary ''ShardCount)

343+$(derive makeArbitrary ''ReplicaCount)

344+$(derive makeArbitrary ''TemplateName)

345+$(derive makeArbitrary ''TemplatePattern)

346+$(derive makeArbitrary ''QueryString)

347+$(derive makeArbitrary ''CacheName)

348+$(derive makeArbitrary ''CacheKey)

349+$(derive makeArbitrary ''Existence)

350+$(derive makeArbitrary ''CutoffFrequency)

351+$(derive makeArbitrary ''Analyzer)

352+$(derive makeArbitrary ''MaxExpansions)

353+$(derive makeArbitrary ''Lenient)

354+$(derive makeArbitrary ''Tiebreaker)

355+$(derive makeArbitrary ''Boost)

356+$(derive makeArbitrary ''BoostTerms)

357+$(derive makeArbitrary ''MinimumMatch)

358+$(derive makeArbitrary ''DisableCoord)

359+$(derive makeArbitrary ''IgnoreTermFrequency)

360+$(derive makeArbitrary ''MinimumTermFrequency)

361+$(derive makeArbitrary ''MaxQueryTerms)

362+$(derive makeArbitrary ''Fuzziness)

363+$(derive makeArbitrary ''PrefixLength)

364+$(derive makeArbitrary ''TypeName)

365+$(derive makeArbitrary ''PercentMatch)

366+$(derive makeArbitrary ''StopWord)

367+$(derive makeArbitrary ''QueryPath)

368+$(derive makeArbitrary ''AllowLeadingWildcard)

369+$(derive makeArbitrary ''LowercaseExpanded)

370+$(derive makeArbitrary ''EnablePositionIncrements)

371+$(derive makeArbitrary ''AnalyzeWildcard)

372+$(derive makeArbitrary ''GeneratePhraseQueries)

373+$(derive makeArbitrary ''Locale)

374+$(derive makeArbitrary ''MaxWordLength)

375+$(derive makeArbitrary ''MinWordLength)

376+$(derive makeArbitrary ''PhraseSlop)

377+$(derive makeArbitrary ''MinDocFrequency)

378+$(derive makeArbitrary ''MaxDocFrequency)

379+$(derive makeArbitrary ''Regexp)

380+$(derive makeArbitrary ''Filter)

381+$(derive makeArbitrary ''Query)

382+$(derive makeArbitrary ''SimpleQueryStringQuery)

383+$(derive makeArbitrary ''FieldOrFields)

384+$(derive makeArbitrary ''SimpleQueryFlag)

385+$(derive makeArbitrary ''RegexpQuery)

386+$(derive makeArbitrary ''QueryStringQuery)

387+$(derive makeArbitrary ''RangeQuery)

388+$(derive makeArbitrary ''RangeValue)

389+$(derive makeArbitrary ''PrefixQuery)

390+$(derive makeArbitrary ''NestedQuery)

391+$(derive makeArbitrary ''MoreLikeThisFieldQuery)

392+$(derive makeArbitrary ''MoreLikeThisQuery)

393+$(derive makeArbitrary ''IndicesQuery)

394+$(derive makeArbitrary ''HasParentQuery)

395+$(derive makeArbitrary ''HasChildQuery)

396+$(derive makeArbitrary ''FuzzyQuery)

397+$(derive makeArbitrary ''FuzzyLikeFieldQuery)

398+$(derive makeArbitrary ''FuzzyLikeThisQuery)

399+$(derive makeArbitrary ''FilteredQuery)

400+$(derive makeArbitrary ''DisMaxQuery)

401+$(derive makeArbitrary ''CommonTermsQuery)

402+$(derive makeArbitrary ''DistanceRange)

403+$(derive makeArbitrary ''MultiMatchQuery)

404+$(derive makeArbitrary ''LessThanD)

405+$(derive makeArbitrary ''LessThanEqD)

406+$(derive makeArbitrary ''GreaterThanD)

407+$(derive makeArbitrary ''GreaterThanEqD)

408+$(derive makeArbitrary ''LessThan)

409+$(derive makeArbitrary ''LessThanEq)

410+$(derive makeArbitrary ''GreaterThan)

411+$(derive makeArbitrary ''GreaterThanEq)

412+$(derive makeArbitrary ''GeoPoint)

413+$(derive makeArbitrary ''NullValue)

414+$(derive makeArbitrary ''MinimumMatchHighLow)

415+$(derive makeArbitrary ''CommonMinimumMatch)

416+$(derive makeArbitrary ''BoostingQuery)

417+$(derive makeArbitrary ''BoolQuery)

418+$(derive makeArbitrary ''MatchQuery)

419+$(derive makeArbitrary ''MultiMatchQueryType)

420+$(derive makeArbitrary ''BooleanOperator)

421+$(derive makeArbitrary ''ZeroTermsQuery)

422+$(derive makeArbitrary ''MatchQueryType)

423+$(derive makeArbitrary ''IndexAliasCreate)

424+$(derive makeArbitrary ''SearchAliasRouting)

425+$(derive makeArbitrary ''ScoreType)

426+$(derive makeArbitrary ''Distance)

427+$(derive makeArbitrary ''DistanceUnit)

428+$(derive makeArbitrary ''DistanceType)

429+$(derive makeArbitrary ''OptimizeBbox)

430+$(derive makeArbitrary ''GeoBoundingBoxConstraint)

431+$(derive makeArbitrary ''GeoFilterType)

432+$(derive makeArbitrary ''GeoBoundingBox)

433+$(derive makeArbitrary ''LatLon)

434+$(derive makeArbitrary ''RangeExecution)

435+$(derive makeArbitrary ''RegexpFlags)

436+$(derive makeArbitrary ''RegexpFlag)

437+$(derive makeArbitrary ''BoolMatch)

438+$(derive makeArbitrary ''Term)

439+

440+

330441main :: IO ()

331442main = hspec $ do

332443

@@ -869,3 +980,100 @@ main = hspec $ do

869980 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored

870981 liftIO $

871982 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]

983+

984+ describe "JSON instances" $ do

985+ propJSON (Proxy :: Proxy Version)

986+ propJSON (Proxy :: Proxy IndexName)

987+ propJSON (Proxy :: Proxy MappingName)

988+ propJSON (Proxy :: Proxy DocId)

989+ propJSON (Proxy :: Proxy IndexAliasRouting)

990+ propJSON (Proxy :: Proxy RoutingValue)

991+ propJSON (Proxy :: Proxy ShardCount)

992+ propJSON (Proxy :: Proxy ReplicaCount)

993+ propJSON (Proxy :: Proxy TemplateName)

994+ propJSON (Proxy :: Proxy TemplatePattern)

995+ propJSON (Proxy :: Proxy QueryString)

996+ propJSON (Proxy :: Proxy FieldName)

997+ propJSON (Proxy :: Proxy CacheName)

998+ propJSON (Proxy :: Proxy CacheKey)

999+ propJSON (Proxy :: Proxy Existence)

1000+ propJSON (Proxy :: Proxy CutoffFrequency)

1001+ propJSON (Proxy :: Proxy Analyzer)

1002+ propJSON (Proxy :: Proxy MaxExpansions)

1003+ propJSON (Proxy :: Proxy Lenient)

1004+ propJSON (Proxy :: Proxy Tiebreaker)

1005+ propJSON (Proxy :: Proxy Boost)

1006+ propJSON (Proxy :: Proxy BoostTerms)

1007+ propJSON (Proxy :: Proxy MaxExpansions)

1008+ propJSON (Proxy :: Proxy MinimumMatch)

1009+ propJSON (Proxy :: Proxy DisableCoord)

1010+ propJSON (Proxy :: Proxy IgnoreTermFrequency)

1011+ propJSON (Proxy :: Proxy MinimumTermFrequency)

1012+ propJSON (Proxy :: Proxy MaxQueryTerms)

1013+ propJSON (Proxy :: Proxy Fuzziness)

1014+ propJSON (Proxy :: Proxy PrefixLength)

1015+ propJSON (Proxy :: Proxy TypeName)

1016+ propJSON (Proxy :: Proxy PercentMatch)

1017+ propJSON (Proxy :: Proxy StopWord)

1018+ propJSON (Proxy :: Proxy QueryPath)

1019+ propJSON (Proxy :: Proxy AllowLeadingWildcard)

1020+ propJSON (Proxy :: Proxy LowercaseExpanded)

1021+ propJSON (Proxy :: Proxy EnablePositionIncrements)

1022+ propJSON (Proxy :: Proxy AnalyzeWildcard)

1023+ propJSON (Proxy :: Proxy GeneratePhraseQueries)

1024+ propJSON (Proxy :: Proxy Locale)

1025+ propJSON (Proxy :: Proxy MaxWordLength)

1026+ propJSON (Proxy :: Proxy MinWordLength)

1027+ propJSON (Proxy :: Proxy PhraseSlop)

1028+ propJSON (Proxy :: Proxy MinDocFrequency)

1029+ propJSON (Proxy :: Proxy MaxDocFrequency)

1030+ propJSON (Proxy :: Proxy Filter)

1031+ propJSON (Proxy :: Proxy Query)

1032+ propJSON (Proxy :: Proxy SimpleQueryStringQuery)

1033+ propJSON (Proxy :: Proxy FieldOrFields)

1034+ propJSON (Proxy :: Proxy SimpleQueryFlag)

1035+ propJSON (Proxy :: Proxy RegexpQuery)

1036+ propJSON (Proxy :: Proxy QueryStringQuery)

1037+ propJSON (Proxy :: Proxy RangeQuery)

1038+ propJSON (Proxy :: Proxy PrefixQuery)

1039+ propJSON (Proxy :: Proxy NestedQuery)

1040+ propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)

1041+ propJSON (Proxy :: Proxy MoreLikeThisQuery)

1042+ propJSON (Proxy :: Proxy IndicesQuery)

1043+ propJSON (Proxy :: Proxy HasParentQuery)

1044+ propJSON (Proxy :: Proxy HasChildQuery)

1045+ propJSON (Proxy :: Proxy FuzzyQuery)

1046+ propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)

1047+ propJSON (Proxy :: Proxy FuzzyLikeThisQuery)

1048+ propJSON (Proxy :: Proxy FilteredQuery)

1049+ propJSON (Proxy :: Proxy DisMaxQuery)

1050+ propJSON (Proxy :: Proxy CommonTermsQuery)

1051+ propJSON (Proxy :: Proxy CommonMinimumMatch)

1052+ propJSON (Proxy :: Proxy BoostingQuery)

1053+ propJSON (Proxy :: Proxy BoolQuery)

1054+ propJSON (Proxy :: Proxy MatchQuery)

1055+ propJSON (Proxy :: Proxy MultiMatchQueryType)

1056+ propJSON (Proxy :: Proxy BooleanOperator)

1057+ propJSON (Proxy :: Proxy ZeroTermsQuery)

1058+ propJSON (Proxy :: Proxy MatchQueryType)

1059+ propJSON (Proxy :: Proxy AliasRouting)

1060+ propJSON (Proxy :: Proxy IndexAliasCreate)

1061+ propJSON (Proxy :: Proxy SearchAliasRouting)

1062+ propJSON (Proxy :: Proxy ScoreType)

1063+ propJSON (Proxy :: Proxy Distance)

1064+ propJSON (Proxy :: Proxy DistanceUnit)

1065+ propJSON (Proxy :: Proxy DistanceType)

1066+ propJSON (Proxy :: Proxy OptimizeBbox)

1067+ propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)

1068+ propJSON (Proxy :: Proxy GeoFilterType)

1069+ propJSON (Proxy :: Proxy GeoBoundingBox)

1070+ propJSON (Proxy :: Proxy LatLon)

1071+ propJSON (Proxy :: Proxy RangeExecution)

1072+ prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->

1073+ let expected = case rfs of

1074+ SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))

1075+ x -> x

1076+ in parseEither parseJSON (toJSON rfs) === Right expected

1077+ propJSON (Proxy :: Proxy BoolMatch)

1078+ propJSON (Proxy :: Proxy Term)

1079+ propJSON (Proxy :: Proxy MultiMatchQuery)