@@ -3,6 +3,7 @@
33{-# LANGUAGE FlexibleInstances #-}
44{-# LANGUAGE GeneralizedNewtypeDeriving #-}
55{-# LANGUAGE MultiParamTypeClasses #-}
6+{-# LANGUAGE NoMonomorphismRestriction #-}
67{-# LANGUAGE OverloadedStrings #-}
78{-# LANGUAGE RecordWildCards #-}
89{-# LANGUAGE UndecidableInstances #-}
@@ -267,8 +268,6 @@ import GHC.Generics (Generic)
267268import Network.HTTP.Client
268269import qualified Network.HTTP.Types.Method as NHTM
269270
270−import Debug.Trace
271−
272271import Database.Bloodhound.Types.Class
273272
274273-- $setup
@@ -872,7 +871,7 @@ data HighlightTag = TagSchema Text
872871
873872data Query =
874873 TermQuery Term (Maybe Boost)
875− | TermsQuery (NonEmpty Term)
874+ | TermsQuery Text (NonEmpty Text)
876875 | QueryMatchQuery MatchQuery
877876 | QueryMultiMatchQuery MultiMatchQuery
878877 | QueryBoolQuery BoolQuery
@@ -921,7 +920,7 @@ data SimpleQueryStringQuery =
921920 , simpleQueryStringField :: Maybe FieldOrFields
922921 , simpleQueryStringOperator :: Maybe BooleanOperator
923922 , simpleQueryStringAnalyzer :: Maybe Analyzer
924− , simpleQueryStringFlags :: Maybe [SimpleQueryFlag]
923+ , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
925924 , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
926925 , simpleQueryStringLocale :: Maybe Locale
927926 } deriving (Eq, Show)
@@ -971,7 +970,7 @@ mkQueryStringQuery qs =
971970 Nothing Nothing
972971
973972data FieldOrFields = FofField FieldName
974− | FofFields [FieldName] deriving (Eq, Show)
973+ | FofFields (NonEmpty FieldName) deriving (Eq, Show)
975974
976975data PrefixQuery =
977976 PrefixQuery
@@ -993,7 +992,7 @@ data MoreLikeThisFieldQuery =
993992 , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
994993 , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
995994 , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
996− , moreLikeThisFieldStopWords :: Maybe [StopWord]
995+ , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
997996 , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
998997 , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
999998 , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
@@ -1006,12 +1005,12 @@ data MoreLikeThisFieldQuery =
10061005data MoreLikeThisQuery =
10071006 MoreLikeThisQuery
10081007 { moreLikeThisText :: Text
1009− , moreLikeThisFields :: Maybe [FieldName]
1008+ , moreLikeThisFields :: Maybe (NonEmpty FieldName)
10101009 -- default 0.3 (30%)
10111010 , moreLikeThisPercentMatch :: Maybe PercentMatch
10121011 , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
10131012 , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
1014− , moreLikeThisStopWords :: Maybe [StopWord]
1013+ , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
10151014 , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
10161015 , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
10171016 , moreLikeThisMinWordLength :: Maybe MinWordLength
@@ -1741,10 +1740,13 @@ instance FromJSON Filter where
17411740 <*> o .: "optimize_bbox"
17421741 <*> o .:? "_cache" .!= defaultCache
17431742 _ -> fail "Could not find GeoDistanceFilter field name"
1744− geoDistanceRangeFilter o = flip fieldTagged o $ \fn o' -> do
1745− gp <- GeoPoint fn <$> parseJSON (Object o')
1746− rng <- DistanceRange <$> o .: "from" <*> o .: "to"
1747− return (GeoDistanceRangeFilter gp rng)
1743+ geoDistanceRangeFilter o = do
1744+ case HM.toList (deleteSeveral ["from", "to"] o) of
1745+ [(fn, v)] -> do
1746+ gp <- GeoPoint (FieldName fn) <$> parseJSON v
1747+ rng <- DistanceRange <$> o .: "from" <*> o .: "to"
1748+ return (GeoDistanceRangeFilter gp rng)
1749+ _ -> fail "Could not find GeoDistanceRangeFilter field name"
17481750 geoPolygonFilter = fieldTagged $ \fn o -> GeoPolygonFilter fn <$> o .: "points"
17491751 idsFilter o = IdsFilter <$> o .: "type"
17501752 <*> o .: "values"
@@ -1764,11 +1766,14 @@ instance FromJSON Filter where
17641766 <*> o .: "execution"
17651767 <*> o .:? "_cache" .!= defaultCache
17661768 _ -> fail "Could not find field name for RangeFilter"
1767− regexpFilter = fieldTagged $ \fn o -> RegexpFilter fn <$> o .: "value"
1768− <*> o .: "flags"
1769− <*> o .: "_name"
1770− <*> o .:? "_cache" .!= defaultCache
1771− <*> o .: "_cache_key"
1769+ regexpFilter o = case HM.toList (deleteSeveral ["_name", "_cache", "_cache_key"] o) of
1770+ [(fn, Object o')] -> RegexpFilter (FieldName fn)
1771+ <$> o' .: "value"
1772+ <*> o' .: "flags"
1773+ <*> o .: "_name"
1774+ <*> o .:? "_cache" .!= defaultCache
1775+ <*> o .: "_cache_key"
1776+ _ -> fail "Could not find field name for RegexpFilter"
17721777 termFilter o = case HM.toList (HM.delete "_cache" o) of
17731778 [(termField, String termVal)] -> TermFilter (Term termField termVal)
17741779 <$> o .:? "_cache" .!= defaultCache
@@ -1793,12 +1798,9 @@ instance ToJSON Query where
17931798 boosted = maybe [] (return . ("boost" .=)) boost
17941799 merged = mappend base boosted
17951800
1796− toJSON (TermsQuery terms) =
1801+ toJSON (TermsQuery fieldName terms) =
17971802 object [ "terms" .= object conjoined ]
1798− where conjoined = [ getTermsField terms .=
1799− fmap (toJSON . getTermValue) (toList terms)]
1800− getTermsField ((Term f _ ) :| _) = f
1801− getTermValue (Term _ v) = v
1803+ where conjoined = [fieldName .= terms]
18021804 toJSON (IdsQuery idsQueryMappingName docIds) =
18031805 object [ "ids" .= object conjoined ]
18041806 where conjoined = [ "type" .= idsQueryMappingName
@@ -1913,7 +1915,7 @@ instance FromJSON Query where
19131915 termsQuery o = case HM.toList o of
19141916 [(fn, vs)] -> do vals <- parseJSON vs
19151917 case vals of
1916− x:xs -> return (TermsQuery (Term fn <$> x :| xs))
1918+ x:xs -> return (TermsQuery fn (x :| xs))
19171919 _ -> fail "Expected non empty list of values"
19181920 _ -> fail "Expected object with 1 field-named key"
19191921 idsQuery o = IdsQuery <$> o .: "type"
@@ -1970,9 +1972,11 @@ instance FromJSON SimpleQueryStringQuery where
19701972 <*> o .:? "fields"
19711973 <*> o .:? "default_operator"
19721974 <*> o .:? "analyzer"
1973− <*> o .:? "flags"
1975+ <*> (parseFlags <$> o .:? "flags")
19741976 <*> o .:? "lowercase_expanded_terms"
19751977 <*> o .:? "locale"
1978+ parseFlags (Just (x:xs)) = Just (x :| xs)
1979+ parseFlags _ = Nothing
19761980
19771981instance ToJSON FieldOrFields where
19781982 toJSON (FofField fieldName) =
@@ -1982,7 +1986,7 @@ instance ToJSON FieldOrFields where
19821986
19831987instance FromJSON FieldOrFields where
19841988 parseJSON v = FofField <$> parseJSON v
1985− <|> FofFields <$> parseJSON v
1989+ <|> FofFields <$> (parseNEJSON =<< parseJSON v)
19861990
19871991instance ToJSON SimpleQueryFlag where
19881992 toJSON SimpleQueryAll = "ALL"
@@ -2103,10 +2107,10 @@ instance FromJSON RangeValue where
21032107 gt <- o .:? "gt"
21042108 gte <- o .:? "gte"
21052109 case (lt, lte, gt, gte) of
2106− (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD a) (LessThanD b))
2107− (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD a) (LessThanD b))
2108− (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD a) (LessThanEqD b))
2109− (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD a) (LessThanEqD b))
2110+ (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))
2111+ (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))
2112+ (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))
2113+ (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))
21102114 (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))
21112115 (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))
21122116 (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))
@@ -2117,10 +2121,10 @@ instance FromJSON RangeValue where
21172121 gt <- o .:? "gt"
21182122 gte <- o .:? "gte"
21192123 case (lt, lte, gt, gte) of
2120− (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan a) (LessThan b))
2121− (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq a) (LessThan b))
2122− (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan a) (LessThanEq b))
2123− (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq a) (LessThanEq b))
2124+ (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))
2125+ (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))
2126+ (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))
2127+ (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))
21242128 (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))
21252129 (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))
21262130 (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))
@@ -2180,7 +2184,7 @@ instance FromJSON MoreLikeThisFieldQuery where
21802184 <*> o .:? "percent_terms_to_match"
21812185 <*> o .:? "min_term_freq"
21822186 <*> o .:? "max_query_terms"
2183− <*> o .:? "stop_words"
2187+ <*> (optionalNE =<< o .:? "stop_words")
21842188 <*> o .:? "min_doc_freq"
21852189 <*> o .:? "max_doc_freq"
21862190 <*> o .:? "min_word_length"
@@ -2188,6 +2192,7 @@ instance FromJSON MoreLikeThisFieldQuery where
21882192 <*> o .:? "boost_terms"
21892193 <*> o .:? "boost"
21902194 <*> o .:? "analyzer"
2195+ optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
21912196
21922197instance ToJSON MoreLikeThisQuery where
21932198 toJSON (MoreLikeThisQuery text fields percent
@@ -2212,11 +2217,11 @@ instance FromJSON MoreLikeThisQuery where
22122217 parseJSON = withObject "MoreLikeThisQuery" parse
22132218 where parse o = MoreLikeThisQuery
22142219 <$> o .: "like_text"
2215− <*> o .:? "fields"
2220+ <*> (optionalNE =<< o .:? "fields")
22162221 <*> o .:? "percent_terms_to_match"
22172222 <*> o .:? "min_term_freq"
22182223 <*> o .:? "max_query_terms"
2219− <*> o .:? "stop_words"
2224+ <*> (optionalNE =<< o .:? "stop_words")
22202225 <*> o .:? "min_doc_freq"
22212226 <*> o .:? "max_doc_freq"
22222227 <*> o .:? "min_word_length"
@@ -2224,6 +2229,7 @@ instance FromJSON MoreLikeThisQuery where
22242229 <*> o .:? "boost_terms"
22252230 <*> o .:? "boost"
22262231 <*> o .:? "analyzer"
2232+ optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
22272233
22282234instance ToJSON IndicesQuery where
22292235 toJSON (IndicesQuery indices query noMatch) =
@@ -2234,7 +2240,7 @@ instance ToJSON IndicesQuery where
22342240instance FromJSON IndicesQuery where
22352241 parseJSON = withObject "IndicesQuery" parse
22362242 where parse o = IndicesQuery
2237− <$> o .: "indices"
2243+ <$> o .:? "indices" .!= []
22382244 <*> o .: "query"
22392245 <*> o .:? "no_match_query"
22402246