@@ -414,9 +414,6 @@ module Database.V5.Bloodhound.Types
415import Bloodhound.Import
415import Bloodhound.Import
417−import qualified Data.HashMap.Strict as HM
418−import qualified Data.Map.Strict as M
420import Database.V5.Bloodhound.Types.Class
417import Database.V5.Bloodhound.Types.Class
421import Database.V5.Bloodhound.Internal.Analysis
418import Database.V5.Bloodhound.Internal.Analysis
422import Database.V5.Bloodhound.Internal.Aggregation
419import Database.V5.Bloodhound.Internal.Aggregation
@@ -425,6 +422,7 @@ import Database.V5.Bloodhound.Internal.Highlight
425import Database.V5.Bloodhound.Internal.Newtypes
422import Database.V5.Bloodhound.Internal.Newtypes
426import Database.V5.Bloodhound.Internal.Query
423import Database.V5.Bloodhound.Internal.Query
427import Database.V5.Bloodhound.Internal.Sort
424import Database.V5.Bloodhound.Internal.Sort
425+import Database.V5.Bloodhound.Internal.Suggest
429{-| 'unpackId' is a silly convenience function that gets used once.
427{-| 'unpackId' is a silly convenience function that gets used once.
@@ -484,14 +482,32 @@ data Source =
484 | SourceIncludeExclude Include Exclude
482 | SourceIncludeExclude Include Exclude
485 deriving (Eq, Show)
483 deriving (Eq, Show)
485+instance ToJSON Source where
486+ toJSON NoSource = toJSON False
487+ toJSON (SourcePatterns patterns) = toJSON patterns
488+ toJSON (SourceIncludeExclude incl excl) = object [ "includes" .= incl, "excludes" .= excl ]
487data PatternOrPatterns = PopPattern Pattern
490data PatternOrPatterns = PopPattern Pattern
488 | PopPatterns [Pattern] deriving (Eq, Read, Show)
491 | PopPatterns [Pattern] deriving (Eq, Read, Show)
493+instance ToJSON PatternOrPatterns where
494+ toJSON (PopPattern pattern) = toJSON pattern
495+ toJSON (PopPatterns patterns) = toJSON patterns
490data Include = Include [Pattern] deriving (Eq, Read, Show)
497data Include = Include [Pattern] deriving (Eq, Read, Show)
491data Exclude = Exclude [Pattern] deriving (Eq, Read, Show)
498data Exclude = Exclude [Pattern] deriving (Eq, Read, Show)
500+instance ToJSON Include where
501+ toJSON (Include patterns) = toJSON patterns
503+instance ToJSON Exclude where
504+ toJSON (Exclude patterns) = toJSON patterns
493newtype Pattern = Pattern Text deriving (Eq, Read, Show)
506newtype Pattern = Pattern Text deriving (Eq, Read, Show)
508+instance ToJSON Pattern where
509+ toJSON (Pattern pattern) = toJSON pattern
495data SearchResult a =
511data SearchResult a =
496 SearchResult { took :: Int
512 SearchResult { took :: Int
497 , timedOut :: Bool
513 , timedOut :: Bool
@@ -499,7 +515,8 @@ data SearchResult a =
499 , searchHits :: SearchHits a
515 , searchHits :: SearchHits a
500 , aggregations :: Maybe AggregationResults
516 , aggregations :: Maybe AggregationResults
501 , scrollId :: Maybe ScrollId
517 , scrollId :: Maybe ScrollId
502− -- ^ Only one Suggestion request / response per Search is supported.
518+ -- ^ Only one Suggestion request / response per
519+ -- Search is supported.
503 , suggest :: Maybe NamedSuggestionResponse
520 , suggest :: Maybe NamedSuggestionResponse
505 deriving (Eq, Show)
522 deriving (Eq, Show)
@@ -518,514 +535,3 @@ instance (FromJSON a) => FromJSON (SearchResult a) where
518newtype ScrollId =
535newtype ScrollId =
519 ScrollId Text
536 ScrollId Text
520 deriving (Eq, Show, Ord, ToJSON, FromJSON)
537 deriving (Eq, Show, Ord, ToJSON, FromJSON)
523− SearchHits { hitsTotal :: Int
525− , hits :: [Hit a] } deriving (Eq, Show)
528−instance (FromJSON a) => FromJSON (SearchHits a) where
529− parseJSON (Object v) = SearchHits <$>
531− v .: "max_score" <*>
535−instance Semigroup (SearchHits a) where
536− (SearchHits ta ma ha) <> (SearchHits tb mb hb) =
537− SearchHits (ta + tb) (max ma mb) (ha <> hb)
539−instance Monoid (SearchHits a) where
540− mempty = SearchHits 0 Nothing mempty
544− Hit { hitIndex :: IndexName
545− , hitType :: MappingName
548− , hitSource :: Maybe a
549− , hitFields :: Maybe HitFields
550− , hitHighlight :: Maybe HitHighlight } deriving (Eq, Show)
552−instance (FromJSON a) => FromJSON (Hit a) where
553− parseJSON (Object v) = Hit <$>
563−data MissingResult = MissingResult
564− { missingDocCount :: Int
567−instance FromJSON MissingResult where
568− parseJSON = withObject "MissingResult" parse
569− where parse v = MissingResult <$> v .: "doc_count"
571−data TopHitResult a = TopHitResult
572− { tarHits :: (SearchHits a)
575−instance (FromJSON a) => FromJSON (TopHitResult a) where
576− parseJSON (Object v) = TopHitResult <$>
578− parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
580−data TermsResult = TermsResult
581− { termKey :: BucketValue
582− , termsDocCount :: Int
583− , termsAggs :: Maybe AggregationResults
584− } deriving (Read, Show)
586−instance FromJSON TermsResult where
587− parseJSON (Object v) = TermsResult <$>
589− v .: "doc_count" <*>
590− (pure $ getNamedSubAgg v ["key", "doc_count"])
591− parseJSON _ = mempty
593−instance BucketAggregation TermsResult where
595− docCount = termsDocCount
598−data DateHistogramResult = DateHistogramResult
600− , dateKeyStr :: Maybe Text
601− , dateDocCount :: Int
602− , dateHistogramAggs :: Maybe AggregationResults
605−instance FromJSON DateHistogramResult where
606− parseJSON (Object v) = DateHistogramResult <$>
608− v .:? "key_as_string" <*>
609− v .: "doc_count" <*>
610− (pure $ getNamedSubAgg v [ "key"
615− parseJSON _ = mempty
617−instance BucketAggregation DateHistogramResult where
618− key = TextValue . showText . dateKey
619− docCount = dateDocCount
620− aggs = dateHistogramAggs
622−data DateRangeResult = DateRangeResult
623− { dateRangeKey :: Text
624− , dateRangeFrom :: Maybe UTCTime
625− , dateRangeFromAsString :: Maybe Text
626− , dateRangeTo :: Maybe UTCTime
627− , dateRangeToAsString :: Maybe Text
628− , dateRangeDocCount :: Int
629− , dateRangeAggs :: Maybe AggregationResults
630− } deriving (Eq, Show)
632−instance FromJSON DateRangeResult where
633− parseJSON = withObject "DateRangeResult" parse
634− where parse v = DateRangeResult <$>
636− (fmap posixMS <$> v .:? "from") <*>
637− v .:? "from_as_string" <*>
638− (fmap posixMS <$> v .:? "to") <*>
639− v .:? "to_as_string" <*>
640− v .: "doc_count" <*>
641− (pure $ getNamedSubAgg v [ "key"
650−instance BucketAggregation DateRangeResult where
651− key = TextValue . dateRangeKey
652− docCount = dateRangeDocCount
653− aggs = dateRangeAggs
655−toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
656−toTerms = toAggResult
658−toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
659−toDateHistogram = toAggResult
661−toMissing :: Text -> AggregationResults -> Maybe MissingResult
662−toMissing = toAggResult
664−toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
665−toTopHits = toAggResult
667−toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
668−toAggResult t a = M.lookup t a >>= deserialize
669− where deserialize = parseMaybe parseJSON
671−-- Try to get an AggregationResults when we don't know the
672−-- field name. We filter out the known keys to try to minimize the noise.
673−getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
674−getNamedSubAgg o knownKeys = maggRes
675− where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
677− | HM.null unknownKeys = Nothing
678− | otherwise = Just . M.fromList $ HM.toList unknownKeys
680−instance ToJSON Source where
681− toJSON NoSource = toJSON False
682− toJSON (SourcePatterns patterns) = toJSON patterns
683− toJSON (SourceIncludeExclude incl excl) = object [ "includes" .= incl, "excludes" .= excl ]
685−instance ToJSON PatternOrPatterns where
686− toJSON (PopPattern pattern) = toJSON pattern
687− toJSON (PopPatterns patterns) = toJSON patterns
689−instance ToJSON Include where
690− toJSON (Include patterns) = toJSON patterns
692−instance ToJSON Exclude where
693− toJSON (Exclude patterns) = toJSON patterns
695−instance ToJSON Pattern where
696− toJSON (Pattern pattern) = toJSON pattern
699−instance ToJSON FieldHighlight where
700− toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
701− object [ fName .= fSettings ]
702− toJSON (FieldHighlight (FieldName fName) Nothing) =
703− object [ fName .= emptyObject ]
705−instance ToJSON Highlights where
706− toJSON (Highlights global fields) =
707− omitNulls (("fields" .= fields)
708− : highlightSettingsPairs global)
710−instance ToJSON HighlightSettings where
711− toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
713−highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
714−highlightSettingsPairs Nothing = []
715−highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
716−highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
717−highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
720−plainHighPairs :: Maybe PlainHighlight -> [Pair]
721−plainHighPairs Nothing = []
722−plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
723− [ "type" .= String "plain"]
724− ++ commonHighlightPairs plCom
725− ++ nonPostingsToPairs plNonPost
727−postHighPairs :: Maybe PostingsHighlight -> [Pair]
728−postHighPairs Nothing = []
729−postHighPairs (Just (PostingsHighlight pCom)) =
730− ("type" .= String "postings")
731− : commonHighlightPairs pCom
733−fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
734−fastVectorHighPairs Nothing = []
735−fastVectorHighPairs (Just
736− (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars
737− fvBoundMaxScan fvFragOff fvMatchedFields
739− [ "type" .= String "fvh"
740− , "boundary_chars" .= fvBoundChars
741− , "boundary_max_scan" .= fvBoundMaxScan
742− , "fragment_offset" .= fvFragOff
743− , "matched_fields" .= fvMatchedFields
744− , "phraseLimit" .= fvPhraseLim]
745− ++ commonHighlightPairs fvCom
746− ++ nonPostingsToPairs fvNonPostSettings
748−commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
749−commonHighlightPairs Nothing = []
750−commonHighlightPairs (Just (CommonHighlight chScore chForceSource
751− chTag chEncoder chNoMatchSize
752− chHighlightQuery chRequireFieldMatch)) =
753− [ "order" .= chScore
754− , "force_source" .= chForceSource
755− , "encoder" .= chEncoder
756− , "no_match_size" .= chNoMatchSize
757− , "highlight_query" .= chHighlightQuery
758− , "require_fieldMatch" .= chRequireFieldMatch
760− ++ highlightTagToPairs chTag
763−nonPostingsToPairs :: Maybe NonPostings -> [Pair]
764−nonPostingsToPairs Nothing = []
765−nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
766− [ "fragment_size" .= npFragSize
767− , "number_of_fragments" .= npNumOfFrags
770−highlightTagToPairs :: Maybe HighlightTag -> [Pair]
771−highlightTagToPairs (Just (TagSchema _)) =
772− [ "scheme" .= String "default"
774−highlightTagToPairs (Just (CustomTags (pre, post))) =
776− , "post_tags" .= post
778−highlightTagToPairs Nothing = []
780−data Suggest = Suggest
781− { suggestText :: Text
782− , suggestName :: Text
783− , suggestType :: SuggestType
784− } deriving (Eq, Show)
786−instance ToJSON Suggest where
787− toJSON Suggest{..} =
788− object [ "text" .= suggestText
789− , suggestName .= suggestType
792−instance FromJSON Suggest where
793− parseJSON (Object o) = do
794− suggestText' <- o .: "text"
797− $ HM.filterWithKey (\x _ -> x /= "text") o
799− case dropTextList of
800− [(x, _)] -> return x
801− _ -> fail "error parsing Suggest field name"
802− suggestType' <- o .: suggestName'
803− return $ Suggest suggestText' suggestName' suggestType'
804− parseJSON x = typeMismatch "Suggest" x
807− SuggestTypePhraseSuggester PhraseSuggester
810−instance ToJSON SuggestType where
811− toJSON (SuggestTypePhraseSuggester x) =
812− object [ "phrase" .= x ]
814−instance FromJSON SuggestType where
815− parseJSON = withObject "SuggestType" parse
816− where parse o = phraseSuggester `taggedWith` "phrase"
817− where taggedWith parser k = parser =<< o .: k
818− phraseSuggester = pure . SuggestTypePhraseSuggester
820−data PhraseSuggester = PhraseSuggester
821− { phraseSuggesterField :: FieldName
822− , phraseSuggesterGramSize :: Maybe Int
823− , phraseSuggesterRealWordErrorLikelihood :: Maybe Int
824− , phraseSuggesterConfidence :: Maybe Int
825− , phraseSuggesterMaxErrors :: Maybe Int
826− , phraseSuggesterSeparator :: Maybe Text
827− , phraseSuggesterSize :: Maybe Size
828− , phraseSuggesterAnalyzer :: Maybe Analyzer
829− , phraseSuggesterShardSize :: Maybe Int
830− , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter
831− , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate
832− , phraseSuggesterCandidateGenerators :: [DirectGenerators]
833− } deriving (Eq, Show)
835−instance ToJSON PhraseSuggester where
836− toJSON PhraseSuggester{..} =
837− omitNulls [ "field" .= phraseSuggesterField
838− , "gram_size" .= phraseSuggesterGramSize
839− , "real_word_error_likelihood" .=
840− phraseSuggesterRealWordErrorLikelihood
841− , "confidence" .= phraseSuggesterConfidence
842− , "max_errors" .= phraseSuggesterMaxErrors
843− , "separator" .= phraseSuggesterSeparator
844− , "size" .= phraseSuggesterSize
845− , "analyzer" .= phraseSuggesterAnalyzer
846− , "shard_size" .= phraseSuggesterShardSize
847− , "highlight" .= phraseSuggesterHighlight
848− , "collate" .= phraseSuggesterCollate
849− , "direct_generator" .=
850− phraseSuggesterCandidateGenerators
853−instance FromJSON PhraseSuggester where
854− parseJSON = withObject "PhraseSuggester" parse
855− where parse o = PhraseSuggester
857− <*> o .:? "gram_size"
858− <*> o .:? "real_word_error_likelihood"
859− <*> o .:? "confidence"
860− <*> o .:? "max_errors"
861− <*> o .:? "separator"
863− <*> o .:? "analyzer"
864− <*> o .:? "shard_size"
865− <*> o .:? "highlight"
867− <*> o .:? "direct_generator" .!= []
869−mkPhraseSuggester :: FieldName -> PhraseSuggester
870−mkPhraseSuggester fName =
871− PhraseSuggester fName Nothing Nothing Nothing Nothing Nothing Nothing
872− Nothing Nothing Nothing Nothing []
874−data PhraseSuggesterHighlighter =
875− PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text
876− , phraseSuggesterHighlighterPostTag :: Text
880−instance ToJSON PhraseSuggesterHighlighter where
881− toJSON PhraseSuggesterHighlighter{..} =
882− object [ "pre_tag" .= phraseSuggesterHighlighterPreTag
883− , "post_tag" .= phraseSuggesterHighlighterPostTag
886−instance FromJSON PhraseSuggesterHighlighter where
887− parseJSON = withObject "PhraseSuggesterHighlighter" parse
888− where parse o = PhraseSuggesterHighlighter
892−data PhraseSuggesterCollate = PhraseSuggesterCollate
893− { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline
894− , phraseSuggesterCollatePrune :: Bool
895− } deriving (Eq, Show)
897−instance ToJSON PhraseSuggesterCollate where
898− toJSON PhraseSuggesterCollate{..} =
899− object [ "query" .= object
900− [ "inline" .= (inline phraseSuggesterCollateTemplateQuery)
902− , "params" .= (params phraseSuggesterCollateTemplateQuery)
903− , "prune" .= phraseSuggesterCollatePrune
906−instance FromJSON PhraseSuggesterCollate where
907− parseJSON (Object o) = do
908− query' <- o .: "query"
909− inline' <- query' .: "inline"
910− params' <- o .: "params"
911− prune' <- o .:? "prune" .!= False
912− return $ PhraseSuggesterCollate
913− (TemplateQueryInline inline' params') prune'
914− parseJSON x = typeMismatch "PhraseSuggesterCollate" x
916−data SuggestOptions =
917− SuggestOptions { suggestOptionsText :: Text
918− , suggestOptionsScore :: Double
919− , suggestOptionsFreq :: Maybe Int
920− , suggestOptionsHighlighted :: Maybe Text
922− deriving (Eq, Read, Show)
924−instance FromJSON SuggestOptions where
925− parseJSON = withObject "SuggestOptions" parse
927− parse o = SuggestOptions
931− <*> o .:? "highlighted"
933−data SuggestResponse =
934− SuggestResponse { suggestResponseText :: Text
935− , suggestResponseOffset :: Int
936− , suggestResponseLength :: Int
937− , suggestResponseOptions :: [SuggestOptions]
939− deriving (Eq, Read, Show)
941−instance FromJSON SuggestResponse where
942− parseJSON = withObject "SuggestResponse" parse
943− where parse o = SuggestResponse
949−data NamedSuggestionResponse = NamedSuggestionResponse
951− , nsrResponses :: [SuggestResponse]
952− } deriving (Eq, Read, Show)
954−instance FromJSON NamedSuggestionResponse where
955− parseJSON (Object o) = do
956− suggestionName' <- case HM.toList o of
957− [(x, _)] -> return x
958− _ -> fail "error parsing NamedSuggestionResponse name"
959− suggestionResponses' <- o .: suggestionName'
960− return $ NamedSuggestionResponse suggestionName' suggestionResponses'
962− parseJSON x = typeMismatch "NamedSuggestionResponse" x
964−data DirectGeneratorSuggestModeTypes = DirectGeneratorSuggestModeMissing
965− | DirectGeneratorSuggestModePopular
966− | DirectGeneratorSuggestModeAlways
969−instance ToJSON DirectGeneratorSuggestModeTypes where
970− toJSON DirectGeneratorSuggestModeMissing = "missing"
971− toJSON DirectGeneratorSuggestModePopular = "popular"
972− toJSON DirectGeneratorSuggestModeAlways = "always"
974−instance FromJSON DirectGeneratorSuggestModeTypes where
975− parseJSON = withText "DirectGeneratorSuggestModeTypes" parse
978− pure DirectGeneratorSuggestModeMissing
980− pure DirectGeneratorSuggestModePopular
982− pure DirectGeneratorSuggestModeAlways
984− fail ("Unexpected DirectGeneratorSuggestModeTypes: " <> show f)
986−data DirectGenerators = DirectGenerators
987− { directGeneratorsField :: FieldName
988− , directGeneratorsSize :: Maybe Int
989− , directGeneratorSuggestMode :: DirectGeneratorSuggestModeTypes
990− , directGeneratorMaxEdits :: Maybe Double
991− , directGeneratorPrefixLength :: Maybe Int
992− , directGeneratorMinWordLength :: Maybe Int
993− , directGeneratorMaxInspections :: Maybe Int
994− , directGeneratorMinDocFreq :: Maybe Double
995− , directGeneratorMaxTermFreq :: Maybe Double
996− , directGeneratorPreFilter :: Maybe Text
997− , directGeneratorPostFilter :: Maybe Text
998− } deriving (Eq, Show)
1000−instance ToJSON DirectGenerators where
1001− toJSON DirectGenerators{..} =
1002− omitNulls [ "field" .= directGeneratorsField
1003− , "size" .= directGeneratorsSize
1004− , "suggest_mode" .= directGeneratorSuggestMode
1005− , "max_edits" .= directGeneratorMaxEdits
1006− , "prefix_length" .= directGeneratorPrefixLength
1007− , "min_word_length" .= directGeneratorMinWordLength
1008− , "max_inspections" .= directGeneratorMaxInspections
1009− , "min_doc_freq" .= directGeneratorMinDocFreq
1010− , "max_term_freq" .= directGeneratorMaxTermFreq
1011− , "pre_filter" .= directGeneratorPreFilter
1012− , "post_filter" .= directGeneratorPostFilter
1015−instance FromJSON DirectGenerators where
1016− parseJSON = withObject "DirectGenerators" parse
1017− where parse o = DirectGenerators
1020− <*> o .: "suggest_mode"
1021− <*> o .:? "max_edits"
1022− <*> o .:? "prefix_length"
1023− <*> o .:? "min_word_length"
1024− <*> o .:? "max_inspections"
1025− <*> o .:? "min_doc_freq"
1026− <*> o .:? "max_term_freq"
1027− <*> o .:? "pre_filter"
1028− <*> o .:? "post_filter"
1030−mkDirectGenerators :: FieldName -> DirectGenerators
1031−mkDirectGenerators fn = DirectGenerators fn Nothing DirectGeneratorSuggestModeMissing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing