mirror of
https://github.com/typeable/bloodhound.git
synced 2025-01-05 21:36:03 +03:00
WIP: fix several bugs with parsers, more to go
Also caught a bug in one of the existing ToJSON instances
This commit is contained in:
Michael Xavier
parent
e2f991e862
commit
a72311a60b
@ -45,7 +45,8 @@ library
|
||||
data-default-class,
|
||||
blaze-builder,
|
||||
unordered-containers,
|
||||
mtl-compat
|
||||
mtl-compat,
|
||||
hashable
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite tests
|
||||
@ -68,7 +69,9 @@ test-suite tests
|
||||
vector,
|
||||
unordered-containers >= 0.2.5.0 && <0.3,
|
||||
mtl,
|
||||
quickcheck-properties
|
||||
quickcheck-properties,
|
||||
derive,
|
||||
quickcheck-instances
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite doctests
|
||||
|
||||
@ -251,6 +251,7 @@ import Data.Aeson.Types (Pair, Parser, emptyObject,
|
||||
parseMaybe)
|
||||
import qualified Data.ByteString.Lazy.Char8 as L
|
||||
import Data.Char
|
||||
import Data.Hashable (Hashable)
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.List (foldl', nub)
|
||||
import Data.List.NonEmpty (NonEmpty (..), toList)
|
||||
@ -266,6 +267,8 @@ import GHC.Generics (Generic)
|
||||
import Network.HTTP.Client
|
||||
import qualified Network.HTTP.Types.Method as NHTM
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
import Database.Bloodhound.Types.Class
|
||||
|
||||
-- $setup
|
||||
@ -711,8 +714,6 @@ newtype BoostTerms =
|
||||
-}
|
||||
newtype MinimumMatch =
|
||||
MinimumMatch Int deriving (Eq, Show, Generic, ToJSON, FromJSON)
|
||||
newtype MinimumMatchText =
|
||||
MinimumMatchText Text deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype DisableCoord =
|
||||
DisableCoord Bool deriving (Eq, Show, Generic, ToJSON, FromJSON)
|
||||
newtype IgnoreTermFrequency =
|
||||
@ -1722,18 +1723,24 @@ instance FromJSON Filter where
|
||||
<*> o .:? "_cache" .!= defaultCache
|
||||
orFilter o = OrFilter <$> o .: "filters"
|
||||
<*> o .:? "_cache" .!= defaultCache
|
||||
notFilter o = NotFilter <$> o .: "filters"
|
||||
notFilter o = NotFilter <$> o .: "filter"
|
||||
<*> o .: "_cache" .!= defaultCache
|
||||
identityFilter () = pure IdentityFilter
|
||||
identityFilter :: Object -> Parser Filter
|
||||
identityFilter m
|
||||
| HM.null m = pure IdentityFilter
|
||||
| otherwise = fail ("Identityfilter expected empty object but got " <> show m)
|
||||
boolFilter = pure . BoolFilter
|
||||
existsFilter o = ExistsFilter <$> o .: "field"
|
||||
geoBoundingBoxFilter = pure . GeoBoundingBoxFilter
|
||||
geoDistanceFilter o = flip fieldTagged o $ \fn o' -> do
|
||||
gp <- GeoPoint fn <$> parseJSON (Object o')
|
||||
GeoDistanceFilter gp <$> o .: "distance"
|
||||
<*> o .: "distance_type"
|
||||
<*> o .: "optimize_bbox"
|
||||
<*> o .:? "_cache" .!= defaultCache
|
||||
geoDistanceFilter o = do
|
||||
case HM.toList (deleteSeveral ["distance", "distance_type", "optimize_bbox", "_cache"] o) of
|
||||
[(fn, v)] -> do
|
||||
gp <- GeoPoint (FieldName fn) <$> parseJSON v
|
||||
GeoDistanceFilter gp <$> o .: "distance"
|
||||
<*> o .: "distance_type"
|
||||
<*> o .: "optimize_bbox"
|
||||
<*> o .:? "_cache" .!= defaultCache
|
||||
_ -> fail "Could not find GeoDistanceFilter field name"
|
||||
geoDistanceRangeFilter o = flip fieldTagged o $ \fn o' -> do
|
||||
gp <- GeoPoint fn <$> parseJSON (Object o')
|
||||
rng <- DistanceRange <$> o .: "from" <*> o .: "to"
|
||||
@ -1745,21 +1752,27 @@ instance FromJSON Filter where
|
||||
missingFilter o = MissingFilter <$> o .: "field"
|
||||
<*> o .: "existence"
|
||||
<*> o .: "null_value"
|
||||
prefixFilter o = flip fieldTagged o $ \fn o' -> PrefixFilter fn <$> parseJSON (Object o')
|
||||
<*> o .:? "_cache" .!= defaultCache
|
||||
prefixFilter o = case HM.toList (HM.delete "_cache" o) of
|
||||
[(fn, String v)] -> PrefixFilter (FieldName fn) v <$> o .:? "_cache" .!= defaultCache
|
||||
_ -> fail "Could not parse PrefixFilter"
|
||||
|
||||
queryFilter q = pure (QueryFilter q False)
|
||||
fqueryFilter o = QueryFilter <$> o .: "query" <*> pure True
|
||||
rangeFilter o = flip fieldTagged o $ \fn o' -> RangeFilter fn <$> parseJSON (Object o')
|
||||
<*> o .: "execution"
|
||||
<*> o .:? "_cache" .!= defaultCache
|
||||
rangeFilter o = case HM.toList (deleteSeveral ["execution", "_cache"] o) of
|
||||
[(fn, v)] -> RangeFilter (FieldName fn)
|
||||
<$> parseJSON v
|
||||
<*> o .: "execution"
|
||||
<*> o .:? "_cache" .!= defaultCache
|
||||
_ -> fail "Could not find field name for RangeFilter"
|
||||
regexpFilter = fieldTagged $ \fn o -> RegexpFilter fn <$> o .: "value"
|
||||
<*> o .: "flags"
|
||||
<*> o .: "_name"
|
||||
<*> o .:? "_cache" .!= defaultCache
|
||||
<*> o .: "_cache_key"
|
||||
termFilter o = flip fieldTagged o $ \(FieldName fn) o' -> do
|
||||
trm <- Term fn <$> parseJSON (Object o')
|
||||
TermFilter trm <$> o .: "_cache" .!= defaultCache
|
||||
termFilter o = case HM.toList (HM.delete "_cache" o) of
|
||||
[(termField, String termVal)] -> TermFilter (Term termField termVal)
|
||||
<$> o .:? "_cache" .!= defaultCache
|
||||
_ -> fail "Could not find term field for TermFilter"
|
||||
|
||||
fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
|
||||
fieldTagged f o = case HM.toList o of
|
||||
@ -1866,13 +1879,13 @@ instance ToJSON Query where
|
||||
object [ "simple_query_string" .= query ]
|
||||
|
||||
instance FromJSON Query where
|
||||
parseJSON = withObject "Query" parse
|
||||
parseJSON v = withObject "Query" parse v
|
||||
where parse o = termQuery `taggedWith` "term"
|
||||
<|> termsQuery `taggedWith` "terms"
|
||||
<|> idsQuery `taggedWith` "ids"
|
||||
<|> queryQueryStringQuery `taggedWith` "query_string"
|
||||
<|> queryMatchQuery `taggedWith` "match"
|
||||
<|> queryMultiMatchQuery o --TODO: is this a precedence issue?
|
||||
<|> queryMultiMatchQuery --TODO: is this a precedence issue?
|
||||
<|> queryBoolQuery `taggedWith` "bool"
|
||||
<|> queryBoostingQuery `taggedWith` "boosting"
|
||||
<|> queryCommonTermsQuery `taggedWith` "common"
|
||||
@ -1895,8 +1908,8 @@ instance FromJSON Query where
|
||||
<|> queryRegexpQuery `taggedWith` "regexp"
|
||||
<|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
|
||||
where taggedWith parser k = parser =<< o .: k
|
||||
termQuery o = TermQuery <$> parseJSON (Object o)
|
||||
<*> o .:? "boost"
|
||||
termQuery = fieldTagged $ \(FieldName fn) o ->
|
||||
TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
|
||||
termsQuery o = case HM.toList o of
|
||||
[(fn, vs)] -> do vals <- parseJSON vs
|
||||
case vals of
|
||||
@ -1907,7 +1920,7 @@ instance FromJSON Query where
|
||||
<*> o .: "values"
|
||||
queryQueryStringQuery = pure . QueryQueryStringQuery
|
||||
queryMatchQuery = pure . QueryMatchQuery
|
||||
queryMultiMatchQuery = undefined
|
||||
queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
|
||||
queryBoolQuery = pure . QueryBoolQuery
|
||||
queryBoostingQuery = pure . QueryBoostingQuery
|
||||
queryCommonTermsQuery = pure . QueryCommonTermsQuery
|
||||
@ -2071,7 +2084,7 @@ instance FromJSON QueryStringQuery where
|
||||
|
||||
instance ToJSON RangeQuery where
|
||||
toJSON (RangeQuery (FieldName fieldName) range boost) =
|
||||
object [ fieldName .= conjoined ]
|
||||
object [ fieldName .= object conjoined ]
|
||||
where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
|
||||
|
||||
instance FromJSON RangeQuery where
|
||||
@ -2312,7 +2325,7 @@ instance ToJSON FuzzyLikeThisQuery where
|
||||
instance FromJSON FuzzyLikeThisQuery where
|
||||
parseJSON = withObject "FuzzyLikeThisQuery" parse
|
||||
where parse o = FuzzyLikeThisQuery
|
||||
<$> o .: "fields"
|
||||
<$> o .:? "fields" .!= []
|
||||
<*> o .: "like_text"
|
||||
<*> o .: "max_query_terms"
|
||||
<*> o .: "ignore_tf"
|
||||
@ -2342,7 +2355,7 @@ instance ToJSON DisMaxQuery where
|
||||
instance FromJSON DisMaxQuery where
|
||||
parseJSON = withObject "DisMaxQuery" parse
|
||||
where parse o = DisMaxQuery
|
||||
<$> o .: "queries"
|
||||
<$> o .:? "queries" .!= []
|
||||
<*> o .: "tie_breaker"
|
||||
<*> o .:? "boost"
|
||||
|
||||
@ -2467,6 +2480,20 @@ instance ToJSON MultiMatchQuery where
|
||||
, "max_expansions" .= maxEx
|
||||
, "lenient" .= lenient ]
|
||||
|
||||
instance FromJSON MultiMatchQuery where
|
||||
parseJSON = withObject "MultiMatchQuery" parse
|
||||
where parse raw = do o <- raw .: "multi_match"
|
||||
MultiMatchQuery
|
||||
<$> o .:? "fields" .!= []
|
||||
<*> o .: "query"
|
||||
<*> o .: "operator"
|
||||
<*> o .: "zero_terms_query"
|
||||
<*> o .:? "tiebreaker"
|
||||
<*> o .:? "type"
|
||||
<*> o .:? "cutoff_frequency"
|
||||
<*> o .:? "analyzer"
|
||||
<*> o .:? "max_expansions"
|
||||
<*> o .:? "lenient"
|
||||
|
||||
instance ToJSON MultiMatchQueryType where
|
||||
toJSON MultiMatchBestFields = "best_fields"
|
||||
@ -2603,12 +2630,16 @@ instance FromJSON AliasRouting where
|
||||
parseJSON = withObject "AliasRouting" parse
|
||||
where parse o = parseAll o <|> parseGranular o
|
||||
parseAll o = AllAliasRouting <$> o .: "routing"
|
||||
parseGranular o = GranularAliasRouting <$> o .:? "search_routing"
|
||||
<*> o .:? "index_routing"
|
||||
parseGranular o = do
|
||||
sr <- o .:? "search_routing"
|
||||
ir <- o .:? "index_routing"
|
||||
if isNothing sr && isNothing ir
|
||||
then fail "Both search_routing and index_routing can't be blank"
|
||||
else return (GranularAliasRouting sr ir)
|
||||
|
||||
instance FromJSON IndexAliasCreate where
|
||||
parseJSON v = withObject "IndexAliasCreate" parse v
|
||||
where parse o = IndexAliasCreate <$> parseJSON v
|
||||
where parse o = IndexAliasCreate <$> optional (parseJSON v)
|
||||
<*> o .:? "filter"
|
||||
|
||||
instance ToJSON SearchAliasRouting where
|
||||
@ -2700,6 +2731,9 @@ fastVectorHighPairs (Just
|
||||
++ commonHighlightPairs fvCom
|
||||
++ nonPostingsToPairs fvNonPostSettings
|
||||
|
||||
deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
|
||||
deleteSeveral ks hm = foldr HM.delete hm ks
|
||||
|
||||
commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
|
||||
commonHighlightPairs Nothing = []
|
||||
commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder
|
||||
@ -2778,10 +2812,10 @@ instance ToJSON ScoreType where
|
||||
|
||||
instance FromJSON ScoreType where
|
||||
parseJSON = withText "ScoreType" parse
|
||||
where parse "max" = pure ScoreTypeMax
|
||||
parse "avg" = pure ScoreTypeAvg
|
||||
parse "sum" = pure ScoreTypeSum
|
||||
parse "non" = pure ScoreTypeNone
|
||||
where parse "max" = pure ScoreTypeMax
|
||||
parse "avg" = pure ScoreTypeAvg
|
||||
parse "sum" = pure ScoreTypeSum
|
||||
parse "none" = pure ScoreTypeNone
|
||||
parse t = fail ("Unexpected ScoreType: " <> show t)
|
||||
|
||||
instance ToJSON Distance where
|
||||
@ -2795,7 +2829,12 @@ instance FromJSON Distance where
|
||||
parseJSON = withText "Distance" parse
|
||||
where parse t = Distance <$> parseCoeff nT
|
||||
<*> parseJSON (String unitT)
|
||||
where (nT, unitT) = T.span isNumber t
|
||||
where (nT, unitT) = T.span validForNumber t
|
||||
-- may be a better way to do this
|
||||
validForNumber '-' = True
|
||||
validForNumber '.' = True
|
||||
validForNumber 'e' = True
|
||||
validForNumber c = isNumber c
|
||||
parseCoeff "" = fail "Empty string cannot be parsed as number"
|
||||
parseCoeff s = return (read (T.unpack s))
|
||||
|
||||
@ -2857,11 +2896,12 @@ instance ToJSON GeoBoundingBoxConstraint where
|
||||
|
||||
instance FromJSON GeoBoundingBoxConstraint where
|
||||
parseJSON = withObject "GeoBoundingBoxConstraint" parse
|
||||
where parse o = flip fieldTagged o $ \fn o' ->
|
||||
GeoBoundingBoxConstraint fn
|
||||
<$> parseJSON (Object o')
|
||||
<*> o .:? "cache" .!= defaultCache
|
||||
<*> o .: "type"
|
||||
where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
|
||||
[(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
|
||||
<$> parseJSON v
|
||||
<*> o .:? "_cache" .!= defaultCache
|
||||
<*> o .: "type"
|
||||
_ -> fail "Could not find field name for GeoBoundingBoxConstraint"
|
||||
|
||||
instance ToJSON GeoFilterType where
|
||||
toJSON GeoFilterMemory = String "memory"
|
||||
|
||||
270
tests/tests.hs
270
tests/tests.hs
@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module Main where
|
||||
|
||||
@ -9,21 +10,25 @@ import Control.Exception
|
||||
import Control.Monad
|
||||
import Control.Monad.Reader
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types (parseEither)
|
||||
import Data.DeriveTH
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.List (nub)
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Monoid
|
||||
import Data.Proxy
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day (..))
|
||||
import Data.Time.Clock (UTCTime (..),
|
||||
secondsToDiffTime)
|
||||
import Data.Typeable
|
||||
import qualified Data.Vector as V
|
||||
import Database.Bloodhound
|
||||
import GHC.Generics (Generic)
|
||||
import Network.HTTP.Client
|
||||
import Network.HTTP.Client hiding (Proxy)
|
||||
import qualified Network.HTTP.Types.Status as NHTS
|
||||
import Prelude hiding (filter)
|
||||
import Test.Hspec
|
||||
@ -31,6 +36,7 @@ import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)
|
||||
|
||||
import Test.Hspec.QuickCheck (prop)
|
||||
import Test.QuickCheck
|
||||
import Test.QuickCheck.Instances ()
|
||||
|
||||
testServer :: Server
|
||||
testServer = Server "http://localhost:9200"
|
||||
@ -101,6 +107,12 @@ is v = testServerBranch >>= \x -> return $ x == Just (serverBranch v)
|
||||
when' :: Monad m => m Bool -> m () -> m ()
|
||||
when' b f = b >>= \x -> when x f
|
||||
|
||||
propJSON :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, Eq a, Typeable a) => Proxy a -> Spec
|
||||
propJSON _ = prop testName $ \(a :: a) ->
|
||||
parseEither parseJSON (toJSON a) === Right a
|
||||
where testName = show ty <> " FromJSON/ToJSON roundtrips"
|
||||
ty = typeOf (undefined :: a)
|
||||
|
||||
data Location = Location { lat :: Double
|
||||
, lon :: Double } deriving (Eq, Generic, Show)
|
||||
|
||||
@ -265,42 +277,12 @@ instance ToJSON BulkTest where
|
||||
noDuplicates :: Eq a => [a] -> Bool
|
||||
noDuplicates xs = nub xs == xs
|
||||
|
||||
instance Arbitrary RegexpFlags where
|
||||
arbitrary = oneof [ pure AllRegexpFlags
|
||||
, pure NoRegexpFlags
|
||||
, SomeRegexpFlags <$> arbitrary
|
||||
]
|
||||
|
||||
instance Arbitrary a => Arbitrary (NonEmpty a) where
|
||||
arbitrary = liftA2 (:|) arbitrary arbitrary
|
||||
|
||||
instance Arbitrary RegexpFlag where
|
||||
arbitrary = oneof [ pure AnyString
|
||||
, pure Automaton
|
||||
, pure Complement
|
||||
, pure Empty
|
||||
, pure Intersection
|
||||
, pure Interval
|
||||
]
|
||||
|
||||
arbitraryScore :: Gen Score
|
||||
arbitraryScore = fmap getPositive <$> arbitrary
|
||||
|
||||
instance Arbitrary Text where
|
||||
arbitrary = T.pack <$> arbitrary
|
||||
|
||||
instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (M.Map k v) where
|
||||
arbitrary = M.fromList <$> arbitrary
|
||||
|
||||
instance Arbitrary IndexName where
|
||||
arbitrary = IndexName <$> arbitrary
|
||||
|
||||
instance Arbitrary MappingName where
|
||||
arbitrary = MappingName <$> arbitrary
|
||||
|
||||
instance Arbitrary DocId where
|
||||
arbitrary = DocId <$> arbitrary
|
||||
|
||||
instance Arbitrary a => Arbitrary (Hit a) where
|
||||
arbitrary = Hit <$> arbitrary
|
||||
<*> arbitrary
|
||||
@ -327,6 +309,135 @@ grabFirst r =
|
||||
(Right Nothing) -> Left "Source was missing"
|
||||
(Right (Just x)) -> Right x
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
arbitraryAlphaNum :: Gen Char
|
||||
arbitraryAlphaNum = oneof [choose ('a', 'z')
|
||||
,choose ('A','Z')
|
||||
, choose ('0', '9')]
|
||||
|
||||
instance Arbitrary RoutingValue where
|
||||
arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
|
||||
|
||||
instance Arbitrary AliasRouting where
|
||||
arbitrary = oneof [allAlias
|
||||
,one
|
||||
,theOther
|
||||
,both]
|
||||
where one = GranularAliasRouting
|
||||
<$> (Just <$> arbitrary)
|
||||
<*> pure Nothing
|
||||
theOther = GranularAliasRouting Nothing
|
||||
<$> (Just <$> arbitrary)
|
||||
both = GranularAliasRouting
|
||||
<$> (Just <$> arbitrary)
|
||||
<*> (Just <$> arbitrary)
|
||||
allAlias = AllAliasRouting <$> arbitrary
|
||||
|
||||
$(derive makeArbitrary ''IndexName)
|
||||
$(derive makeArbitrary ''FieldName)
|
||||
$(derive makeArbitrary ''MappingName)
|
||||
$(derive makeArbitrary ''DocId)
|
||||
$(derive makeArbitrary ''Version)
|
||||
$(derive makeArbitrary ''IndexAliasRouting)
|
||||
$(derive makeArbitrary ''ShardCount)
|
||||
$(derive makeArbitrary ''ReplicaCount)
|
||||
$(derive makeArbitrary ''TemplateName)
|
||||
$(derive makeArbitrary ''TemplatePattern)
|
||||
$(derive makeArbitrary ''QueryString)
|
||||
$(derive makeArbitrary ''CacheName)
|
||||
$(derive makeArbitrary ''CacheKey)
|
||||
$(derive makeArbitrary ''Existence)
|
||||
$(derive makeArbitrary ''CutoffFrequency)
|
||||
$(derive makeArbitrary ''Analyzer)
|
||||
$(derive makeArbitrary ''MaxExpansions)
|
||||
$(derive makeArbitrary ''Lenient)
|
||||
$(derive makeArbitrary ''Tiebreaker)
|
||||
$(derive makeArbitrary ''Boost)
|
||||
$(derive makeArbitrary ''BoostTerms)
|
||||
$(derive makeArbitrary ''MinimumMatch)
|
||||
$(derive makeArbitrary ''DisableCoord)
|
||||
$(derive makeArbitrary ''IgnoreTermFrequency)
|
||||
$(derive makeArbitrary ''MinimumTermFrequency)
|
||||
$(derive makeArbitrary ''MaxQueryTerms)
|
||||
$(derive makeArbitrary ''Fuzziness)
|
||||
$(derive makeArbitrary ''PrefixLength)
|
||||
$(derive makeArbitrary ''TypeName)
|
||||
$(derive makeArbitrary ''PercentMatch)
|
||||
$(derive makeArbitrary ''StopWord)
|
||||
$(derive makeArbitrary ''QueryPath)
|
||||
$(derive makeArbitrary ''AllowLeadingWildcard)
|
||||
$(derive makeArbitrary ''LowercaseExpanded)
|
||||
$(derive makeArbitrary ''EnablePositionIncrements)
|
||||
$(derive makeArbitrary ''AnalyzeWildcard)
|
||||
$(derive makeArbitrary ''GeneratePhraseQueries)
|
||||
$(derive makeArbitrary ''Locale)
|
||||
$(derive makeArbitrary ''MaxWordLength)
|
||||
$(derive makeArbitrary ''MinWordLength)
|
||||
$(derive makeArbitrary ''PhraseSlop)
|
||||
$(derive makeArbitrary ''MinDocFrequency)
|
||||
$(derive makeArbitrary ''MaxDocFrequency)
|
||||
$(derive makeArbitrary ''Regexp)
|
||||
$(derive makeArbitrary ''Filter)
|
||||
$(derive makeArbitrary ''Query)
|
||||
$(derive makeArbitrary ''SimpleQueryStringQuery)
|
||||
$(derive makeArbitrary ''FieldOrFields)
|
||||
$(derive makeArbitrary ''SimpleQueryFlag)
|
||||
$(derive makeArbitrary ''RegexpQuery)
|
||||
$(derive makeArbitrary ''QueryStringQuery)
|
||||
$(derive makeArbitrary ''RangeQuery)
|
||||
$(derive makeArbitrary ''RangeValue)
|
||||
$(derive makeArbitrary ''PrefixQuery)
|
||||
$(derive makeArbitrary ''NestedQuery)
|
||||
$(derive makeArbitrary ''MoreLikeThisFieldQuery)
|
||||
$(derive makeArbitrary ''MoreLikeThisQuery)
|
||||
$(derive makeArbitrary ''IndicesQuery)
|
||||
$(derive makeArbitrary ''HasParentQuery)
|
||||
$(derive makeArbitrary ''HasChildQuery)
|
||||
$(derive makeArbitrary ''FuzzyQuery)
|
||||
$(derive makeArbitrary ''FuzzyLikeFieldQuery)
|
||||
$(derive makeArbitrary ''FuzzyLikeThisQuery)
|
||||
$(derive makeArbitrary ''FilteredQuery)
|
||||
$(derive makeArbitrary ''DisMaxQuery)
|
||||
$(derive makeArbitrary ''CommonTermsQuery)
|
||||
$(derive makeArbitrary ''DistanceRange)
|
||||
$(derive makeArbitrary ''MultiMatchQuery)
|
||||
$(derive makeArbitrary ''LessThanD)
|
||||
$(derive makeArbitrary ''LessThanEqD)
|
||||
$(derive makeArbitrary ''GreaterThanD)
|
||||
$(derive makeArbitrary ''GreaterThanEqD)
|
||||
$(derive makeArbitrary ''LessThan)
|
||||
$(derive makeArbitrary ''LessThanEq)
|
||||
$(derive makeArbitrary ''GreaterThan)
|
||||
$(derive makeArbitrary ''GreaterThanEq)
|
||||
$(derive makeArbitrary ''GeoPoint)
|
||||
$(derive makeArbitrary ''NullValue)
|
||||
$(derive makeArbitrary ''MinimumMatchHighLow)
|
||||
$(derive makeArbitrary ''CommonMinimumMatch)
|
||||
$(derive makeArbitrary ''BoostingQuery)
|
||||
$(derive makeArbitrary ''BoolQuery)
|
||||
$(derive makeArbitrary ''MatchQuery)
|
||||
$(derive makeArbitrary ''MultiMatchQueryType)
|
||||
$(derive makeArbitrary ''BooleanOperator)
|
||||
$(derive makeArbitrary ''ZeroTermsQuery)
|
||||
$(derive makeArbitrary ''MatchQueryType)
|
||||
$(derive makeArbitrary ''IndexAliasCreate)
|
||||
$(derive makeArbitrary ''SearchAliasRouting)
|
||||
$(derive makeArbitrary ''ScoreType)
|
||||
$(derive makeArbitrary ''Distance)
|
||||
$(derive makeArbitrary ''DistanceUnit)
|
||||
$(derive makeArbitrary ''DistanceType)
|
||||
$(derive makeArbitrary ''OptimizeBbox)
|
||||
$(derive makeArbitrary ''GeoBoundingBoxConstraint)
|
||||
$(derive makeArbitrary ''GeoFilterType)
|
||||
$(derive makeArbitrary ''GeoBoundingBox)
|
||||
$(derive makeArbitrary ''LatLon)
|
||||
$(derive makeArbitrary ''RangeExecution)
|
||||
$(derive makeArbitrary ''RegexpFlags)
|
||||
$(derive makeArbitrary ''RegexpFlag)
|
||||
$(derive makeArbitrary ''BoolMatch)
|
||||
$(derive makeArbitrary ''Term)
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
|
||||
@ -869,3 +980,100 @@ main = hspec $ do
|
||||
regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
|
||||
liftIO $
|
||||
scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
|
||||
|
||||
describe "JSON instances" $ do
|
||||
propJSON (Proxy :: Proxy Version)
|
||||
propJSON (Proxy :: Proxy IndexName)
|
||||
propJSON (Proxy :: Proxy MappingName)
|
||||
propJSON (Proxy :: Proxy DocId)
|
||||
propJSON (Proxy :: Proxy IndexAliasRouting)
|
||||
propJSON (Proxy :: Proxy RoutingValue)
|
||||
propJSON (Proxy :: Proxy ShardCount)
|
||||
propJSON (Proxy :: Proxy ReplicaCount)
|
||||
propJSON (Proxy :: Proxy TemplateName)
|
||||
propJSON (Proxy :: Proxy TemplatePattern)
|
||||
propJSON (Proxy :: Proxy QueryString)
|
||||
propJSON (Proxy :: Proxy FieldName)
|
||||
propJSON (Proxy :: Proxy CacheName)
|
||||
propJSON (Proxy :: Proxy CacheKey)
|
||||
propJSON (Proxy :: Proxy Existence)
|
||||
propJSON (Proxy :: Proxy CutoffFrequency)
|
||||
propJSON (Proxy :: Proxy Analyzer)
|
||||
propJSON (Proxy :: Proxy MaxExpansions)
|
||||
propJSON (Proxy :: Proxy Lenient)
|
||||
propJSON (Proxy :: Proxy Tiebreaker)
|
||||
propJSON (Proxy :: Proxy Boost)
|
||||
propJSON (Proxy :: Proxy BoostTerms)
|
||||
propJSON (Proxy :: Proxy MaxExpansions)
|
||||
propJSON (Proxy :: Proxy MinimumMatch)
|
||||
propJSON (Proxy :: Proxy DisableCoord)
|
||||
propJSON (Proxy :: Proxy IgnoreTermFrequency)
|
||||
propJSON (Proxy :: Proxy MinimumTermFrequency)
|
||||
propJSON (Proxy :: Proxy MaxQueryTerms)
|
||||
propJSON (Proxy :: Proxy Fuzziness)
|
||||
propJSON (Proxy :: Proxy PrefixLength)
|
||||
propJSON (Proxy :: Proxy TypeName)
|
||||
propJSON (Proxy :: Proxy PercentMatch)
|
||||
propJSON (Proxy :: Proxy StopWord)
|
||||
propJSON (Proxy :: Proxy QueryPath)
|
||||
propJSON (Proxy :: Proxy AllowLeadingWildcard)
|
||||
propJSON (Proxy :: Proxy LowercaseExpanded)
|
||||
propJSON (Proxy :: Proxy EnablePositionIncrements)
|
||||
propJSON (Proxy :: Proxy AnalyzeWildcard)
|
||||
propJSON (Proxy :: Proxy GeneratePhraseQueries)
|
||||
propJSON (Proxy :: Proxy Locale)
|
||||
propJSON (Proxy :: Proxy MaxWordLength)
|
||||
propJSON (Proxy :: Proxy MinWordLength)
|
||||
propJSON (Proxy :: Proxy PhraseSlop)
|
||||
propJSON (Proxy :: Proxy MinDocFrequency)
|
||||
propJSON (Proxy :: Proxy MaxDocFrequency)
|
||||
propJSON (Proxy :: Proxy Filter)
|
||||
propJSON (Proxy :: Proxy Query)
|
||||
propJSON (Proxy :: Proxy SimpleQueryStringQuery)
|
||||
propJSON (Proxy :: Proxy FieldOrFields)
|
||||
propJSON (Proxy :: Proxy SimpleQueryFlag)
|
||||
propJSON (Proxy :: Proxy RegexpQuery)
|
||||
propJSON (Proxy :: Proxy QueryStringQuery)
|
||||
propJSON (Proxy :: Proxy RangeQuery)
|
||||
propJSON (Proxy :: Proxy PrefixQuery)
|
||||
propJSON (Proxy :: Proxy NestedQuery)
|
||||
propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
|
||||
propJSON (Proxy :: Proxy MoreLikeThisQuery)
|
||||
propJSON (Proxy :: Proxy IndicesQuery)
|
||||
propJSON (Proxy :: Proxy HasParentQuery)
|
||||
propJSON (Proxy :: Proxy HasChildQuery)
|
||||
propJSON (Proxy :: Proxy FuzzyQuery)
|
||||
propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
|
||||
propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
|
||||
propJSON (Proxy :: Proxy FilteredQuery)
|
||||
propJSON (Proxy :: Proxy DisMaxQuery)
|
||||
propJSON (Proxy :: Proxy CommonTermsQuery)
|
||||
propJSON (Proxy :: Proxy CommonMinimumMatch)
|
||||
propJSON (Proxy :: Proxy BoostingQuery)
|
||||
propJSON (Proxy :: Proxy BoolQuery)
|
||||
propJSON (Proxy :: Proxy MatchQuery)
|
||||
propJSON (Proxy :: Proxy MultiMatchQueryType)
|
||||
propJSON (Proxy :: Proxy BooleanOperator)
|
||||
propJSON (Proxy :: Proxy ZeroTermsQuery)
|
||||
propJSON (Proxy :: Proxy MatchQueryType)
|
||||
propJSON (Proxy :: Proxy AliasRouting)
|
||||
propJSON (Proxy :: Proxy IndexAliasCreate)
|
||||
propJSON (Proxy :: Proxy SearchAliasRouting)
|
||||
propJSON (Proxy :: Proxy ScoreType)
|
||||
propJSON (Proxy :: Proxy Distance)
|
||||
propJSON (Proxy :: Proxy DistanceUnit)
|
||||
propJSON (Proxy :: Proxy DistanceType)
|
||||
propJSON (Proxy :: Proxy OptimizeBbox)
|
||||
propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
|
||||
propJSON (Proxy :: Proxy GeoFilterType)
|
||||
propJSON (Proxy :: Proxy GeoBoundingBox)
|
||||
propJSON (Proxy :: Proxy LatLon)
|
||||
propJSON (Proxy :: Proxy RangeExecution)
|
||||
prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
|
||||
let expected = case rfs of
|
||||
SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
|
||||
x -> x
|
||||
in parseEither parseJSON (toJSON rfs) === Right expected
|
||||
propJSON (Proxy :: Proxy BoolMatch)
|
||||
propJSON (Proxy :: Proxy Term)
|
||||
propJSON (Proxy :: Proxy MultiMatchQuery)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user