git.iko.soy/typeable/bloodhound
on master help sign in
Colocate instances w/ datatypes
commit8cc73961cd4f616eac2b2fe4557dc8b2718880d5 authorChris Allen <cma@bitemyapp.com> dateTue 13 Feb 2018, 16:46 (9 years ago) parentb8196f5
1 file changed+1068−1053
src/Database/V5/Bloodhound/Internal/Query.hs+1068−1053
src/Database/V5/Bloodhound/Internal/Query.hs+1068−1053
@@ -49,6 +49,173 @@ data Query =
4949 | QueryMatchNoneQuery
5050 deriving (Eq, Show)
5151
52+instance ToJSON Query where
53+ toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
54+ object [ "term" .=
55+ object [termQueryField .= object merged]]
56+ where
57+ base = [ "value" .= termQueryValue ]
58+ boosted = maybe [] (return . ("boost" .=)) boost
59+ merged = mappend base boosted
60+
61+ toJSON (TermsQuery fieldName terms) =
62+ object [ "terms" .= object conjoined ]
63+ where conjoined = [fieldName .= terms]
64+
65+ toJSON (IdsQuery idsQueryMappingName docIds) =
66+ object [ "ids" .= object conjoined ]
67+ where conjoined = [ "type" .= idsQueryMappingName
68+ , "values" .= fmap toJSON docIds ]
69+
70+ toJSON (QueryQueryStringQuery qQueryStringQuery) =
71+ object [ "query_string" .= qQueryStringQuery ]
72+
73+ toJSON (QueryMatchQuery matchQuery) =
74+ object [ "match" .= matchQuery ]
75+
76+ toJSON (QueryMultiMatchQuery multiMatchQuery) =
77+ toJSON multiMatchQuery
78+
79+ toJSON (QueryBoolQuery boolQuery) =
80+ object [ "bool" .= boolQuery ]
81+
82+ toJSON (QueryBoostingQuery boostingQuery) =
83+ object [ "boosting" .= boostingQuery ]
84+
85+ toJSON (QueryCommonTermsQuery commonTermsQuery) =
86+ object [ "common" .= commonTermsQuery ]
87+
88+ toJSON (ConstantScoreQuery query boost) =
89+ object ["constant_score" .= object ["query" .= query
90+ , "boost" .= boost]]
91+
92+ toJSON (QueryFunctionScoreQuery functionScoreQuery) =
93+ object [ "function_score" .= functionScoreQuery ]
94+
95+ toJSON (QueryDisMaxQuery disMaxQuery) =
96+ object [ "dis_max" .= disMaxQuery ]
97+
98+ toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
99+ object [ "fuzzy_like_this" .= fuzzyQuery ]
100+
101+ toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
102+ object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
103+
104+ toJSON (QueryFuzzyQuery fuzzyQuery) =
105+ object [ "fuzzy" .= fuzzyQuery ]
106+
107+ toJSON (QueryHasChildQuery childQuery) =
108+ object [ "has_child" .= childQuery ]
109+
110+ toJSON (QueryHasParentQuery parentQuery) =
111+ object [ "has_parent" .= parentQuery ]
112+
113+ toJSON (QueryIndicesQuery qIndicesQuery) =
114+ object [ "indices" .= qIndicesQuery ]
115+
116+ toJSON (MatchAllQuery boost) =
117+ object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
118+
119+ toJSON (QueryMoreLikeThisQuery query) =
120+ object [ "more_like_this" .= query ]
121+
122+ toJSON (QueryMoreLikeThisFieldQuery query) =
123+ object [ "more_like_this_field" .= query ]
124+
125+ toJSON (QueryNestedQuery query) =
126+ object [ "nested" .= query ]
127+
128+ toJSON (QueryPrefixQuery query) =
129+ object [ "prefix" .= query ]
130+
131+ toJSON (QueryRangeQuery query) =
132+ object [ "range" .= query ]
133+
134+ toJSON (QueryRegexpQuery query) =
135+ object [ "regexp" .= query ]
136+
137+ toJSON (QuerySimpleQueryStringQuery query) =
138+ object [ "simple_query_string" .= query ]
139+
140+ toJSON (QueryExistsQuery (FieldName fieldName)) =
141+ object ["exists" .= object
142+ ["field" .= fieldName]
143+ ]
144+ toJSON QueryMatchNoneQuery =
145+ object ["match_none" .= object []]
146+
147+ toJSON (QueryTemplateQueryInline templateQuery) =
148+ object [ "template" .= templateQuery ]
149+
150+instance FromJSON Query where
151+ parseJSON v = withObject "Query" parse v
152+ where parse o = termQuery `taggedWith` "term"
153+ <|> termsQuery `taggedWith` "terms"
154+ <|> idsQuery `taggedWith` "ids"
155+ <|> queryQueryStringQuery `taggedWith` "query_string"
156+ <|> queryMatchQuery `taggedWith` "match"
157+ <|> queryMultiMatchQuery
158+ <|> queryBoolQuery `taggedWith` "bool"
159+ <|> queryBoostingQuery `taggedWith` "boosting"
160+ <|> queryCommonTermsQuery `taggedWith` "common"
161+ <|> constantScoreQuery `taggedWith` "constant_score"
162+ <|> queryFunctionScoreQuery `taggedWith` "function_score"
163+ <|> queryDisMaxQuery `taggedWith` "dis_max"
164+ <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
165+ <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
166+ <|> queryFuzzyQuery `taggedWith` "fuzzy"
167+ <|> queryHasChildQuery `taggedWith` "has_child"
168+ <|> queryHasParentQuery `taggedWith` "has_parent"
169+ <|> queryIndicesQuery `taggedWith` "indices"
170+ <|> matchAllQuery `taggedWith` "match_all"
171+ <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
172+ <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
173+ <|> queryNestedQuery `taggedWith` "nested"
174+ <|> queryPrefixQuery `taggedWith` "prefix"
175+ <|> queryRangeQuery `taggedWith` "range"
176+ <|> queryRegexpQuery `taggedWith` "regexp"
177+ <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
178+ <|> queryTemplateQueryInline `taggedWith` "template"
179+ where taggedWith parser k = parser =<< o .: k
180+ termQuery = fieldTagged $ \(FieldName fn) o ->
181+ TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
182+ termsQuery o = case HM.toList o of
183+ [(fn, vs)] -> do vals <- parseJSON vs
184+ case vals of
185+ x:xs -> return (TermsQuery fn (x :| xs))
186+ _ -> fail "Expected non empty list of values"
187+ _ -> fail "Expected object with 1 field-named key"
188+ idsQuery o = IdsQuery <$> o .: "type"
189+ <*> o .: "values"
190+ queryQueryStringQuery = pure . QueryQueryStringQuery
191+ queryMatchQuery = pure . QueryMatchQuery
192+ queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
193+ queryBoolQuery = pure . QueryBoolQuery
194+ queryBoostingQuery = pure . QueryBoostingQuery
195+ queryCommonTermsQuery = pure . QueryCommonTermsQuery
196+ constantScoreQuery o = case HM.lookup "query" o of
197+ Just x -> ConstantScoreQuery <$> parseJSON x
198+ <*> o .: "boost"
199+ _ -> fail "Does not appear to be a ConstantScoreQuery"
200+ queryFunctionScoreQuery = pure . QueryFunctionScoreQuery
201+ queryDisMaxQuery = pure . QueryDisMaxQuery
202+ queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
203+ queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
204+ queryFuzzyQuery = pure . QueryFuzzyQuery
205+ queryHasChildQuery = pure . QueryHasChildQuery
206+ queryHasParentQuery = pure . QueryHasParentQuery
207+ queryIndicesQuery = pure . QueryIndicesQuery
208+ matchAllQuery o = MatchAllQuery <$> o .:? "boost"
209+ queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
210+ queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
211+ queryNestedQuery = pure . QueryNestedQuery
212+ queryPrefixQuery = pure . QueryPrefixQuery
213+ queryRangeQuery = pure . QueryRangeQuery
214+ queryRegexpQuery = pure . QueryRegexpQuery
215+ querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
216+ -- queryExistsQuery o = QueryExistsQuery <$> o .: "field"
217+ queryTemplateQueryInline = pure . QueryTemplateQueryInline
218+
52219-- | As of Elastic 2.0, 'Filters' are just 'Queries' housed in a
53220-- Bool Query, and flagged in a different context.
54221newtype Filter = Filter { unFilter :: Query }
@@ -67,11 +234,41 @@ data RegexpQuery =
67234 , regexpQueryBoost :: Maybe Boost
68235 } deriving (Eq, Show)
69236
237+instance ToJSON RegexpQuery where
238+ toJSON (RegexpQuery (FieldName rqQueryField)
239+ (Regexp regexpQueryQuery) rqQueryFlags
240+ rqQueryBoost) =
241+ object [ rqQueryField .= omitNulls base ]
242+ where base = [ "value" .= regexpQueryQuery
243+ , "flags" .= rqQueryFlags
244+ , "boost" .= rqQueryBoost ]
245+
246+instance FromJSON RegexpQuery where
247+ parseJSON = withObject "RegexpQuery" parse
248+ where parse = fieldTagged $ \fn o ->
249+ RegexpQuery fn
250+ <$> o .: "value"
251+ <*> o .: "flags"
252+ <*> o .:? "boost"
253+
70254data RangeQuery =
71255 RangeQuery { rangeQueryField :: FieldName
72256 , rangeQueryRange :: RangeValue
73257 , rangeQueryBoost :: Boost } deriving (Eq, Show)
74258
259+instance ToJSON RangeQuery where
260+ toJSON (RangeQuery (FieldName fieldName) range boost) =
261+ object [ fieldName .= object conjoined ]
262+ where
263+ conjoined = ("boost" .= boost) : rangeValueToPair range
264+
265+instance FromJSON RangeQuery where
266+ parseJSON = withObject "RangeQuery" parse
267+ where parse = fieldTagged $ \fn o ->
268+ RangeQuery fn
269+ <$> parseJSON (Object o)
270+ <*> o .: "boost"
271+
75272mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
76273mkRangeQuery f r = RangeQuery f r (Boost 1.0)
77274
@@ -86,8 +283,32 @@ data SimpleQueryStringQuery =
86283 , simpleQueryStringLocale :: Maybe Locale
87284 } deriving (Eq, Show)
88285
286+
287+instance ToJSON SimpleQueryStringQuery where
288+ toJSON SimpleQueryStringQuery {..} =
289+ omitNulls (base ++ maybeAdd)
290+ where base = [ "query" .= simpleQueryStringQuery ]
291+ maybeAdd = [ "fields" .= simpleQueryStringField
292+ , "default_operator" .= simpleQueryStringOperator
293+ , "analyzer" .= simpleQueryStringAnalyzer
294+ , "flags" .= simpleQueryStringFlags
295+ , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
296+ , "locale" .= simpleQueryStringLocale ]
297+
298+instance FromJSON SimpleQueryStringQuery where
299+ parseJSON = withObject "SimpleQueryStringQuery" parse
300+ where parse o = SimpleQueryStringQuery <$> o .: "query"
301+ <*> o .:? "fields"
302+ <*> o .:? "default_operator"
303+ <*> o .:? "analyzer"
304+ <*> (parseFlags <$> o .:? "flags")
305+ <*> o .:? "lowercase_expanded_terms"
306+ <*> o .:? "locale"
307+ parseFlags (Just (x:xs)) = Just (x :| xs)
308+ parseFlags _ = Nothing
309+
89310data SimpleQueryFlag =
90− SimpleQueryAll
311+ SimpleQueryAll
91312 | SimpleQueryNone
92313 | SimpleQueryAnd
93314 | SimpleQueryOr
@@ -100,6 +321,36 @@ data SimpleQueryFlag =
100321 | SimpleQueryNear
101322 | SimpleQuerySlop deriving (Eq, Show)
102323
324+instance ToJSON SimpleQueryFlag where
325+ toJSON SimpleQueryAll = "ALL"
326+ toJSON SimpleQueryNone = "NONE"
327+ toJSON SimpleQueryAnd = "AND"
328+ toJSON SimpleQueryOr = "OR"
329+ toJSON SimpleQueryPrefix = "PREFIX"
330+ toJSON SimpleQueryPhrase = "PHRASE"
331+ toJSON SimpleQueryPrecedence = "PRECEDENCE"
332+ toJSON SimpleQueryEscape = "ESCAPE"
333+ toJSON SimpleQueryWhitespace = "WHITESPACE"
334+ toJSON SimpleQueryFuzzy = "FUZZY"
335+ toJSON SimpleQueryNear = "NEAR"
336+ toJSON SimpleQuerySlop = "SLOP"
337+
338+instance FromJSON SimpleQueryFlag where
339+ parseJSON = withText "SimpleQueryFlag" parse
340+ where parse "ALL" = pure SimpleQueryAll
341+ parse "NONE" = pure SimpleQueryNone
342+ parse "AND" = pure SimpleQueryAnd
343+ parse "OR" = pure SimpleQueryOr
344+ parse "PREFIX" = pure SimpleQueryPrefix
345+ parse "PHRASE" = pure SimpleQueryPhrase
346+ parse "PRECEDENCE" = pure SimpleQueryPrecedence
347+ parse "ESCAPE" = pure SimpleQueryEscape
348+ parse "WHITESPACE" = pure SimpleQueryWhitespace
349+ parse "FUZZY" = pure SimpleQueryFuzzy
350+ parse "NEAR" = pure SimpleQueryNear
351+ parse "SLOP" = pure SimpleQuerySlop
352+ parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
353+
103354-- use_dis_max and tie_breaker when fields are plural?
104355data QueryStringQuery =
105356 QueryStringQuery
@@ -122,29 +373,117 @@ data QueryStringQuery =
122373 , queryStringLocale :: Maybe Locale
123374 } deriving (Eq, Show)
124375
125−mkQueryStringQuery :: QueryString -> QueryStringQuery
126−mkQueryStringQuery qs =
127− QueryStringQuery qs Nothing Nothing
128− Nothing Nothing Nothing Nothing
129− Nothing Nothing Nothing Nothing
376+
377+instance ToJSON QueryStringQuery where
378+ toJSON (QueryStringQuery qsQueryString
379+ qsDefaultField qsOperator
380+ qsAnalyzer qsAllowWildcard
381+ qsLowercaseExpanded qsEnablePositionIncrements
382+ qsFuzzyMaxExpansions qsFuzziness
383+ qsFuzzyPrefixLength qsPhraseSlop
384+ qsBoost qsAnalyzeWildcard
385+ qsGeneratePhraseQueries qsMinimumShouldMatch
386+ qsLenient qsLocale) =
387+ omitNulls base
388+ where
389+ base = [ "query" .= qsQueryString
390+ , "default_field" .= qsDefaultField
391+ , "default_operator" .= qsOperator
392+ , "analyzer" .= qsAnalyzer
393+ , "allow_leading_wildcard" .= qsAllowWildcard
394+ , "lowercase_expanded_terms" .= qsLowercaseExpanded
395+ , "enable_position_increments" .= qsEnablePositionIncrements
396+ , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
397+ , "fuzziness" .= qsFuzziness
398+ , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
399+ , "phrase_slop" .= qsPhraseSlop
400+ , "boost" .= qsBoost
401+ , "analyze_wildcard" .= qsAnalyzeWildcard
402+ , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
403+ , "minimum_should_match" .= qsMinimumShouldMatch
404+ , "lenient" .= qsLenient
405+ , "locale" .= qsLocale ]
406+
407+instance FromJSON QueryStringQuery where
408+ parseJSON = withObject "QueryStringQuery" parse
409+ where parse o = QueryStringQuery
410+ <$> o .: "query"
411+ <*> o .:? "default_field"
412+ <*> o .:? "default_operator"
413+ <*> o .:? "analyzer"
414+ <*> o .:? "allow_leading_wildcard"
415+ <*> o .:? "lowercase_expanded_terms"
416+ <*> o .:? "enable_position_increments"
417+ <*> o .:? "fuzzy_max_expansions"
418+ <*> o .:? "fuzziness"
419+ <*> o .:? "fuzzy_prefix_length"
420+ <*> o .:? "phrase_slop"
421+ <*> o .:? "boost"
422+ <*> o .:? "analyze_wildcard"
423+ <*> o .:? "auto_generate_phrase_queries"
424+ <*> o .:? "minimum_should_match"
425+ <*> o .:? "lenient"
426+ <*> o .:? "locale"
427+
428+mkQueryStringQuery :: QueryString -> QueryStringQuery
429+mkQueryStringQuery qs =
430+ QueryStringQuery qs Nothing Nothing
431+ Nothing Nothing Nothing Nothing
432+ Nothing Nothing Nothing Nothing
130433 Nothing Nothing Nothing Nothing
131434 Nothing Nothing
132435
133436data FieldOrFields = FofField FieldName
134437 | FofFields (NonEmpty FieldName) deriving (Eq, Show)
135438
439+instance ToJSON FieldOrFields where
440+ toJSON (FofField fieldName) =
441+ toJSON fieldName
442+ toJSON (FofFields fieldNames) =
443+ toJSON fieldNames
444+
445+instance FromJSON FieldOrFields where
446+ parseJSON v = FofField <$> parseJSON v
447+ <|> FofFields <$> (parseNEJSON =<< parseJSON v)
448+
136449data PrefixQuery =
137450 PrefixQuery
138451 { prefixQueryField :: FieldName
139452 , prefixQueryPrefixValue :: Text
140453 , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show)
141454
455+instance ToJSON PrefixQuery where
456+ toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
457+ object [ fieldName .= omitNulls base ]
458+ where base = [ "value" .= queryValue
459+ , "boost" .= boost ]
460+
461+instance FromJSON PrefixQuery where
462+ parseJSON = withObject "PrefixQuery" parse
463+ where parse = fieldTagged $ \fn o ->
464+ PrefixQuery fn
465+ <$> o .: "value"
466+ <*> o .:? "boost"
467+
142468data NestedQuery =
143469 NestedQuery
144470 { nestedQueryPath :: QueryPath
145471 , nestedQueryScoreType :: ScoreType
146472 , nestedQuery :: Query } deriving (Eq, Show)
147473
474+instance ToJSON NestedQuery where
475+ toJSON (NestedQuery nqPath nqScoreType nqQuery) =
476+ object [ "path" .= nqPath
477+ , "score_mode" .= nqScoreType
478+ , "query" .= nqQuery ]
479+
480+instance FromJSON NestedQuery where
481+ parseJSON = withObject "NestedQuery" parse
482+ where parse o = NestedQuery
483+ <$> o .: "path"
484+ <*> o .: "score_mode"
485+ <*> o .: "query"
486+
148487data MoreLikeThisFieldQuery =
149488 MoreLikeThisFieldQuery
150489 { moreLikeThisFieldText :: Text
@@ -163,6 +502,45 @@ data MoreLikeThisFieldQuery =
163502 , moreLikeThisFieldAnalyzer :: Maybe Analyzer
164503 } deriving (Eq, Show)
165504
505+
506+instance ToJSON MoreLikeThisFieldQuery where
507+ toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
508+ percent mtf mqt stopwords mindf maxdf
509+ minwl maxwl boostTerms boost analyzer) =
510+ object [ fieldName .= omitNulls base ]
511+ where base = [ "like_text" .= text
512+ , "percent_terms_to_match" .= percent
513+ , "min_term_freq" .= mtf
514+ , "max_query_terms" .= mqt
515+ , "stop_words" .= stopwords
516+ , "min_doc_freq" .= mindf
517+ , "max_doc_freq" .= maxdf
518+ , "min_word_length" .= minwl
519+ , "max_word_length" .= maxwl
520+ , "boost_terms" .= boostTerms
521+ , "boost" .= boost
522+ , "analyzer" .= analyzer ]
523+
524+instance FromJSON MoreLikeThisFieldQuery where
525+ parseJSON = withObject "MoreLikeThisFieldQuery" parse
526+ where parse = fieldTagged $ \fn o ->
527+ MoreLikeThisFieldQuery
528+ <$> o .: "like_text"
529+ <*> pure fn
530+ <*> o .:? "percent_terms_to_match"
531+ <*> o .:? "min_term_freq"
532+ <*> o .:? "max_query_terms"
533+ -- <*> (optionalNE =<< o .:? "stop_words")
534+ <*> o .:? "stop_words"
535+ <*> o .:? "min_doc_freq"
536+ <*> o .:? "max_doc_freq"
537+ <*> o .:? "min_word_length"
538+ <*> o .:? "max_word_length"
539+ <*> o .:? "boost_terms"
540+ <*> o .:? "boost"
541+ <*> o .:? "analyzer"
542+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
543+
166544data MoreLikeThisQuery =
167545 MoreLikeThisQuery
168546 { moreLikeThisText :: Text
@@ -181,6 +559,46 @@ data MoreLikeThisQuery =
181559 , moreLikeThisAnalyzer :: Maybe Analyzer
182560 } deriving (Eq, Show)
183561
562+
563+instance ToJSON MoreLikeThisQuery where
564+ toJSON (MoreLikeThisQuery text fields percent
565+ mtf mqt stopwords mindf maxdf
566+ minwl maxwl boostTerms boost analyzer) =
567+ omitNulls base
568+ where base = [ "like_text" .= text
569+ , "fields" .= fields
570+ , "percent_terms_to_match" .= percent
571+ , "min_term_freq" .= mtf
572+ , "max_query_terms" .= mqt
573+ , "stop_words" .= stopwords
574+ , "min_doc_freq" .= mindf
575+ , "max_doc_freq" .= maxdf
576+ , "min_word_length" .= minwl
577+ , "max_word_length" .= maxwl
578+ , "boost_terms" .= boostTerms
579+ , "boost" .= boost
580+ , "analyzer" .= analyzer ]
581+
582+instance FromJSON MoreLikeThisQuery where
583+ parseJSON = withObject "MoreLikeThisQuery" parse
584+ where parse o = MoreLikeThisQuery
585+ <$> o .: "like_text"
586+ -- <*> (optionalNE =<< o .:? "fields")
587+ <*> o .:? "fields"
588+ <*> o .:? "percent_terms_to_match"
589+ <*> o .:? "min_term_freq"
590+ <*> o .:? "max_query_terms"
591+ -- <*> (optionalNE =<< o .:? "stop_words")
592+ <*> o .:? "stop_words"
593+ <*> o .:? "min_doc_freq"
594+ <*> o .:? "max_doc_freq"
595+ <*> o .:? "min_word_length"
596+ <*> o .:? "max_word_length"
597+ <*> o .:? "boost_terms"
598+ <*> o .:? "boost"
599+ <*> o .:? "analyzer"
600+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
601+
184602data IndicesQuery =
185603 IndicesQuery
186604 { indicesQueryIndices :: [IndexName]
@@ -188,24 +606,78 @@ data IndicesQuery =
188606 -- default "all"
189607 , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show)
190608
609+
610+instance ToJSON IndicesQuery where
611+ toJSON (IndicesQuery indices query noMatch) =
612+ omitNulls [ "indices" .= indices
613+ , "no_match_query" .= noMatch
614+ , "query" .= query ]
615+
616+instance FromJSON IndicesQuery where
617+ parseJSON = withObject "IndicesQuery" parse
618+ where parse o = IndicesQuery
619+ <$> o .:? "indices" .!= []
620+ <*> o .: "query"
621+ <*> o .:? "no_match_query"
622+
191623data HasParentQuery =
192624 HasParentQuery
193625 { hasParentQueryType :: TypeName
194626 , hasParentQuery :: Query
195627 , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)
196628
629+instance ToJSON HasParentQuery where
630+ toJSON (HasParentQuery queryType query scoreType) =
631+ omitNulls [ "parent_type" .= queryType
632+ , "score_type" .= scoreType
633+ , "query" .= query ]
634+
635+instance FromJSON HasParentQuery where
636+ parseJSON = withObject "HasParentQuery" parse
637+ where parse o = HasParentQuery
638+ <$> o .: "parent_type"
639+ <*> o .: "query"
640+ <*> o .:? "score_type"
641+
197642data HasChildQuery =
198643 HasChildQuery
199644 { hasChildQueryType :: TypeName
200645 , hasChildQuery :: Query
201646 , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)
202647
648+instance ToJSON HasChildQuery where
649+ toJSON (HasChildQuery queryType query scoreType) =
650+ omitNulls [ "query" .= query
651+ , "score_type" .= scoreType
652+ , "type" .= queryType ]
653+
654+instance FromJSON HasChildQuery where
655+ parseJSON = withObject "HasChildQuery" parse
656+ where parse o = HasChildQuery
657+ <$> o .: "type"
658+ <*> o .: "query"
659+ <*> o .:? "score_type"
660+
203661data ScoreType =
204− ScoreTypeMax
662+ ScoreTypeMax
205663 | ScoreTypeSum
206664 | ScoreTypeAvg
207665 | ScoreTypeNone deriving (Eq, Show)
208666
667+instance ToJSON ScoreType where
668+ toJSON ScoreTypeMax = "max"
669+ toJSON ScoreTypeAvg = "avg"
670+ toJSON ScoreTypeSum = "sum"
671+ toJSON ScoreTypeNone = "none"
672+
673+instance FromJSON ScoreType where
674+ parseJSON = withText "ScoreType" parse
675+ where parse "max" = pure ScoreTypeMax
676+ parse "avg" = pure ScoreTypeAvg
677+ parse "sum" = pure ScoreTypeSum
678+ parse "none" = pure ScoreTypeNone
679+ parse t = fail ("Unexpected ScoreType: " <> show t)
680+
209681data FuzzyQuery =
210682 FuzzyQuery { fuzzyQueryField :: FieldName
211683 , fuzzyQueryValue :: Text
@@ -215,6 +687,27 @@ data FuzzyQuery =
215687 , fuzzyQueryBoost :: Maybe Boost
216688 } deriving (Eq, Show)
217689
690+
691+instance ToJSON FuzzyQuery where
692+ toJSON (FuzzyQuery (FieldName fieldName) queryText
693+ prefixLength maxEx fuzziness boost) =
694+ object [ fieldName .= omitNulls base ]
695+ where base = [ "value" .= queryText
696+ , "fuzziness" .= fuzziness
697+ , "prefix_length" .= prefixLength
698+ , "boost" .= boost
699+ , "max_expansions" .= maxEx ]
700+
701+instance FromJSON FuzzyQuery where
702+ parseJSON = withObject "FuzzyQuery" parse
703+ where parse = fieldTagged $ \fn o ->
704+ FuzzyQuery fn
705+ <$> o .: "value"
706+ <*> o .: "prefix_length"
707+ <*> o .: "max_expansions"
708+ <*> o .: "fuzziness"
709+ <*> o .:? "boost"
710+
218711data FuzzyLikeFieldQuery =
219712 FuzzyLikeFieldQuery
220713 { fuzzyLikeField :: FieldName
@@ -228,18 +721,70 @@ data FuzzyLikeFieldQuery =
228721 , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
229722 } deriving (Eq, Show)
230723
231−data FuzzyLikeThisQuery =
232− FuzzyLikeThisQuery
233− { fuzzyLikeFields :: [FieldName]
234− , fuzzyLikeText :: Text
235− , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
236− , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
237− , fuzzyLikeFuzziness :: Fuzziness
238− , fuzzyLikePrefixLength :: PrefixLength
239− , fuzzyLikeBoost :: Boost
724+
725+instance ToJSON FuzzyLikeFieldQuery where
726+ toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
727+ fieldText maxTerms ignoreFreq fuzziness prefixLength
728+ boost analyzer) =
729+ object [ fieldName .=
730+ omitNulls [ "like_text" .= fieldText
731+ , "max_query_terms" .= maxTerms
732+ , "ignore_tf" .= ignoreFreq
733+ , "fuzziness" .= fuzziness
734+ , "prefix_length" .= prefixLength
735+ , "analyzer" .= analyzer
736+ , "boost" .= boost ]]
737+
738+instance FromJSON FuzzyLikeFieldQuery where
739+ parseJSON = withObject "FuzzyLikeFieldQuery" parse
740+ where parse = fieldTagged $ \fn o ->
741+ FuzzyLikeFieldQuery fn
742+ <$> o .: "like_text"
743+ <*> o .: "max_query_terms"
744+ <*> o .: "ignore_tf"
745+ <*> o .: "fuzziness"
746+ <*> o .: "prefix_length"
747+ <*> o .: "boost"
748+ <*> o .:? "analyzer"
749+
750+data FuzzyLikeThisQuery =
751+ FuzzyLikeThisQuery
752+ { fuzzyLikeFields :: [FieldName]
753+ , fuzzyLikeText :: Text
754+ , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
755+ , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
756+ , fuzzyLikeFuzziness :: Fuzziness
757+ , fuzzyLikePrefixLength :: PrefixLength
758+ , fuzzyLikeBoost :: Boost
240759 , fuzzyLikeAnalyzer :: Maybe Analyzer
241760 } deriving (Eq, Show)
242761
762+
763+instance ToJSON FuzzyLikeThisQuery where
764+ toJSON (FuzzyLikeThisQuery fields text maxTerms
765+ ignoreFreq fuzziness prefixLength boost analyzer) =
766+ omitNulls base
767+ where base = [ "fields" .= fields
768+ , "like_text" .= text
769+ , "max_query_terms" .= maxTerms
770+ , "ignore_tf" .= ignoreFreq
771+ , "fuzziness" .= fuzziness
772+ , "prefix_length" .= prefixLength
773+ , "analyzer" .= analyzer
774+ , "boost" .= boost ]
775+
776+instance FromJSON FuzzyLikeThisQuery where
777+ parseJSON = withObject "FuzzyLikeThisQuery" parse
778+ where parse o = FuzzyLikeThisQuery
779+ <$> o .:? "fields" .!= []
780+ <*> o .: "like_text"
781+ <*> o .: "max_query_terms"
782+ <*> o .: "ignore_tf"
783+ <*> o .: "fuzziness"
784+ <*> o .: "prefix_length"
785+ <*> o .: "boost"
786+ <*> o .:? "analyzer"
787+
243788data DisMaxQuery =
244789 DisMaxQuery { disMaxQueries :: [Query]
245790 -- default 0.0
@@ -247,19 +792,70 @@ data DisMaxQuery =
247792 , disMaxBoost :: Maybe Boost
248793 } deriving (Eq, Show)
249794
250−data MatchQuery =
251− MatchQuery { matchQueryField :: FieldName
252− , matchQueryQueryString :: QueryString
253− , matchQueryOperator :: BooleanOperator
254− , matchQueryZeroTerms :: ZeroTermsQuery
255− , matchQueryCutoffFrequency :: Maybe CutoffFrequency
256− , matchQueryMatchType :: Maybe MatchQueryType
257− , matchQueryAnalyzer :: Maybe Analyzer
258− , matchQueryMaxExpansions :: Maybe MaxExpansions
259− , matchQueryLenient :: Maybe Lenient
260− , matchQueryBoost :: Maybe Boost
261− , matchQueryMinimumShouldMatch :: Maybe Text
262− } deriving (Eq, Show)
795+
796+instance ToJSON DisMaxQuery where
797+ toJSON (DisMaxQuery queries tiebreaker boost) =
798+ omitNulls base
799+ where base = [ "queries" .= queries
800+ , "boost" .= boost
801+ , "tie_breaker" .= tiebreaker ]
802+
803+instance FromJSON DisMaxQuery where
804+ parseJSON = withObject "DisMaxQuery" parse
805+ where parse o = DisMaxQuery
806+ <$> o .:? "queries" .!= []
807+ <*> o .: "tie_breaker"
808+ <*> o .:? "boost"
809+
810+data MatchQuery = MatchQuery
811+ { matchQueryField :: FieldName
812+ , matchQueryQueryString :: QueryString
813+ , matchQueryOperator :: BooleanOperator
814+ , matchQueryZeroTerms :: ZeroTermsQuery
815+ , matchQueryCutoffFrequency :: Maybe CutoffFrequency
816+ , matchQueryMatchType :: Maybe MatchQueryType
817+ , matchQueryAnalyzer :: Maybe Analyzer
818+ , matchQueryMaxExpansions :: Maybe MaxExpansions
819+ , matchQueryLenient :: Maybe Lenient
820+ , matchQueryBoost :: Maybe Boost
821+ , matchQueryMinimumShouldMatch :: Maybe Text
822+ } deriving (Eq, Show)
823+
824+
825+instance ToJSON MatchQuery where
826+ toJSON (MatchQuery (FieldName fieldName)
827+ (QueryString mqQueryString) booleanOperator
828+ zeroTermsQuery cutoffFrequency matchQueryType
829+ analyzer maxExpansions lenient boost
830+ minShouldMatch
831+ ) =
832+ object [ fieldName .= omitNulls base ]
833+ where base = [ "query" .= mqQueryString
834+ , "operator" .= booleanOperator
835+ , "zero_terms_query" .= zeroTermsQuery
836+ , "cutoff_frequency" .= cutoffFrequency
837+ , "type" .= matchQueryType
838+ , "analyzer" .= analyzer
839+ , "max_expansions" .= maxExpansions
840+ , "lenient" .= lenient
841+ , "boost" .= boost
842+ , "minimum_should_match" .= minShouldMatch
843+ ]
844+
845+instance FromJSON MatchQuery where
846+ parseJSON = withObject "MatchQuery" parse
847+ where parse = fieldTagged $ \fn o ->
848+ MatchQuery fn
849+ <$> o .: "query"
850+ <*> o .: "operator"
851+ <*> o .: "zero_terms_query"
852+ <*> o .:? "cutoff_frequency"
853+ <*> o .:? "type"
854+ <*> o .:? "analyzer"
855+ <*> o .:? "max_expansions"
856+ <*> o .:? "lenient"
857+ <*> o .:? "boost"
858+ <*> o .:? "minimum_should_match"
263859
264860{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
265861 enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
@@ -268,20 +864,61 @@ mkMatchQuery :: FieldName -> QueryString -> MatchQuery
268864mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing Nothing
269865
270866data MatchQueryType =
271− MatchPhrase
867+ MatchPhrase
272868 | MatchPhrasePrefix deriving (Eq, Show)
273869
274−data MultiMatchQuery =
275− MultiMatchQuery { multiMatchQueryFields :: [FieldName]
276− , multiMatchQueryString :: QueryString
277− , multiMatchQueryOperator :: BooleanOperator
278− , multiMatchQueryZeroTerms :: ZeroTermsQuery
279− , multiMatchQueryTiebreaker :: Maybe Tiebreaker
280− , multiMatchQueryType :: Maybe MultiMatchQueryType
281− , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
282− , multiMatchQueryAnalyzer :: Maybe Analyzer
283− , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
284− , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Show)
870+instance ToJSON MatchQueryType where
871+ toJSON MatchPhrase = "phrase"
872+ toJSON MatchPhrasePrefix = "phrase_prefix"
873+
874+instance FromJSON MatchQueryType where
875+ parseJSON = withText "MatchQueryType" parse
876+ where parse "phrase" = pure MatchPhrase
877+ parse "phrase_prefix" = pure MatchPhrasePrefix
878+ parse t = fail ("Unexpected MatchQueryType: " <> show t)
879+
880+data MultiMatchQuery = MultiMatchQuery
881+ { multiMatchQueryFields :: [FieldName]
882+ , multiMatchQueryString :: QueryString
883+ , multiMatchQueryOperator :: BooleanOperator
884+ , multiMatchQueryZeroTerms :: ZeroTermsQuery
885+ , multiMatchQueryTiebreaker :: Maybe Tiebreaker
886+ , multiMatchQueryType :: Maybe MultiMatchQueryType
887+ , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
888+ , multiMatchQueryAnalyzer :: Maybe Analyzer
889+ , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
890+ , multiMatchQueryLenient :: Maybe Lenient
891+ } deriving (Eq, Show)
892+
893+instance ToJSON MultiMatchQuery where
894+ toJSON (MultiMatchQuery fields (QueryString query) boolOp
895+ ztQ tb mmqt cf analyzer maxEx lenient) =
896+ object ["multi_match" .= omitNulls base]
897+ where base = [ "fields" .= fmap toJSON fields
898+ , "query" .= query
899+ , "operator" .= boolOp
900+ , "zero_terms_query" .= ztQ
901+ , "tie_breaker" .= tb
902+ , "type" .= mmqt
903+ , "cutoff_frequency" .= cf
904+ , "analyzer" .= analyzer
905+ , "max_expansions" .= maxEx
906+ , "lenient" .= lenient ]
907+
908+instance FromJSON MultiMatchQuery where
909+ parseJSON = withObject "MultiMatchQuery" parse
910+ where parse raw = do o <- raw .: "multi_match"
911+ MultiMatchQuery
912+ <$> o .:? "fields" .!= []
913+ <*> o .: "query"
914+ <*> o .: "operator"
915+ <*> o .: "zero_terms_query"
916+ <*> o .:? "tie_breaker"
917+ <*> o .:? "type"
918+ <*> o .:? "cutoff_frequency"
919+ <*> o .:? "analyzer"
920+ <*> o .:? "max_expansions"
921+ <*> o .:? "lenient"
285922
286923{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
287924 enabling you to provide only the list of 'FieldName's and 'QueryString' to
@@ -294,12 +931,28 @@ mkMultiMatchQuery matchFields query =
294931 Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
295932
296933data MultiMatchQueryType =
297− MultiMatchBestFields
934+ MultiMatchBestFields
298935 | MultiMatchMostFields
299936 | MultiMatchCrossFields
300937 | MultiMatchPhrase
301938 | MultiMatchPhrasePrefix deriving (Eq, Show)
302939
940+instance ToJSON MultiMatchQueryType where
941+ toJSON MultiMatchBestFields = "best_fields"
942+ toJSON MultiMatchMostFields = "most_fields"
943+ toJSON MultiMatchCrossFields = "cross_fields"
944+ toJSON MultiMatchPhrase = "phrase"
945+ toJSON MultiMatchPhrasePrefix = "phrase_prefix"
946+
947+instance FromJSON MultiMatchQueryType where
948+ parseJSON = withText "MultiMatchPhrasePrefix" parse
949+ where parse "best_fields" = pure MultiMatchBestFields
950+ parse "most_fields" = pure MultiMatchMostFields
951+ parse "cross_fields" = pure MultiMatchCrossFields
952+ parse "phrase" = pure MultiMatchPhrase
953+ parse "phrase_prefix" = pure MultiMatchPhrasePrefix
954+ parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
955+
303956data BoolQuery =
304957 BoolQuery { boolQueryMustMatch :: [Query]
305958 , boolQueryFilter :: [Filter]
@@ -310,6 +963,29 @@ data BoolQuery =
310963 , boolQueryDisableCoord :: Maybe DisableCoord
311964 } deriving (Eq, Show)
312965
966+
967+instance ToJSON BoolQuery where
968+ toJSON (BoolQuery mustM filterM' notM shouldM bqMin boost disableCoord) =
969+ omitNulls base
970+ where base = [ "must" .= mustM
971+ , "filter" .= filterM'
972+ , "must_not" .= notM
973+ , "should" .= shouldM
974+ , "minimum_should_match" .= bqMin
975+ , "boost" .= boost
976+ , "disable_coord" .= disableCoord ]
977+
978+instance FromJSON BoolQuery where
979+ parseJSON = withObject "BoolQuery" parse
980+ where parse o = BoolQuery
981+ <$> o .:? "must" .!= []
982+ <*> o .:? "filter" .!= []
983+ <*> o .:? "must_not" .!= []
984+ <*> o .:? "should" .!= []
985+ <*> o .:? "minimum_should_match"
986+ <*> o .:? "boost"
987+ <*> o .:? "disable_coord"
988+
313989mkBoolQuery :: [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
314990mkBoolQuery must filt mustNot should =
315991 BoolQuery must filt mustNot should Nothing Nothing Nothing
@@ -319,6 +995,19 @@ data BoostingQuery =
319995 , negativeQuery :: Query
320996 , negativeBoost :: Boost } deriving (Eq, Show)
321997
998+instance ToJSON BoostingQuery where
999+ toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
1000+ object [ "positive" .= bqPositiveQuery
1001+ , "negative" .= bqNegativeQuery
1002+ , "negative_boost" .= bqNegativeBoost ]
1003+
1004+instance FromJSON BoostingQuery where
1005+ parseJSON = withObject "BoostingQuery" parse
1006+ where parse o = BoostingQuery
1007+ <$> o .: "positive"
1008+ <*> o .: "negative"
1009+ <*> o .: "negative_boost"
1010+
3221011data CommonTermsQuery =
3231012 CommonTermsQuery { commonField :: FieldName
3241013 , commonQuery :: QueryString
@@ -331,20 +1020,87 @@ data CommonTermsQuery =
3311020 , commonDisableCoord :: Maybe DisableCoord
3321021 } deriving (Eq, Show)
3331022
1023+
1024+instance ToJSON CommonTermsQuery where
1025+ toJSON (CommonTermsQuery (FieldName fieldName)
1026+ (QueryString query) cf lfo hfo msm
1027+ boost analyzer disableCoord) =
1028+ object [fieldName .= omitNulls base ]
1029+ where base = [ "query" .= query
1030+ , "cutoff_frequency" .= cf
1031+ , "low_freq_operator" .= lfo
1032+ , "minimum_should_match" .= msm
1033+ , "boost" .= boost
1034+ , "analyzer" .= analyzer
1035+ , "disable_coord" .= disableCoord
1036+ , "high_freq_operator" .= hfo ]
1037+
1038+instance FromJSON CommonTermsQuery where
1039+ parseJSON = withObject "CommonTermsQuery" parse
1040+ where parse = fieldTagged $ \fn o ->
1041+ CommonTermsQuery fn
1042+ <$> o .: "query"
1043+ <*> o .: "cutoff_frequency"
1044+ <*> o .: "low_freq_operator"
1045+ <*> o .: "high_freq_operator"
1046+ <*> o .:? "minimum_should_match"
1047+ <*> o .:? "boost"
1048+ <*> o .:? "analyzer"
1049+ <*> o .:? "disable_coord"
1050+
3341051data CommonMinimumMatch =
3351052 CommonMinimumMatchHighLow MinimumMatchHighLow
3361053 | CommonMinimumMatch MinimumMatch
3371054 deriving (Eq, Show)
3381055
1056+
1057+instance ToJSON CommonMinimumMatch where
1058+ toJSON (CommonMinimumMatch mm) = toJSON mm
1059+ toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
1060+ object [ "low_freq" .= lowF
1061+ , "high_freq" .= highF ]
1062+
1063+instance FromJSON CommonMinimumMatch where
1064+ parseJSON v = parseMinimum v
1065+ <|> parseMinimumHighLow v
1066+ where parseMinimum = fmap CommonMinimumMatch . parseJSON
1067+ parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
1068+ MinimumMatchHighLow
1069+ <$> o .: "low_freq"
1070+ <*> o .: "high_freq")
1071+
3391072data MinimumMatchHighLow =
3401073 MinimumMatchHighLow { lowFreq :: MinimumMatch
3411074 , highFreq :: MinimumMatch } deriving (Eq, Show)
3421075
343−data ZeroTermsQuery = ZeroTermsNone
344− | ZeroTermsAll deriving (Eq, Show)
1076+data ZeroTermsQuery =
1077+ ZeroTermsNone
1078+ | ZeroTermsAll deriving (Eq, Show)
3451079
346−data RangeExecution = RangeExecutionIndex
347− | RangeExecutionFielddata deriving (Eq, Show)
1080+instance ToJSON ZeroTermsQuery where
1081+ toJSON ZeroTermsNone = String "none"
1082+ toJSON ZeroTermsAll = String "all"
1083+
1084+instance FromJSON ZeroTermsQuery where
1085+ parseJSON = withText "ZeroTermsQuery" parse
1086+ where parse "none" = pure ZeroTermsNone
1087+ parse "all" = pure ZeroTermsAll
1088+ parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
1089+
1090+data RangeExecution = RangeExecutionIndex
1091+ | RangeExecutionFielddata deriving (Eq, Show)
1092+
1093+-- index for smaller ranges, fielddata for longer ranges
1094+instance ToJSON RangeExecution where
1095+ toJSON RangeExecutionIndex = "index"
1096+ toJSON RangeExecutionFielddata = "fielddata"
1097+
1098+
1099+instance FromJSON RangeExecution where
1100+ parseJSON = withText "RangeExecution" parse
1101+ where parse "index" = pure RangeExecutionIndex
1102+ parse "fielddata" = pure RangeExecutionFielddata
1103+ parse t = error ("Unrecognized RangeExecution " <> show t)
3481104
3491105newtype Regexp = Regexp Text deriving (Eq, Show, FromJSON)
3501106
@@ -352,6 +1108,24 @@ data RegexpFlags = AllRegexpFlags
3521108 | NoRegexpFlags
3531109 | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show)
3541110
1111+instance ToJSON RegexpFlags where
1112+ toJSON AllRegexpFlags = String "ALL"
1113+ toJSON NoRegexpFlags = String "NONE"
1114+ toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
1115+ where flagStrs = map flagStr . nub $ h:fs
1116+ flagStr AnyString = "ANYSTRING"
1117+ flagStr Automaton = "AUTOMATON"
1118+ flagStr Complement = "COMPLEMENT"
1119+ flagStr Empty = "EMPTY"
1120+ flagStr Intersection = "INTERSECTION"
1121+ flagStr Interval = "INTERVAL"
1122+
1123+instance FromJSON RegexpFlags where
1124+ parseJSON = withText "RegexpFlags" parse
1125+ where parse "ALL" = pure AllRegexpFlags
1126+ parse "NONE" = pure NoRegexpFlags
1127+ parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
1128+
3551129data RegexpFlag = AnyString
3561130 | Automaton
3571131 | Complement
@@ -359,6 +1133,16 @@ data RegexpFlag = AnyString
3591133 | Intersection
3601134 | Interval deriving (Eq, Show)
3611135
1136+instance FromJSON RegexpFlag where
1137+ parseJSON = withText "RegexpFlag" parse
1138+ where parse "ANYSTRING" = pure AnyString
1139+ parse "AUTOMATON" = pure Automaton
1140+ parse "COMPLEMENT" = pure Complement
1141+ parse "EMPTY" = pure Empty
1142+ parse "INTERSECTION" = pure Intersection
1143+ parse "INTERVAL" = pure Interval
1144+ parse f = fail ("Unknown RegexpFlag: " <> show f)
1145+
3621146newtype LessThan = LessThan Double deriving (Eq, Show)
3631147newtype LessThanEq = LessThanEq Double deriving (Eq, Show)
3641148newtype GreaterThan = GreaterThan Double deriving (Eq, Show)
@@ -387,6 +1171,78 @@ data RangeValue = RangeDateLte LessThanEqD
3871171 | RangeDoubleGtLte GreaterThan LessThanEq
3881172 deriving (Eq, Show)
3891173
1174+
1175+parseRangeValue :: ( FromJSON t4
1176+ , FromJSON t3
1177+ , FromJSON t2
1178+ , FromJSON t1
1179+ )
1180+ => (t3 -> t5)
1181+ -> (t1 -> t6)
1182+ -> (t4 -> t7)
1183+ -> (t2 -> t8)
1184+ -> (t5 -> t6 -> b)
1185+ -> (t7 -> t6 -> b)
1186+ -> (t5 -> t8 -> b)
1187+ -> (t7 -> t8 -> b)
1188+ -> (t5 -> b)
1189+ -> (t6 -> b)
1190+ -> (t7 -> b)
1191+ -> (t8 -> b)
1192+ -> Parser b
1193+ -> Object
1194+ -> Parser b
1195+parseRangeValue mkGt mkLt mkGte mkLte
1196+ fGtLt fGteLt fGtLte fGteLte
1197+ fGt fLt fGte fLte nada o = do
1198+ lt <- o .:? "lt"
1199+ lte <- o .:? "lte"
1200+ gt <- o .:? "gt"
1201+ gte <- o .:? "gte"
1202+ case (lt, lte, gt, gte) of
1203+ (Just a, _, Just b, _) ->
1204+ return (fGtLt (mkGt b) (mkLt a))
1205+ (Just a, _, _, Just b) ->
1206+ return (fGteLt (mkGte b) (mkLt a))
1207+ (_, Just a, Just b, _) ->
1208+ return (fGtLte (mkGt b) (mkLte a))
1209+ (_, Just a, _, Just b) ->
1210+ return (fGteLte (mkGte b) (mkLte a))
1211+ (_, _, Just a, _) ->
1212+ return (fGt (mkGt a))
1213+ (Just a, _, _, _) ->
1214+ return (fLt (mkLt a))
1215+ (_, _, _, Just a) ->
1216+ return (fGte (mkGte a))
1217+ (_, Just a, _, _) ->
1218+ return (fLte (mkLte a))
1219+ (Nothing, Nothing, Nothing, Nothing) ->
1220+ nada
1221+
1222+
1223+instance FromJSON RangeValue where
1224+ parseJSON = withObject "RangeValue" parse
1225+ where parse o = parseDate o
1226+ <|> parseDouble o
1227+ parseDate o =
1228+ parseRangeValue
1229+ GreaterThanD LessThanD
1230+ GreaterThanEqD LessThanEqD
1231+ RangeDateGtLt RangeDateGteLt
1232+ RangeDateGtLte RangeDateGteLte
1233+ RangeDateGt RangeDateLt
1234+ RangeDateGte RangeDateLte
1235+ mzero o
1236+ parseDouble o =
1237+ parseRangeValue
1238+ GreaterThan LessThan
1239+ GreaterThanEq LessThanEq
1240+ RangeDoubleGtLt RangeDoubleGteLt
1241+ RangeDoubleGtLte RangeDoubleGteLte
1242+ RangeDoubleGt RangeDoubleLt
1243+ RangeDoubleGte RangeDoubleLte
1244+ mzero o
1245+
3901246rangeValueToPair :: RangeValue -> [Pair]
3911247rangeValueToPair rv = case rv of
3921248 RangeDateLte (LessThanEqD t) -> ["lte" .= t]
@@ -409,21 +1265,82 @@ rangeValueToPair rv = case rv of
4091265data Term = Term { termField :: Text
4101266 , termValue :: Text } deriving (Eq, Show)
4111267
1268+instance ToJSON Term where
1269+ toJSON (Term field value) = object ["term" .= object
1270+ [field .= value]]
1271+
1272+instance FromJSON Term where
1273+ parseJSON = withObject "Term" parse
1274+ where parse o = do termObj <- o .: "term"
1275+ case HM.toList termObj of
1276+ [(fn, v)] -> Term fn <$> parseJSON v
1277+ _ -> fail "Expected object with 1 field-named key"
1278+
4121279data BoolMatch = MustMatch Term Cache
4131280 | MustNotMatch Term Cache
4141281 | ShouldMatch [Term] Cache deriving (Eq, Show)
4151282
1283+
1284+instance ToJSON BoolMatch where
1285+ toJSON (MustMatch term cache) = object ["must" .= term,
1286+ "_cache" .= cache]
1287+ toJSON (MustNotMatch term cache) = object ["must_not" .= term,
1288+ "_cache" .= cache]
1289+ toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
1290+ "_cache" .= cache]
1291+
1292+instance FromJSON BoolMatch where
1293+ parseJSON = withObject "BoolMatch" parse
1294+ where parse o = mustMatch `taggedWith` "must"
1295+ <|> mustNotMatch `taggedWith` "must_not"
1296+ <|> shouldMatch `taggedWith` "should"
1297+ where taggedWith parser k = parser =<< o .: k
1298+ mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
1299+ mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
1300+ shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
1301+
4161302-- "memory" or "indexed"
4171303data GeoFilterType = GeoFilterMemory
4181304 | GeoFilterIndexed deriving (Eq, Show)
4191305
1306+instance ToJSON GeoFilterType where
1307+ toJSON GeoFilterMemory = String "memory"
1308+ toJSON GeoFilterIndexed = String "indexed"
1309+
1310+instance FromJSON GeoFilterType where
1311+ parseJSON = withText "GeoFilterType" parse
1312+ where parse "memory" = pure GeoFilterMemory
1313+ parse "indexed" = pure GeoFilterIndexed
1314+ parse t = fail ("Unrecognized GeoFilterType: " <> show t)
1315+
4201316data LatLon = LatLon { lat :: Double
4211317 , lon :: Double } deriving (Eq, Show)
4221318
1319+instance ToJSON LatLon where
1320+ toJSON (LatLon lLat lLon) =
1321+ object ["lat" .= lLat
1322+ , "lon" .= lLon]
1323+
1324+instance FromJSON LatLon where
1325+ parseJSON = withObject "LatLon" parse
1326+ where parse o = LatLon <$> o .: "lat"
1327+ <*> o .: "lon"
1328+
4231329data GeoBoundingBox =
4241330 GeoBoundingBox { topLeft :: LatLon
4251331 , bottomRight :: LatLon } deriving (Eq, Show)
4261332
1333+instance ToJSON GeoBoundingBox where
1334+ toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
1335+ object ["top_left" .= gbbTopLeft
1336+ , "bottom_right" .= gbbBottomRight]
1337+
1338+instance FromJSON GeoBoundingBox where
1339+ parseJSON = withObject "GeoBoundingBox" parse
1340+ where parse o = GeoBoundingBox
1341+ <$> o .: "top_left"
1342+ <*> o .: "bottom_right"
1343+
4271344data GeoBoundingBoxConstraint =
4281345 GeoBoundingBoxConstraint { geoBBField :: FieldName
4291346 , constraintBox :: GeoBoundingBox
@@ -431,6 +1348,22 @@ data GeoBoundingBoxConstraint =
4311348 , geoType :: GeoFilterType
4321349 } deriving (Eq, Show)
4331350
1351+instance ToJSON GeoBoundingBoxConstraint where
1352+ toJSON (GeoBoundingBoxConstraint
1353+ (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
1354+ object [gbbcGeoBBField .= gbbcConstraintBox
1355+ , "_cache" .= cache
1356+ , "type" .= type']
1357+
1358+instance FromJSON GeoBoundingBoxConstraint where
1359+ parseJSON = withObject "GeoBoundingBoxConstraint" parse
1360+ where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
1361+ [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
1362+ <$> parseJSON v
1363+ <*> o .:? "_cache" .!= defaultCache
1364+ <*> o .: "type"
1365+ _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
1366+
4341367data GeoPoint =
4351368 GeoPoint { geoField :: FieldName
4361369 , latLon :: LatLon} deriving (Eq, Show)
@@ -449,27 +1382,96 @@ data DistanceUnit = Miles
4491382 | Millimeters
4501383 | NauticalMiles deriving (Eq, Show)
4511384
1385+instance ToJSON DistanceUnit where
1386+ toJSON Miles = String "mi"
1387+ toJSON Yards = String "yd"
1388+ toJSON Feet = String "ft"
1389+ toJSON Inches = String "in"
1390+ toJSON Kilometers = String "km"
1391+ toJSON Meters = String "m"
1392+ toJSON Centimeters = String "cm"
1393+ toJSON Millimeters = String "mm"
1394+ toJSON NauticalMiles = String "nmi"
1395+
1396+instance FromJSON DistanceUnit where
1397+ parseJSON = withText "DistanceUnit" parse
1398+ where parse "mi" = pure Miles
1399+ parse "yd" = pure Yards
1400+ parse "ft" = pure Feet
1401+ parse "in" = pure Inches
1402+ parse "km" = pure Kilometers
1403+ parse "m" = pure Meters
1404+ parse "cm" = pure Centimeters
1405+ parse "mm" = pure Millimeters
1406+ parse "nmi" = pure NauticalMiles
1407+ parse u = fail ("Unrecognized DistanceUnit: " <> show u)
1408+
4521409data DistanceType = Arc
4531410 | SloppyArc -- doesn't exist <1.0
4541411 | Plane deriving (Eq, Show)
4551412
1413+instance ToJSON DistanceType where
1414+ toJSON Arc = String "arc"
1415+ toJSON SloppyArc = String "sloppy_arc"
1416+ toJSON Plane = String "plane"
1417+
1418+instance FromJSON DistanceType where
1419+ parseJSON = withText "DistanceType" parse
1420+ where parse "arc" = pure Arc
1421+ parse "sloppy_arc" = pure SloppyArc
1422+ parse "plane" = pure Plane
1423+ parse t = fail ("Unrecognized DistanceType: " <> show t)
1424+
4561425data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
4571426 | NoOptimizeBbox deriving (Eq, Show)
4581427
1428+
1429+instance ToJSON OptimizeBbox where
1430+ toJSON NoOptimizeBbox = String "none"
1431+ toJSON (OptimizeGeoFilterType gft) = toJSON gft
1432+
1433+instance FromJSON OptimizeBbox where
1434+ parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
1435+ <|> parseOptimize v
1436+ where parseNoOptimize "none" = pure NoOptimizeBbox
1437+ parseNoOptimize _ = mzero
1438+ parseOptimize = fmap OptimizeGeoFilterType . parseJSON
1439+
4591440data Distance =
4601441 Distance { coefficient :: Double
4611442 , unit :: DistanceUnit } deriving (Eq, Show)
4621443
463−data DistanceRange =
464− DistanceRange { distanceFrom :: Distance
465− , distanceTo :: Distance } deriving (Eq, Show)
466−
467−type TemplateQueryKey = Text
468−type TemplateQueryValue = Text
469−
470−newtype TemplateQueryKeyValuePairs =
471− TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)
472− deriving (Eq, Show)
1444+
1445+instance ToJSON Distance where
1446+ toJSON (Distance dCoefficient dUnit) =
1447+ String boltedTogether where
1448+ coefText = showText dCoefficient
1449+ (String unitText) = toJSON dUnit
1450+ boltedTogether = mappend coefText unitText
1451+
1452+instance FromJSON Distance where
1453+ parseJSON = withText "Distance" parse
1454+ where parse t = Distance <$> parseCoeff nT
1455+ <*> parseJSON (String unitT)
1456+ where (nT, unitT) = T.span validForNumber t
1457+ -- may be a better way to do this
1458+ validForNumber '-' = True
1459+ validForNumber '.' = True
1460+ validForNumber 'e' = True
1461+ validForNumber c = isNumber c
1462+ parseCoeff "" = fail "Empty string cannot be parsed as number"
1463+ parseCoeff s = return (read (T.unpack s))
1464+
1465+data DistanceRange =
1466+ DistanceRange { distanceFrom :: Distance
1467+ , distanceTo :: Distance } deriving (Eq, Show)
1468+
1469+type TemplateQueryKey = Text
1470+type TemplateQueryValue = Text
1471+
1472+newtype TemplateQueryKeyValuePairs =
1473+ TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)
1474+ deriving (Eq, Show)
4731475
4741476instance ToJSON TemplateQueryKeyValuePairs where
4751477 toJSON (TemplateQueryKeyValuePairs x) =
@@ -505,6 +1507,16 @@ instance FromJSON TemplateQueryInline where
5051507-}
5061508data BooleanOperator = And | Or deriving (Eq, Show)
5071509
1510+instance ToJSON BooleanOperator where
1511+ toJSON And = String "and"
1512+ toJSON Or = String "or"
1513+
1514+instance FromJSON BooleanOperator where
1515+ parseJSON = withText "BooleanOperator" parse
1516+ where parse "and" = pure And
1517+ parse "or" = pure Or
1518+ parse o = fail ("Unexpected BooleanOperator: " <> show o)
1519+
5081520{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
5091521 'Query's cannot be cached.
5101522-}
@@ -579,1007 +1591,10 @@ functionScoreFunctionsPair (FunctionScoreSingle fn)
5791591functionScoreFunctionsPair (FunctionScoreMultiple componentFns) =
5801592 ("functions", toJSON componentFns)
5811593
582−
583−instance ToJSON Query where
584− toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
585− object [ "term" .=
586− object [termQueryField .= object merged]]
587− where
588− base = [ "value" .= termQueryValue ]
589− boosted = maybe [] (return . ("boost" .=)) boost
590− merged = mappend base boosted
591−
592− toJSON (TermsQuery fieldName terms) =
593− object [ "terms" .= object conjoined ]
594− where conjoined = [fieldName .= terms]
595−
596− toJSON (IdsQuery idsQueryMappingName docIds) =
597− object [ "ids" .= object conjoined ]
598− where conjoined = [ "type" .= idsQueryMappingName
599− , "values" .= fmap toJSON docIds ]
600−
601− toJSON (QueryQueryStringQuery qQueryStringQuery) =
602− object [ "query_string" .= qQueryStringQuery ]
603−
604− toJSON (QueryMatchQuery matchQuery) =
605− object [ "match" .= matchQuery ]
606−
607− toJSON (QueryMultiMatchQuery multiMatchQuery) =
608− toJSON multiMatchQuery
609−
610− toJSON (QueryBoolQuery boolQuery) =
611− object [ "bool" .= boolQuery ]
612−
613− toJSON (QueryBoostingQuery boostingQuery) =
614− object [ "boosting" .= boostingQuery ]
615−
616− toJSON (QueryCommonTermsQuery commonTermsQuery) =
617− object [ "common" .= commonTermsQuery ]
618−
619− toJSON (ConstantScoreQuery query boost) =
620− object ["constant_score" .= object ["query" .= query
621− , "boost" .= boost]]
622−
623− toJSON (QueryFunctionScoreQuery functionScoreQuery) =
624− object [ "function_score" .= functionScoreQuery ]
625−
626− toJSON (QueryDisMaxQuery disMaxQuery) =
627− object [ "dis_max" .= disMaxQuery ]
628−
629− toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
630− object [ "fuzzy_like_this" .= fuzzyQuery ]
631−
632− toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
633− object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
634−
635− toJSON (QueryFuzzyQuery fuzzyQuery) =
636− object [ "fuzzy" .= fuzzyQuery ]
637−
638− toJSON (QueryHasChildQuery childQuery) =
639− object [ "has_child" .= childQuery ]
640−
641− toJSON (QueryHasParentQuery parentQuery) =
642− object [ "has_parent" .= parentQuery ]
643−
644− toJSON (QueryIndicesQuery qIndicesQuery) =
645− object [ "indices" .= qIndicesQuery ]
646−
647− toJSON (MatchAllQuery boost) =
648− object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
649−
650− toJSON (QueryMoreLikeThisQuery query) =
651− object [ "more_like_this" .= query ]
652−
653− toJSON (QueryMoreLikeThisFieldQuery query) =
654− object [ "more_like_this_field" .= query ]
655−
656− toJSON (QueryNestedQuery query) =
657− object [ "nested" .= query ]
658−
659− toJSON (QueryPrefixQuery query) =
660− object [ "prefix" .= query ]
661−
662− toJSON (QueryRangeQuery query) =
663− object [ "range" .= query ]
664−
665− toJSON (QueryRegexpQuery query) =
666− object [ "regexp" .= query ]
667−
668− toJSON (QuerySimpleQueryStringQuery query) =
669− object [ "simple_query_string" .= query ]
670−
671− toJSON (QueryExistsQuery (FieldName fieldName)) =
672− object ["exists" .= object
673− ["field" .= fieldName]
674− ]
675− toJSON QueryMatchNoneQuery =
676− object ["match_none" .= object []]
677−
678− toJSON (QueryTemplateQueryInline templateQuery) =
679− object [ "template" .= templateQuery ]
680−
681−instance FromJSON Query where
682− parseJSON v = withObject "Query" parse v
683− where parse o = termQuery `taggedWith` "term"
684− <|> termsQuery `taggedWith` "terms"
685− <|> idsQuery `taggedWith` "ids"
686− <|> queryQueryStringQuery `taggedWith` "query_string"
687− <|> queryMatchQuery `taggedWith` "match"
688− <|> queryMultiMatchQuery
689− <|> queryBoolQuery `taggedWith` "bool"
690− <|> queryBoostingQuery `taggedWith` "boosting"
691− <|> queryCommonTermsQuery `taggedWith` "common"
692− <|> constantScoreQuery `taggedWith` "constant_score"
693− <|> queryFunctionScoreQuery `taggedWith` "function_score"
694− <|> queryDisMaxQuery `taggedWith` "dis_max"
695− <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
696− <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
697− <|> queryFuzzyQuery `taggedWith` "fuzzy"
698− <|> queryHasChildQuery `taggedWith` "has_child"
699− <|> queryHasParentQuery `taggedWith` "has_parent"
700− <|> queryIndicesQuery `taggedWith` "indices"
701− <|> matchAllQuery `taggedWith` "match_all"
702− <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
703− <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
704− <|> queryNestedQuery `taggedWith` "nested"
705− <|> queryPrefixQuery `taggedWith` "prefix"
706− <|> queryRangeQuery `taggedWith` "range"
707− <|> queryRegexpQuery `taggedWith` "regexp"
708− <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
709− <|> queryTemplateQueryInline `taggedWith` "template"
710− where taggedWith parser k = parser =<< o .: k
711− termQuery = fieldTagged $ \(FieldName fn) o ->
712− TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
713− termsQuery o = case HM.toList o of
714− [(fn, vs)] -> do vals <- parseJSON vs
715− case vals of
716− x:xs -> return (TermsQuery fn (x :| xs))
717− _ -> fail "Expected non empty list of values"
718− _ -> fail "Expected object with 1 field-named key"
719− idsQuery o = IdsQuery <$> o .: "type"
720− <*> o .: "values"
721− queryQueryStringQuery = pure . QueryQueryStringQuery
722− queryMatchQuery = pure . QueryMatchQuery
723− queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
724− queryBoolQuery = pure . QueryBoolQuery
725− queryBoostingQuery = pure . QueryBoostingQuery
726− queryCommonTermsQuery = pure . QueryCommonTermsQuery
727− constantScoreQuery o = case HM.lookup "query" o of
728− Just x -> ConstantScoreQuery <$> parseJSON x
729− <*> o .: "boost"
730− _ -> fail "Does not appear to be a ConstantScoreQuery"
731− queryFunctionScoreQuery = pure . QueryFunctionScoreQuery
732− queryDisMaxQuery = pure . QueryDisMaxQuery
733− queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
734− queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
735− queryFuzzyQuery = pure . QueryFuzzyQuery
736− queryHasChildQuery = pure . QueryHasChildQuery
737− queryHasParentQuery = pure . QueryHasParentQuery
738− queryIndicesQuery = pure . QueryIndicesQuery
739− matchAllQuery o = MatchAllQuery <$> o .:? "boost"
740− queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
741− queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
742− queryNestedQuery = pure . QueryNestedQuery
743− queryPrefixQuery = pure . QueryPrefixQuery
744− queryRangeQuery = pure . QueryRangeQuery
745− queryRegexpQuery = pure . QueryRegexpQuery
746− querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
747− -- queryExistsQuery o = QueryExistsQuery <$> o .: "field"
748− queryTemplateQueryInline = pure . QueryTemplateQueryInline
749−
7501594fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
7511595fieldTagged f o = case HM.toList o of
7521596 [(k, Object o')] -> f (FieldName k) o'
7531597 _ -> fail "Expected object with 1 field-named key"
7541598
755−instance ToJSON SimpleQueryStringQuery where
756− toJSON SimpleQueryStringQuery {..} =
757− omitNulls (base ++ maybeAdd)
758− where base = [ "query" .= simpleQueryStringQuery ]
759− maybeAdd = [ "fields" .= simpleQueryStringField
760− , "default_operator" .= simpleQueryStringOperator
761− , "analyzer" .= simpleQueryStringAnalyzer
762− , "flags" .= simpleQueryStringFlags
763− , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
764− , "locale" .= simpleQueryStringLocale ]
765−
766−instance FromJSON SimpleQueryStringQuery where
767− parseJSON = withObject "SimpleQueryStringQuery" parse
768− where parse o = SimpleQueryStringQuery <$> o .: "query"
769− <*> o .:? "fields"
770− <*> o .:? "default_operator"
771− <*> o .:? "analyzer"
772− <*> (parseFlags <$> o .:? "flags")
773− <*> o .:? "lowercase_expanded_terms"
774− <*> o .:? "locale"
775− parseFlags (Just (x:xs)) = Just (x :| xs)
776− parseFlags _ = Nothing
777−
778−instance ToJSON FieldOrFields where
779− toJSON (FofField fieldName) =
780− toJSON fieldName
781− toJSON (FofFields fieldNames) =
782− toJSON fieldNames
783−
784−instance FromJSON FieldOrFields where
785− parseJSON v = FofField <$> parseJSON v
786− <|> FofFields <$> (parseNEJSON =<< parseJSON v)
787−
788−instance ToJSON SimpleQueryFlag where
789− toJSON SimpleQueryAll = "ALL"
790− toJSON SimpleQueryNone = "NONE"
791− toJSON SimpleQueryAnd = "AND"
792− toJSON SimpleQueryOr = "OR"
793− toJSON SimpleQueryPrefix = "PREFIX"
794− toJSON SimpleQueryPhrase = "PHRASE"
795− toJSON SimpleQueryPrecedence = "PRECEDENCE"
796− toJSON SimpleQueryEscape = "ESCAPE"
797− toJSON SimpleQueryWhitespace = "WHITESPACE"
798− toJSON SimpleQueryFuzzy = "FUZZY"
799− toJSON SimpleQueryNear = "NEAR"
800− toJSON SimpleQuerySlop = "SLOP"
801−
802−instance FromJSON SimpleQueryFlag where
803− parseJSON = withText "SimpleQueryFlag" parse
804− where parse "ALL" = pure SimpleQueryAll
805− parse "NONE" = pure SimpleQueryNone
806− parse "AND" = pure SimpleQueryAnd
807− parse "OR" = pure SimpleQueryOr
808− parse "PREFIX" = pure SimpleQueryPrefix
809− parse "PHRASE" = pure SimpleQueryPhrase
810− parse "PRECEDENCE" = pure SimpleQueryPrecedence
811− parse "ESCAPE" = pure SimpleQueryEscape
812− parse "WHITESPACE" = pure SimpleQueryWhitespace
813− parse "FUZZY" = pure SimpleQueryFuzzy
814− parse "NEAR" = pure SimpleQueryNear
815− parse "SLOP" = pure SimpleQuerySlop
816− parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
817−
818−instance ToJSON RegexpQuery where
819− toJSON (RegexpQuery (FieldName rqQueryField)
820− (Regexp regexpQueryQuery) rqQueryFlags
821− rqQueryBoost) =
822− object [ rqQueryField .= omitNulls base ]
823− where base = [ "value" .= regexpQueryQuery
824− , "flags" .= rqQueryFlags
825− , "boost" .= rqQueryBoost ]
826−
827−instance FromJSON RegexpQuery where
828− parseJSON = withObject "RegexpQuery" parse
829− where parse = fieldTagged $ \fn o ->
830− RegexpQuery fn
831− <$> o .: "value"
832− <*> o .: "flags"
833− <*> o .:? "boost"
834−
835−instance ToJSON QueryStringQuery where
836− toJSON (QueryStringQuery qsQueryString
837− qsDefaultField qsOperator
838− qsAnalyzer qsAllowWildcard
839− qsLowercaseExpanded qsEnablePositionIncrements
840− qsFuzzyMaxExpansions qsFuzziness
841− qsFuzzyPrefixLength qsPhraseSlop
842− qsBoost qsAnalyzeWildcard
843− qsGeneratePhraseQueries qsMinimumShouldMatch
844− qsLenient qsLocale) =
845− omitNulls base
846− where
847− base = [ "query" .= qsQueryString
848− , "default_field" .= qsDefaultField
849− , "default_operator" .= qsOperator
850− , "analyzer" .= qsAnalyzer
851− , "allow_leading_wildcard" .= qsAllowWildcard
852− , "lowercase_expanded_terms" .= qsLowercaseExpanded
853− , "enable_position_increments" .= qsEnablePositionIncrements
854− , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
855− , "fuzziness" .= qsFuzziness
856− , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
857− , "phrase_slop" .= qsPhraseSlop
858− , "boost" .= qsBoost
859− , "analyze_wildcard" .= qsAnalyzeWildcard
860− , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
861− , "minimum_should_match" .= qsMinimumShouldMatch
862− , "lenient" .= qsLenient
863− , "locale" .= qsLocale ]
864−
865−instance FromJSON QueryStringQuery where
866− parseJSON = withObject "QueryStringQuery" parse
867− where parse o = QueryStringQuery
868− <$> o .: "query"
869− <*> o .:? "default_field"
870− <*> o .:? "default_operator"
871− <*> o .:? "analyzer"
872− <*> o .:? "allow_leading_wildcard"
873− <*> o .:? "lowercase_expanded_terms"
874− <*> o .:? "enable_position_increments"
875− <*> o .:? "fuzzy_max_expansions"
876− <*> o .:? "fuzziness"
877− <*> o .:? "fuzzy_prefix_length"
878− <*> o .:? "phrase_slop"
879− <*> o .:? "boost"
880− <*> o .:? "analyze_wildcard"
881− <*> o .:? "auto_generate_phrase_queries"
882− <*> o .:? "minimum_should_match"
883− <*> o .:? "lenient"
884− <*> o .:? "locale"
885−
886−instance ToJSON RangeQuery where
887− toJSON (RangeQuery (FieldName fieldName) range boost) =
888− object [ fieldName .= object conjoined ]
889− where
890− conjoined = ("boost" .= boost) : rangeValueToPair range
891−
892−instance FromJSON RangeQuery where
893− parseJSON = withObject "RangeQuery" parse
894− where parse = fieldTagged $ \fn o ->
895− RangeQuery fn
896− <$> parseJSON (Object o)
897− <*> o .: "boost"
898−
899−parseRangeValue :: ( FromJSON t4
900− , FromJSON t3
901− , FromJSON t2
902− , FromJSON t1
903− )
904− => (t3 -> t5)
905− -> (t1 -> t6)
906− -> (t4 -> t7)
907− -> (t2 -> t8)
908− -> (t5 -> t6 -> b)
909− -> (t7 -> t6 -> b)
910− -> (t5 -> t8 -> b)
911− -> (t7 -> t8 -> b)
912− -> (t5 -> b)
913− -> (t6 -> b)
914− -> (t7 -> b)
915− -> (t8 -> b)
916− -> Parser b
917− -> Object
918− -> Parser b
919−parseRangeValue mkGt mkLt mkGte mkLte
920− fGtLt fGteLt fGtLte fGteLte
921− fGt fLt fGte fLte nada o = do
922− lt <- o .:? "lt"
923− lte <- o .:? "lte"
924− gt <- o .:? "gt"
925− gte <- o .:? "gte"
926− case (lt, lte, gt, gte) of
927− (Just a, _, Just b, _) ->
928− return (fGtLt (mkGt b) (mkLt a))
929− (Just a, _, _, Just b) ->
930− return (fGteLt (mkGte b) (mkLt a))
931− (_, Just a, Just b, _) ->
932− return (fGtLte (mkGt b) (mkLte a))
933− (_, Just a, _, Just b) ->
934− return (fGteLte (mkGte b) (mkLte a))
935− (_, _, Just a, _) ->
936− return (fGt (mkGt a))
937− (Just a, _, _, _) ->
938− return (fLt (mkLt a))
939− (_, _, _, Just a) ->
940− return (fGte (mkGte a))
941− (_, Just a, _, _) ->
942− return (fLte (mkLte a))
943− (Nothing, Nothing, Nothing, Nothing) ->
944− nada
945−
946−
947−instance FromJSON RangeValue where
948− parseJSON = withObject "RangeValue" parse
949− where parse o = parseDate o
950− <|> parseDouble o
951− parseDate o =
952− parseRangeValue
953− GreaterThanD LessThanD
954− GreaterThanEqD LessThanEqD
955− RangeDateGtLt RangeDateGteLt
956− RangeDateGtLte RangeDateGteLte
957− RangeDateGt RangeDateLt
958− RangeDateGte RangeDateLte
959− mzero o
960− parseDouble o =
961− parseRangeValue
962− GreaterThan LessThan
963− GreaterThanEq LessThanEq
964− RangeDoubleGtLt RangeDoubleGteLt
965− RangeDoubleGtLte RangeDoubleGteLte
966− RangeDoubleGt RangeDoubleLt
967− RangeDoubleGte RangeDoubleLte
968− mzero o
969−
970−instance ToJSON PrefixQuery where
971− toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
972− object [ fieldName .= omitNulls base ]
973− where base = [ "value" .= queryValue
974− , "boost" .= boost ]
975−
976−instance FromJSON PrefixQuery where
977− parseJSON = withObject "PrefixQuery" parse
978− where parse = fieldTagged $ \fn o ->
979− PrefixQuery fn
980− <$> o .: "value"
981− <*> o .:? "boost"
982−
983−instance ToJSON NestedQuery where
984− toJSON (NestedQuery nqPath nqScoreType nqQuery) =
985− object [ "path" .= nqPath
986− , "score_mode" .= nqScoreType
987− , "query" .= nqQuery ]
988−
989−instance FromJSON NestedQuery where
990− parseJSON = withObject "NestedQuery" parse
991− where parse o = NestedQuery
992− <$> o .: "path"
993− <*> o .: "score_mode"
994− <*> o .: "query"
995−
996−instance ToJSON MoreLikeThisFieldQuery where
997− toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
998− percent mtf mqt stopwords mindf maxdf
999− minwl maxwl boostTerms boost analyzer) =
1000− object [ fieldName .= omitNulls base ]
1001− where base = [ "like_text" .= text
1002− , "percent_terms_to_match" .= percent
1003− , "min_term_freq" .= mtf
1004− , "max_query_terms" .= mqt
1005− , "stop_words" .= stopwords
1006− , "min_doc_freq" .= mindf
1007− , "max_doc_freq" .= maxdf
1008− , "min_word_length" .= minwl
1009− , "max_word_length" .= maxwl
1010− , "boost_terms" .= boostTerms
1011− , "boost" .= boost
1012− , "analyzer" .= analyzer ]
1013−
1014−instance FromJSON MoreLikeThisFieldQuery where
1015− parseJSON = withObject "MoreLikeThisFieldQuery" parse
1016− where parse = fieldTagged $ \fn o ->
1017− MoreLikeThisFieldQuery
1018− <$> o .: "like_text"
1019− <*> pure fn
1020− <*> o .:? "percent_terms_to_match"
1021− <*> o .:? "min_term_freq"
1022− <*> o .:? "max_query_terms"
1023− -- <*> (optionalNE =<< o .:? "stop_words")
1024− <*> o .:? "stop_words"
1025− <*> o .:? "min_doc_freq"
1026− <*> o .:? "max_doc_freq"
1027− <*> o .:? "min_word_length"
1028− <*> o .:? "max_word_length"
1029− <*> o .:? "boost_terms"
1030− <*> o .:? "boost"
1031− <*> o .:? "analyzer"
1032− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
1033−
1034−instance ToJSON MoreLikeThisQuery where
1035− toJSON (MoreLikeThisQuery text fields percent
1036− mtf mqt stopwords mindf maxdf
1037− minwl maxwl boostTerms boost analyzer) =
1038− omitNulls base
1039− where base = [ "like_text" .= text
1040− , "fields" .= fields
1041− , "percent_terms_to_match" .= percent
1042− , "min_term_freq" .= mtf
1043− , "max_query_terms" .= mqt
1044− , "stop_words" .= stopwords
1045− , "min_doc_freq" .= mindf
1046− , "max_doc_freq" .= maxdf
1047− , "min_word_length" .= minwl
1048− , "max_word_length" .= maxwl
1049− , "boost_terms" .= boostTerms
1050− , "boost" .= boost
1051− , "analyzer" .= analyzer ]
1052−
1053−instance FromJSON MoreLikeThisQuery where
1054− parseJSON = withObject "MoreLikeThisQuery" parse
1055− where parse o = MoreLikeThisQuery
1056− <$> o .: "like_text"
1057− -- <*> (optionalNE =<< o .:? "fields")
1058− <*> o .:? "fields"
1059− <*> o .:? "percent_terms_to_match"
1060− <*> o .:? "min_term_freq"
1061− <*> o .:? "max_query_terms"
1062− -- <*> (optionalNE =<< o .:? "stop_words")
1063− <*> o .:? "stop_words"
1064− <*> o .:? "min_doc_freq"
1065− <*> o .:? "max_doc_freq"
1066− <*> o .:? "min_word_length"
1067− <*> o .:? "max_word_length"
1068− <*> o .:? "boost_terms"
1069− <*> o .:? "boost"
1070− <*> o .:? "analyzer"
1071− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
1072−
1073−instance ToJSON IndicesQuery where
1074− toJSON (IndicesQuery indices query noMatch) =
1075− omitNulls [ "indices" .= indices
1076− , "no_match_query" .= noMatch
1077− , "query" .= query ]
1078−
1079−instance FromJSON IndicesQuery where
1080− parseJSON = withObject "IndicesQuery" parse
1081− where parse o = IndicesQuery
1082− <$> o .:? "indices" .!= []
1083− <*> o .: "query"
1084− <*> o .:? "no_match_query"
1085−
1086−instance ToJSON HasParentQuery where
1087− toJSON (HasParentQuery queryType query scoreType) =
1088− omitNulls [ "parent_type" .= queryType
1089− , "score_type" .= scoreType
1090− , "query" .= query ]
1091−
1092−instance FromJSON HasParentQuery where
1093− parseJSON = withObject "HasParentQuery" parse
1094− where parse o = HasParentQuery
1095− <$> o .: "parent_type"
1096− <*> o .: "query"
1097− <*> o .:? "score_type"
1098−
1099−instance ToJSON HasChildQuery where
1100− toJSON (HasChildQuery queryType query scoreType) =
1101− omitNulls [ "query" .= query
1102− , "score_type" .= scoreType
1103− , "type" .= queryType ]
1104−
1105−instance FromJSON HasChildQuery where
1106− parseJSON = withObject "HasChildQuery" parse
1107− where parse o = HasChildQuery
1108− <$> o .: "type"
1109− <*> o .: "query"
1110− <*> o .:? "score_type"
1111−
1112−instance ToJSON FuzzyQuery where
1113− toJSON (FuzzyQuery (FieldName fieldName) queryText
1114− prefixLength maxEx fuzziness boost) =
1115− object [ fieldName .= omitNulls base ]
1116− where base = [ "value" .= queryText
1117− , "fuzziness" .= fuzziness
1118− , "prefix_length" .= prefixLength
1119− , "boost" .= boost
1120− , "max_expansions" .= maxEx ]
1121−
1122−instance FromJSON FuzzyQuery where
1123− parseJSON = withObject "FuzzyQuery" parse
1124− where parse = fieldTagged $ \fn o ->
1125− FuzzyQuery fn
1126− <$> o .: "value"
1127− <*> o .: "prefix_length"
1128− <*> o .: "max_expansions"
1129− <*> o .: "fuzziness"
1130− <*> o .:? "boost"
1131−
1132−instance ToJSON FuzzyLikeFieldQuery where
1133− toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
1134− fieldText maxTerms ignoreFreq fuzziness prefixLength
1135− boost analyzer) =
1136− object [ fieldName .=
1137− omitNulls [ "like_text" .= fieldText
1138− , "max_query_terms" .= maxTerms
1139− , "ignore_tf" .= ignoreFreq
1140− , "fuzziness" .= fuzziness
1141− , "prefix_length" .= prefixLength
1142− , "analyzer" .= analyzer
1143− , "boost" .= boost ]]
1144−
1145−instance FromJSON FuzzyLikeFieldQuery where
1146− parseJSON = withObject "FuzzyLikeFieldQuery" parse
1147− where parse = fieldTagged $ \fn o ->
1148− FuzzyLikeFieldQuery fn
1149− <$> o .: "like_text"
1150− <*> o .: "max_query_terms"
1151− <*> o .: "ignore_tf"
1152− <*> o .: "fuzziness"
1153− <*> o .: "prefix_length"
1154− <*> o .: "boost"
1155− <*> o .:? "analyzer"
1156−
1157−instance ToJSON FuzzyLikeThisQuery where
1158− toJSON (FuzzyLikeThisQuery fields text maxTerms
1159− ignoreFreq fuzziness prefixLength boost analyzer) =
1160− omitNulls base
1161− where base = [ "fields" .= fields
1162− , "like_text" .= text
1163− , "max_query_terms" .= maxTerms
1164− , "ignore_tf" .= ignoreFreq
1165− , "fuzziness" .= fuzziness
1166− , "prefix_length" .= prefixLength
1167− , "analyzer" .= analyzer
1168− , "boost" .= boost ]
1169−
1170−instance FromJSON FuzzyLikeThisQuery where
1171− parseJSON = withObject "FuzzyLikeThisQuery" parse
1172− where parse o = FuzzyLikeThisQuery
1173− <$> o .:? "fields" .!= []
1174− <*> o .: "like_text"
1175− <*> o .: "max_query_terms"
1176− <*> o .: "ignore_tf"
1177− <*> o .: "fuzziness"
1178− <*> o .: "prefix_length"
1179− <*> o .: "boost"
1180− <*> o .:? "analyzer"
1181−
1182−instance ToJSON DisMaxQuery where
1183− toJSON (DisMaxQuery queries tiebreaker boost) =
1184− omitNulls base
1185− where base = [ "queries" .= queries
1186− , "boost" .= boost
1187− , "tie_breaker" .= tiebreaker ]
1188−
1189−instance FromJSON DisMaxQuery where
1190− parseJSON = withObject "DisMaxQuery" parse
1191− where parse o = DisMaxQuery
1192− <$> o .:? "queries" .!= []
1193− <*> o .: "tie_breaker"
1194− <*> o .:? "boost"
1195−
1196−instance ToJSON CommonTermsQuery where
1197− toJSON (CommonTermsQuery (FieldName fieldName)
1198− (QueryString query) cf lfo hfo msm
1199− boost analyzer disableCoord) =
1200− object [fieldName .= omitNulls base ]
1201− where base = [ "query" .= query
1202− , "cutoff_frequency" .= cf
1203− , "low_freq_operator" .= lfo
1204− , "minimum_should_match" .= msm
1205− , "boost" .= boost
1206− , "analyzer" .= analyzer
1207− , "disable_coord" .= disableCoord
1208− , "high_freq_operator" .= hfo ]
1209−
1210−instance FromJSON CommonTermsQuery where
1211− parseJSON = withObject "CommonTermsQuery" parse
1212− where parse = fieldTagged $ \fn o ->
1213− CommonTermsQuery fn
1214− <$> o .: "query"
1215− <*> o .: "cutoff_frequency"
1216− <*> o .: "low_freq_operator"
1217− <*> o .: "high_freq_operator"
1218− <*> o .:? "minimum_should_match"
1219− <*> o .:? "boost"
1220− <*> o .:? "analyzer"
1221− <*> o .:? "disable_coord"
1222−
1223−instance ToJSON CommonMinimumMatch where
1224− toJSON (CommonMinimumMatch mm) = toJSON mm
1225− toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
1226− object [ "low_freq" .= lowF
1227− , "high_freq" .= highF ]
1228−
1229−instance FromJSON CommonMinimumMatch where
1230− parseJSON v = parseMinimum v
1231− <|> parseMinimumHighLow v
1232− where parseMinimum = fmap CommonMinimumMatch . parseJSON
1233− parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
1234− MinimumMatchHighLow
1235− <$> o .: "low_freq"
1236− <*> o .: "high_freq")
1237−
1238−
1239−instance ToJSON BoostingQuery where
1240− toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
1241− object [ "positive" .= bqPositiveQuery
1242− , "negative" .= bqNegativeQuery
1243− , "negative_boost" .= bqNegativeBoost ]
1244−
1245−instance FromJSON BoostingQuery where
1246− parseJSON = withObject "BoostingQuery" parse
1247− where parse o = BoostingQuery
1248− <$> o .: "positive"
1249− <*> o .: "negative"
1250− <*> o .: "negative_boost"
1251−
1252−instance ToJSON BoolQuery where
1253− toJSON (BoolQuery mustM filterM' notM shouldM bqMin boost disableCoord) =
1254− omitNulls base
1255− where base = [ "must" .= mustM
1256− , "filter" .= filterM'
1257− , "must_not" .= notM
1258− , "should" .= shouldM
1259− , "minimum_should_match" .= bqMin
1260− , "boost" .= boost
1261− , "disable_coord" .= disableCoord ]
1262−
1263−instance FromJSON BoolQuery where
1264− parseJSON = withObject "BoolQuery" parse
1265− where parse o = BoolQuery
1266− <$> o .:? "must" .!= []
1267− <*> o .:? "filter" .!= []
1268− <*> o .:? "must_not" .!= []
1269− <*> o .:? "should" .!= []
1270− <*> o .:? "minimum_should_match"
1271− <*> o .:? "boost"
1272− <*> o .:? "disable_coord"
1273−
1274−instance ToJSON MatchQuery where
1275− toJSON (MatchQuery (FieldName fieldName)
1276− (QueryString mqQueryString) booleanOperator
1277− zeroTermsQuery cutoffFrequency matchQueryType
1278− analyzer maxExpansions lenient boost
1279− minShouldMatch
1280− ) =
1281− object [ fieldName .= omitNulls base ]
1282− where base = [ "query" .= mqQueryString
1283− , "operator" .= booleanOperator
1284− , "zero_terms_query" .= zeroTermsQuery
1285− , "cutoff_frequency" .= cutoffFrequency
1286− , "type" .= matchQueryType
1287− , "analyzer" .= analyzer
1288− , "max_expansions" .= maxExpansions
1289− , "lenient" .= lenient
1290− , "boost" .= boost
1291− , "minimum_should_match" .= minShouldMatch
1292− ]
1293−
1294−instance FromJSON MatchQuery where
1295− parseJSON = withObject "MatchQuery" parse
1296− where parse = fieldTagged $ \fn o ->
1297− MatchQuery fn
1298− <$> o .: "query"
1299− <*> o .: "operator"
1300− <*> o .: "zero_terms_query"
1301− <*> o .:? "cutoff_frequency"
1302− <*> o .:? "type"
1303− <*> o .:? "analyzer"
1304− <*> o .:? "max_expansions"
1305− <*> o .:? "lenient"
1306− <*> o .:? "boost"
1307− <*> o .:? "minimum_should_match"
1308−
1309−instance ToJSON MultiMatchQuery where
1310− toJSON (MultiMatchQuery fields (QueryString query) boolOp
1311− ztQ tb mmqt cf analyzer maxEx lenient) =
1312− object ["multi_match" .= omitNulls base]
1313− where base = [ "fields" .= fmap toJSON fields
1314− , "query" .= query
1315− , "operator" .= boolOp
1316− , "zero_terms_query" .= ztQ
1317− , "tie_breaker" .= tb
1318− , "type" .= mmqt
1319− , "cutoff_frequency" .= cf
1320− , "analyzer" .= analyzer
1321− , "max_expansions" .= maxEx
1322− , "lenient" .= lenient ]
1323−
1324−instance FromJSON MultiMatchQuery where
1325− parseJSON = withObject "MultiMatchQuery" parse
1326− where parse raw = do o <- raw .: "multi_match"
1327− MultiMatchQuery
1328− <$> o .:? "fields" .!= []
1329− <*> o .: "query"
1330− <*> o .: "operator"
1331− <*> o .: "zero_terms_query"
1332− <*> o .:? "tie_breaker"
1333− <*> o .:? "type"
1334− <*> o .:? "cutoff_frequency"
1335− <*> o .:? "analyzer"
1336− <*> o .:? "max_expansions"
1337− <*> o .:? "lenient"
1338−
1339−instance ToJSON MultiMatchQueryType where
1340− toJSON MultiMatchBestFields = "best_fields"
1341− toJSON MultiMatchMostFields = "most_fields"
1342− toJSON MultiMatchCrossFields = "cross_fields"
1343− toJSON MultiMatchPhrase = "phrase"
1344− toJSON MultiMatchPhrasePrefix = "phrase_prefix"
1345−
1346−instance FromJSON MultiMatchQueryType where
1347− parseJSON = withText "MultiMatchPhrasePrefix" parse
1348− where parse "best_fields" = pure MultiMatchBestFields
1349− parse "most_fields" = pure MultiMatchMostFields
1350− parse "cross_fields" = pure MultiMatchCrossFields
1351− parse "phrase" = pure MultiMatchPhrase
1352− parse "phrase_prefix" = pure MultiMatchPhrasePrefix
1353− parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
1354−
1355−instance ToJSON BooleanOperator where
1356− toJSON And = String "and"
1357− toJSON Or = String "or"
1358−
1359−instance FromJSON BooleanOperator where
1360− parseJSON = withText "BooleanOperator" parse
1361− where parse "and" = pure And
1362− parse "or" = pure Or
1363− parse o = fail ("Unexpected BooleanOperator: " <> show o)
1364−
1365−instance ToJSON ZeroTermsQuery where
1366− toJSON ZeroTermsNone = String "none"
1367− toJSON ZeroTermsAll = String "all"
1368−
1369−instance FromJSON ZeroTermsQuery where
1370− parseJSON = withText "ZeroTermsQuery" parse
1371− where parse "none" = pure ZeroTermsNone
1372− parse "all" = pure ZeroTermsAll
1373− parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
1374−
1375−instance ToJSON MatchQueryType where
1376− toJSON MatchPhrase = "phrase"
1377− toJSON MatchPhrasePrefix = "phrase_prefix"
1378−
1379−instance FromJSON MatchQueryType where
1380− parseJSON = withText "MatchQueryType" parse
1381− where parse "phrase" = pure MatchPhrase
1382− parse "phrase_prefix" = pure MatchPhrasePrefix
1383− parse t = fail ("Unexpected MatchQueryType: " <> show t)
1384−
1385−instance ToJSON ScoreType where
1386− toJSON ScoreTypeMax = "max"
1387− toJSON ScoreTypeAvg = "avg"
1388− toJSON ScoreTypeSum = "sum"
1389− toJSON ScoreTypeNone = "none"
1390−
1391−instance FromJSON ScoreType where
1392− parseJSON = withText "ScoreType" parse
1393− where parse "max" = pure ScoreTypeMax
1394− parse "avg" = pure ScoreTypeAvg
1395− parse "sum" = pure ScoreTypeSum
1396− parse "none" = pure ScoreTypeNone
1397− parse t = fail ("Unexpected ScoreType: " <> show t)
1398−
1399−instance ToJSON Distance where
1400− toJSON (Distance dCoefficient dUnit) =
1401− String boltedTogether where
1402− coefText = showText dCoefficient
1403− (String unitText) = toJSON dUnit
1404− boltedTogether = mappend coefText unitText
1405−
1406−instance FromJSON Distance where
1407− parseJSON = withText "Distance" parse
1408− where parse t = Distance <$> parseCoeff nT
1409− <*> parseJSON (String unitT)
1410− where (nT, unitT) = T.span validForNumber t
1411− -- may be a better way to do this
1412− validForNumber '-' = True
1413− validForNumber '.' = True
1414− validForNumber 'e' = True
1415− validForNumber c = isNumber c
1416− parseCoeff "" = fail "Empty string cannot be parsed as number"
1417− parseCoeff s = return (read (T.unpack s))
1418−
1419−instance ToJSON DistanceUnit where
1420− toJSON Miles = String "mi"
1421− toJSON Yards = String "yd"
1422− toJSON Feet = String "ft"
1423− toJSON Inches = String "in"
1424− toJSON Kilometers = String "km"
1425− toJSON Meters = String "m"
1426− toJSON Centimeters = String "cm"
1427− toJSON Millimeters = String "mm"
1428− toJSON NauticalMiles = String "nmi"
1429−
1430−
1431−instance FromJSON DistanceUnit where
1432− parseJSON = withText "DistanceUnit" parse
1433− where parse "mi" = pure Miles
1434− parse "yd" = pure Yards
1435− parse "ft" = pure Feet
1436− parse "in" = pure Inches
1437− parse "km" = pure Kilometers
1438− parse "m" = pure Meters
1439− parse "cm" = pure Centimeters
1440− parse "mm" = pure Millimeters
1441− parse "nmi" = pure NauticalMiles
1442− parse u = fail ("Unrecognized DistanceUnit: " <> show u)
1443−
1444−instance ToJSON DistanceType where
1445− toJSON Arc = String "arc"
1446− toJSON SloppyArc = String "sloppy_arc"
1447− toJSON Plane = String "plane"
1448−
1449−instance FromJSON DistanceType where
1450− parseJSON = withText "DistanceType" parse
1451− where parse "arc" = pure Arc
1452− parse "sloppy_arc" = pure SloppyArc
1453− parse "plane" = pure Plane
1454− parse t = fail ("Unrecognized DistanceType: " <> show t)
1455−
1456−
1457−instance ToJSON OptimizeBbox where
1458− toJSON NoOptimizeBbox = String "none"
1459− toJSON (OptimizeGeoFilterType gft) = toJSON gft
1460−
1461−instance FromJSON OptimizeBbox where
1462− parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
1463− <|> parseOptimize v
1464− where parseNoOptimize "none" = pure NoOptimizeBbox
1465− parseNoOptimize _ = mzero
1466− parseOptimize = fmap OptimizeGeoFilterType . parseJSON
1467−
1468−instance ToJSON GeoBoundingBoxConstraint where
1469− toJSON (GeoBoundingBoxConstraint
1470− (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
1471− object [gbbcGeoBBField .= gbbcConstraintBox
1472− , "_cache" .= cache
1473− , "type" .= type']
1474−
14751599deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
14761600deleteSeveral ks hm = foldr HM.delete hm ks
1477−
1478−instance FromJSON GeoBoundingBoxConstraint where
1479− parseJSON = withObject "GeoBoundingBoxConstraint" parse
1480− where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
1481− [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
1482− <$> parseJSON v
1483− <*> o .:? "_cache" .!= defaultCache
1484− <*> o .: "type"
1485− _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
1486−
1487−instance ToJSON GeoFilterType where
1488− toJSON GeoFilterMemory = String "memory"
1489− toJSON GeoFilterIndexed = String "indexed"
1490−
1491−instance FromJSON GeoFilterType where
1492− parseJSON = withText "GeoFilterType" parse
1493− where parse "memory" = pure GeoFilterMemory
1494− parse "indexed" = pure GeoFilterIndexed
1495− parse t = fail ("Unrecognized GeoFilterType: " <> show t)
1496−
1497−instance ToJSON GeoBoundingBox where
1498− toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
1499− object ["top_left" .= gbbTopLeft
1500− , "bottom_right" .= gbbBottomRight]
1501−
1502−instance FromJSON GeoBoundingBox where
1503− parseJSON = withObject "GeoBoundingBox" parse
1504− where parse o = GeoBoundingBox
1505− <$> o .: "top_left"
1506− <*> o .: "bottom_right"
1507−
1508−instance ToJSON LatLon where
1509− toJSON (LatLon lLat lLon) =
1510− object ["lat" .= lLat
1511− , "lon" .= lLon]
1512−
1513−instance FromJSON LatLon where
1514− parseJSON = withObject "LatLon" parse
1515− where parse o = LatLon <$> o .: "lat"
1516− <*> o .: "lon"
1517−
1518−-- index for smaller ranges, fielddata for longer ranges
1519−instance ToJSON RangeExecution where
1520− toJSON RangeExecutionIndex = "index"
1521− toJSON RangeExecutionFielddata = "fielddata"
1522−
1523−
1524−instance FromJSON RangeExecution where
1525− parseJSON = withText "RangeExecution" parse
1526− where parse "index" = pure RangeExecutionIndex
1527− parse "fielddata" = pure RangeExecutionFielddata
1528− parse t = error ("Unrecognized RangeExecution " <> show t)
1529−
1530−instance ToJSON RegexpFlags where
1531− toJSON AllRegexpFlags = String "ALL"
1532− toJSON NoRegexpFlags = String "NONE"
1533− toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
1534− where flagStrs = map flagStr . nub $ h:fs
1535− flagStr AnyString = "ANYSTRING"
1536− flagStr Automaton = "AUTOMATON"
1537− flagStr Complement = "COMPLEMENT"
1538− flagStr Empty = "EMPTY"
1539− flagStr Intersection = "INTERSECTION"
1540− flagStr Interval = "INTERVAL"
1541−
1542−instance FromJSON RegexpFlags where
1543− parseJSON = withText "RegexpFlags" parse
1544− where parse "ALL" = pure AllRegexpFlags
1545− parse "NONE" = pure NoRegexpFlags
1546− parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
1547−
1548−instance FromJSON RegexpFlag where
1549− parseJSON = withText "RegexpFlag" parse
1550− where parse "ANYSTRING" = pure AnyString
1551− parse "AUTOMATON" = pure Automaton
1552− parse "COMPLEMENT" = pure Complement
1553− parse "EMPTY" = pure Empty
1554− parse "INTERSECTION" = pure Intersection
1555− parse "INTERVAL" = pure Interval
1556− parse f = fail ("Unknown RegexpFlag: " <> show f)
1557−
1558−instance ToJSON Term where
1559− toJSON (Term field value) = object ["term" .= object
1560− [field .= value]]
1561−
1562−instance FromJSON Term where
1563− parseJSON = withObject "Term" parse
1564− where parse o = do termObj <- o .: "term"
1565− case HM.toList termObj of
1566− [(fn, v)] -> Term fn <$> parseJSON v
1567− _ -> fail "Expected object with 1 field-named key"
1568−
1569−instance ToJSON BoolMatch where
1570− toJSON (MustMatch term cache) = object ["must" .= term,
1571− "_cache" .= cache]
1572− toJSON (MustNotMatch term cache) = object ["must_not" .= term,
1573− "_cache" .= cache]
1574− toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
1575− "_cache" .= cache]
1576−
1577−instance FromJSON BoolMatch where
1578− parseJSON = withObject "BoolMatch" parse
1579− where parse o = mustMatch `taggedWith` "must"
1580− <|> mustNotMatch `taggedWith` "must_not"
1581− <|> shouldMatch `taggedWith` "should"
1582− where taggedWith parser k = parser =<< o .: k
1583− mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
1584− mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
1585− shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache