{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UndecidableInstances #-} ------------------------------------------------------------------------------- -- | -- Module : Database.Bloodhound.Types -- Copyright : (C) 2014 Chris Allen -- License : BSD-style (see the file LICENSE) -- Maintainer : Chris Allen >> :set -XOverloadedStrings -- >>> import Database.Bloodhound -- >>> let testServer = (Server "http://localhost:9200") -- >>> let testIndex = IndexName "twitter" -- >>> let testMapping = MappingName "tweet" -- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2) -- defaultIndexSettings is exported by Database.Bloodhound as well -- no trailing slashes in servers, library handles building the path. {-| Common environment for Elasticsearch calls. Connections will be pipelined according to the provided HTTP connection manager. -} data BHEnv = BHEnv { bhServer :: Server , bhManager :: Manager } {-| All API calls to Elasticsearch operate within MonadBH. The idea is that it can be easily embedded in your own monad transformer stack. A default instance for a ReaderT and alias 'BH' is provided for the simple case. -} class (Functor m, Applicative m, MonadIO m) => MonadBH m where getBHEnv :: m BHEnv newtype BH m a = BH { unBH :: ReaderT BHEnv m a } deriving ( Functor , Applicative , Monad , MonadIO , MonadState s , MonadWriter w , MonadError e , Alternative , MonadPlus , MonadFix) instance MonadTrans BH where lift = BH . lift instance (MonadReader r m) => MonadReader r (BH m) where ask = lift ask local f (BH (ReaderT m)) = BH $ ReaderT $ \r -> local f (m r) instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where getBHEnv = BH getBHEnv instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where getBHEnv = ask runBH :: BHEnv -> BH m a -> m a runBH e f = runReaderT (unBH f) e {-| 'Version' is embedded in 'Status' -} data Version = Version { number :: Text , build_hash :: Text , build_timestamp :: UTCTime , build_snapshot :: Bool , lucene_version :: Text } deriving (Eq, Show, Generic) {-| 'Status' is a data type for describing the JSON body returned by Elasticsearch when you query its status. This was deprecated in 1.2.0. -} data Status = Status { ok :: Maybe Bool , status :: Int , name :: Text , version :: Version , tagline :: Text } deriving (Eq, Show) {-| 'IndexSettings' is used to configure the shards and replicas when you create an Elasticsearch Index. -} data IndexSettings = IndexSettings { indexShards :: ShardCount , indexReplicas :: ReplicaCount } deriving (Eq, Show) {-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -} defaultIndexSettings :: IndexSettings defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2) {-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -} type Reply = Network.HTTP.Client.Response L.ByteString type Method = NHTM.Method {-| 'OpenCloseIndex' is a sum type for opening and closing indices. -} data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Show) data FieldType = GeoPointType | GeoShapeType | FloatType | IntegerType | LongType | ShortType | ByteType deriving (Eq, Show) data FieldDefinition = FieldDefinition { fieldType :: FieldType } deriving (Eq, Show) data MappingField = MappingField { mappingFieldName :: FieldName , fieldDefinition :: FieldDefinition } deriving (Eq, Show) {-| Support for type reification of 'Mapping's is currently incomplete, for now the mapping API verbiage expects a 'ToJSON'able blob. Indexes have mappings, mappings are schemas for the documents contained in the index. I'd recommend having only one mapping per index, always having a mapping, and keeping different kinds of documents separated if possible. -} data Mapping = Mapping { typeName :: TypeName , mappingFields :: [MappingField] } deriving (Eq, Show) {-| 'BulkOperation' is a sum type for expressing the four kinds of bulk operation index, create, delete, and update. 'BulkIndex' behaves like an "upsert", 'BulkCreate' will fail if a document already exists at the DocId. -} data BulkOperation = BulkIndex IndexName MappingName DocId Value | BulkCreate IndexName MappingName DocId Value | BulkDelete IndexName MappingName DocId | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show) {-| 'EsResult' describes the standard wrapper JSON document that you see in successful Elasticsearch responses. -} data EsResult a = EsResult { _index :: Text , _type :: Text , _id :: Text , _version :: Int , found :: Maybe Bool , _source :: a } deriving (Eq, Show) {-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order dependent with later sorts acting as tie-breakers for earlier sorts. -} type Sort = [SortSpec] {-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and 'DistanceUnit' to express "nearness" to a single geographical point as a sort specification. -} data SortSpec = DefaultSortSpec DefaultSort | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Show) {-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a 'mkSort' convenience function for when you want to specify only the most common parameters. -} data DefaultSort = DefaultSort { sortFieldName :: FieldName , sortOrder :: SortOrder -- default False , ignoreUnmapped :: Bool , sortMode :: Maybe SortMode , missingSort :: Maybe Missing , nestedFilter :: Maybe Filter } deriving (Eq, Show) {-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get encoded into "asc" or "desc" when turned into JSON. -} data SortOrder = Ascending | Descending deriving (Eq, Show) {-| 'Missing' prescribes how to handle missing fields. A missing field can be sorted last, first, or using a custom value as a substitute. -} data Missing = LastMissing | FirstMissing | CustomMissing Text deriving (Eq, Show) {-| 'SortMode' prescribes how to handle sorting array/multi-valued fields. http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option -} data SortMode = SortMin | SortMax | SortSum | SortAvg deriving (Eq, Show) {-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so that you can concisely describe the usual kind of 'SortSpec's you want. -} mkSort :: FieldName -> SortOrder -> DefaultSort mkSort fieldName sOrder = DefaultSort fieldName sOrder False Nothing Nothing Nothing {-| 'Cache' is for telling ES whether it should cache a 'Filter' not. 'Query's cannot be cached. -} type Cache = Bool -- caching on/off defaultCache :: Cache defaultCache = False {-| 'PrefixValue' is used in 'PrefixQuery' as the main query component. -} type PrefixValue = Text {-| 'BooleanOperator' is the usual And/Or operators with an ES compatible JSON encoding baked in. Used all over the place. -} data BooleanOperator = And | Or deriving (Eq, Show) {-| 'ShardCount' is part of 'IndexSettings' -} newtype ShardCount = ShardCount Int deriving (Eq, Show, Generic) {-| 'ReplicaCount' is part of 'IndexSettings' -} newtype ReplicaCount = ReplicaCount Int deriving (Eq, Show, Generic) {-| 'Server' is used with the client functions to point at the ES instance -} newtype Server = Server Text deriving (Eq, Show) {-| 'IndexName' is used to describe which index to query/create/delete -} newtype IndexName = IndexName Text deriving (Eq, Generic, Show) {-| 'MappingName' is part of mappings which are how ES describes and schematizes the data in the indices. -} newtype MappingName = MappingName Text deriving (Eq, Generic, Show) {-| 'DocId' is a generic wrapper value for expressing unique Document IDs. Can be set by the user or created by ES itself. Often used in client functions for poking at specific documents. -} newtype DocId = DocId Text deriving (Eq, Generic, Show) {-| 'QueryString' is used to wrap query text bodies, be they human written or not. -} newtype QueryString = QueryString Text deriving (Eq, Generic, Show) {-| 'FieldName' is used all over the place wherever a specific field within a document needs to be specified, usually in 'Query's or 'Filter's. -} newtype FieldName = FieldName Text deriving (Eq, Show) {-| 'CacheName' is used in 'RegexpFilter' for describing the 'CacheKey' keyed caching behavior. -} newtype CacheName = CacheName Text deriving (Eq, Show) {-| 'CacheKey' is used in 'RegexpFilter' to key regex caching. -} newtype CacheKey = CacheKey Text deriving (Eq, Show) newtype Existence = Existence Bool deriving (Eq, Show) newtype NullValue = NullValue Bool deriving (Eq, Show) newtype CutoffFrequency = CutoffFrequency Double deriving (Eq, Show, Generic) newtype Analyzer = Analyzer Text deriving (Eq, Show, Generic) newtype MaxExpansions = MaxExpansions Int deriving (Eq, Show, Generic) {-| 'Lenient', if set to true, will cause format based failures to be ignored. I don't know what the bloody default is, Elasticsearch documentation didn't say what it was. Let me know if you figure it out. -} newtype Lenient = Lenient Bool deriving (Eq, Show, Generic) newtype Tiebreaker = Tiebreaker Double deriving (Eq, Show, Generic) newtype Boost = Boost Double deriving (Eq, Show, Generic) newtype BoostTerms = BoostTerms Double deriving (Eq, Show, Generic) {-| 'MinimumMatch' controls how many should clauses in the bool query should match. Can be an absolute value (2) or a percentage (30%) or a combination of both. -} newtype MinimumMatch = MinimumMatch Int deriving (Eq, Show, Generic) newtype MinimumMatchText = MinimumMatchText Text deriving (Eq, Show) newtype DisableCoord = DisableCoord Bool deriving (Eq, Show, Generic) newtype IgnoreTermFrequency = IgnoreTermFrequency Bool deriving (Eq, Show, Generic) newtype MinimumTermFrequency = MinimumTermFrequency Int deriving (Eq, Show, Generic) newtype MaxQueryTerms = MaxQueryTerms Int deriving (Eq, Show, Generic) newtype Fuzziness = Fuzziness Double deriving (Eq, Show, Generic) {-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -} newtype PrefixLength = PrefixLength Int deriving (Eq, Show, Generic) newtype TypeName = TypeName Text deriving (Eq, Show, Generic) newtype PercentMatch = PercentMatch Double deriving (Eq, Show, Generic) newtype StopWord = StopWord Text deriving (Eq, Show, Generic) newtype QueryPath = QueryPath Text deriving (Eq, Show, Generic) {-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly heavy, because all terms in the index need to be examined, just in case they match. Leading wildcards can be disabled by setting 'AllowLeadingWildcard' to false. -} newtype AllowLeadingWildcard = AllowLeadingWildcard Bool deriving (Eq, Show, Generic) newtype LowercaseExpanded = LowercaseExpanded Bool deriving (Eq, Show, Generic) newtype EnablePositionIncrements = EnablePositionIncrements Bool deriving (Eq, Show, Generic) {-| By default, wildcard terms in a query are not analyzed. Setting 'AnalyzeWildcard' to true enables best-effort analysis. -} newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Show, Generic) {-| 'GeneratePhraseQueries' defaults to false. -} newtype GeneratePhraseQueries = GeneratePhraseQueries Bool deriving (Eq, Show, Generic) {-| 'Locale' is used for string conversions - defaults to ROOT. -} newtype Locale = Locale Text deriving (Eq, Show, Generic) newtype MaxWordLength = MaxWordLength Int deriving (Eq, Show, Generic) newtype MinWordLength = MinWordLength Int deriving (Eq, Show, Generic) {-| 'PhraseSlop' sets the default slop for phrases, 0 means exact phrase matches. Default is 0. -} newtype PhraseSlop = PhraseSlop Int deriving (Eq, Show, Generic) newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Show, Generic) newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, Generic) {-| 'unpackId' is a silly convenience function that gets used once. -} unpackId :: DocId -> Text unpackId (DocId docId) = docId type TrackSortScores = Bool newtype From = From Int deriving (Eq, Show, ToJSON) newtype Size = Size Int deriving (Eq, Show, ToJSON) data Search = Search { queryBody :: Maybe Query , filterBody :: Maybe Filter , sortBody :: Maybe Sort , aggBody :: Maybe Aggregations , highlight :: Maybe Highlights -- default False , trackSortScores :: TrackSortScores , from :: From , size :: Size } deriving (Eq, Show) data Highlights = Highlights { globalsettings :: Maybe HighlightSettings , highlightFields :: [FieldHighlight] } deriving (Show, Eq) data FieldHighlight = FieldHighlight FieldName (Maybe HighlightSettings) deriving (Show, Eq) data HighlightSettings = Plain PlainHighlight | Postings PostingsHighlight | FastVector FastVectorHighlight deriving (Show, Eq) data PlainHighlight = PlainHighlight { plainCommon :: Maybe CommonHighlight , plainNonPost :: Maybe NonPostings } deriving (Show, Eq) -- This requires that index_options are set to 'offset' in the mapping. data PostingsHighlight = PostingsHighlight (Maybe CommonHighlight) deriving (Show, Eq) -- This requires that term_vector is set to 'with_positions_offsets' in the mapping. data FastVectorHighlight = FastVectorHighlight { fvCommon :: Maybe CommonHighlight , fvNonPostSettings :: Maybe NonPostings , boundaryChars :: Maybe Text , boundaryMaxScan :: Maybe Int , fragmentOffset :: Maybe Int , matchedFields :: [Text] , phraseLimit :: Maybe Int } deriving (Show, Eq) data CommonHighlight = CommonHighlight { order :: Maybe Text , forceSource :: Maybe Bool , tag :: Maybe HighlightTag , encoder :: Maybe HighlightEncoder , noMatchSize :: Maybe Int , highlightQuery :: Maybe Query , requireFieldMatch :: Maybe Bool } deriving (Show, Eq) -- Settings that are only applicable to FastVector and Plain highlighters. data NonPostings = NonPostings { fragmentSize :: Maybe Int , numberOfFragments :: Maybe Int} deriving (Show, Eq) data HighlightEncoder = DefaultEncoder | HTMLEncoder deriving (Show, Eq) -- NOTE: Should the tags use some kind of HTML type, rather than Text? data HighlightTag = TagSchema Text | CustomTags ([Text], [Text]) -- Only uses more than the first value in the lists if fvh deriving (Show, Eq) data Query = TermQuery Term (Maybe Boost) | TermsQuery (NonEmpty Term) | QueryMatchQuery MatchQuery | QueryMultiMatchQuery MultiMatchQuery | QueryBoolQuery BoolQuery | QueryBoostingQuery BoostingQuery | QueryCommonTermsQuery CommonTermsQuery | ConstantScoreFilter Filter Boost | ConstantScoreQuery Query Boost | QueryDisMaxQuery DisMaxQuery | QueryFilteredQuery FilteredQuery | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery | QueryFuzzyQuery FuzzyQuery | QueryHasChildQuery HasChildQuery | QueryHasParentQuery HasParentQuery | IdsQuery MappingName [DocId] | QueryIndicesQuery IndicesQuery | MatchAllQuery (Maybe Boost) | QueryMoreLikeThisQuery MoreLikeThisQuery | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery | QueryNestedQuery NestedQuery | QueryPrefixQuery PrefixQuery | QueryQueryStringQuery QueryStringQuery | QuerySimpleQueryStringQuery SimpleQueryStringQuery | QueryRangeQuery RangeQuery | QueryRegexpQuery RegexpQuery deriving (Eq, Show) data RegexpQuery = RegexpQuery { regexpQueryField :: FieldName , regexpQuery :: Regexp , regexpQueryFlags :: RegexpFlags , regexpQueryBoost :: Maybe Boost } deriving (Eq, Show) data RangeQuery = RangeQuery { rangeQueryField :: FieldName , rangeQueryRange :: RangeValue , rangeQueryBoost :: Boost } deriving (Eq, Show) mkRangeQuery :: FieldName -> RangeValue -> RangeQuery mkRangeQuery f r = RangeQuery f r (Boost 1.0) data SimpleQueryStringQuery = SimpleQueryStringQuery { simpleQueryStringQuery :: QueryString , simpleQueryStringField :: Maybe FieldOrFields , simpleQueryStringOperator :: Maybe BooleanOperator , simpleQueryStringAnalyzer :: Maybe Analyzer , simpleQueryStringFlags :: Maybe [SimpleQueryFlag] , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded , simpleQueryStringLocale :: Maybe Locale } deriving (Eq, Show) data SimpleQueryFlag = SimpleQueryAll | SimpleQueryNone | SimpleQueryAnd | SimpleQueryOr | SimpleQueryPrefix | SimpleQueryPhrase | SimpleQueryPrecedence | SimpleQueryEscape | SimpleQueryWhitespace | SimpleQueryFuzzy | SimpleQueryNear | SimpleQuerySlop deriving (Eq, Show) -- use_dis_max and tie_breaker when fields are plural? data QueryStringQuery = QueryStringQuery { queryStringQuery :: QueryString , queryStringDefaultField :: Maybe FieldName , queryStringOperator :: Maybe BooleanOperator , queryStringAnalyzer :: Maybe Analyzer , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard , queryStringLowercaseExpanded :: Maybe LowercaseExpanded , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions , queryStringFuzziness :: Maybe Fuzziness , queryStringFuzzyPrefixLength :: Maybe PrefixLength , queryStringPhraseSlop :: Maybe PhraseSlop , queryStringBoost :: Maybe Boost , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries , queryStringMinimumShouldMatch :: Maybe MinimumMatch , queryStringLenient :: Maybe Lenient , queryStringLocale :: Maybe Locale } deriving (Eq, Show) mkQueryStringQuery :: QueryString -> QueryStringQuery mkQueryStringQuery qs = QueryStringQuery qs Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing data FieldOrFields = FofField FieldName | FofFields [FieldName] deriving (Eq, Show) data PrefixQuery = PrefixQuery { prefixQueryField :: FieldName , prefixQueryPrefixValue :: Text , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show) data NestedQuery = NestedQuery { nestedQueryPath :: QueryPath , nestedQueryScoreType :: ScoreType , nestedQuery :: Query } deriving (Eq, Show) data MoreLikeThisFieldQuery = MoreLikeThisFieldQuery { moreLikeThisFieldText :: Text , moreLikeThisFieldFields :: FieldName -- default 0.3 (30%) , moreLikeThisFieldPercentMatch :: Maybe PercentMatch , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms , moreLikeThisFieldStopWords :: Maybe [StopWord] , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency , moreLikeThisFieldMinWordLength :: Maybe MinWordLength , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength , moreLikeThisFieldBoostTerms :: Maybe BoostTerms , moreLikeThisFieldBoost :: Maybe Boost , moreLikeThisFieldAnalyzer :: Maybe Analyzer } deriving (Eq, Show) data MoreLikeThisQuery = MoreLikeThisQuery { moreLikeThisText :: Text , moreLikeThisFields :: Maybe [FieldName] -- default 0.3 (30%) , moreLikeThisPercentMatch :: Maybe PercentMatch , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms , moreLikeThisStopWords :: Maybe [StopWord] , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency , moreLikeThisMinWordLength :: Maybe MinWordLength , moreLikeThisMaxWordLength :: Maybe MaxWordLength , moreLikeThisBoostTerms :: Maybe BoostTerms , moreLikeThisBoost :: Maybe Boost , moreLikeThisAnalyzer :: Maybe Analyzer } deriving (Eq, Show) data IndicesQuery = IndicesQuery { indicesQueryIndices :: [IndexName] , indicesQuery :: Query -- default "all" , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show) data HasParentQuery = HasParentQuery { hasParentQueryType :: TypeName , hasParentQuery :: Query , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Show) data HasChildQuery = HasChildQuery { hasChildQueryType :: TypeName , hasChildQuery :: Query , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Show) data ScoreType = ScoreTypeMax | ScoreTypeSum | ScoreTypeAvg | ScoreTypeNone deriving (Eq, Show) data FuzzyQuery = FuzzyQuery { fuzzyQueryField :: FieldName , fuzzyQueryValue :: Text , fuzzyQueryPrefixLength :: PrefixLength , fuzzyQueryMaxExpansions :: MaxExpansions , fuzzyQueryFuzziness :: Fuzziness , fuzzyQueryBoost :: Maybe Boost } deriving (Eq, Show) data FuzzyLikeFieldQuery = FuzzyLikeFieldQuery { fuzzyLikeField :: FieldName -- anaphora is good for the soul. , fuzzyLikeFieldText :: Text , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency , fuzzyLikeFieldFuzziness :: Fuzziness , fuzzyLikeFieldPrefixLength :: PrefixLength , fuzzyLikeFieldBoost :: Boost , fuzzyLikeFieldAnalyzer :: Maybe Analyzer } deriving (Eq, Show) data FuzzyLikeThisQuery = FuzzyLikeThisQuery { fuzzyLikeFields :: [FieldName] , fuzzyLikeText :: Text , fuzzyLikeMaxQueryTerms :: MaxQueryTerms , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency , fuzzyLikeFuzziness :: Fuzziness , fuzzyLikePrefixLength :: PrefixLength , fuzzyLikeBoost :: Boost , fuzzyLikeAnalyzer :: Maybe Analyzer } deriving (Eq, Show) data FilteredQuery = FilteredQuery { filteredQuery :: Query , filteredFilter :: Filter } deriving (Eq, Show) data DisMaxQuery = DisMaxQuery { disMaxQueries :: [Query] -- default 0.0 , disMaxTiebreaker :: Tiebreaker , disMaxBoost :: Maybe Boost } deriving (Eq, Show) data MatchQuery = MatchQuery { matchQueryField :: FieldName , matchQueryQueryString :: QueryString , matchQueryOperator :: BooleanOperator , matchQueryZeroTerms :: ZeroTermsQuery , matchQueryCutoffFrequency :: Maybe CutoffFrequency , matchQueryMatchType :: Maybe MatchQueryType , matchQueryAnalyzer :: Maybe Analyzer , matchQueryMaxExpansions :: Maybe MaxExpansions , matchQueryLenient :: Maybe Lenient } deriving (Eq, Show) {-| 'mkMatchQuery' is a convenience function that defaults the less common parameters, enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery' -} mkMatchQuery :: FieldName -> QueryString -> MatchQuery mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing data MatchQueryType = MatchPhrase | MatchPhrasePrefix deriving (Eq, Show) data MultiMatchQuery = MultiMatchQuery { multiMatchQueryFields :: [FieldName] , multiMatchQueryString :: QueryString , multiMatchQueryOperator :: BooleanOperator , multiMatchQueryZeroTerms :: ZeroTermsQuery , multiMatchQueryTiebreaker :: Maybe Tiebreaker , multiMatchQueryType :: Maybe MultiMatchQueryType , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency , multiMatchQueryAnalyzer :: Maybe Analyzer , multiMatchQueryMaxExpansions :: Maybe MaxExpansions , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Show) {-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters, enabling you to provide only the list of 'FieldName's and 'QueryString' to make a 'MultiMatchQuery'. -} mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery mkMultiMatchQuery matchFields query = MultiMatchQuery matchFields query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing data MultiMatchQueryType = MultiMatchBestFields | MultiMatchMostFields | MultiMatchCrossFields | MultiMatchPhrase | MultiMatchPhrasePrefix deriving (Eq, Show) data BoolQuery = BoolQuery { boolQueryMustMatch :: [Query] , boolQueryMustNotMatch :: [Query] , boolQueryShouldMatch :: [Query] , boolQueryMinimumShouldMatch :: Maybe MinimumMatch , boolQueryBoost :: Maybe Boost , boolQueryDisableCoord :: Maybe DisableCoord } deriving (Eq, Show) mkBoolQuery :: [Query] -> [Query] -> [Query] -> BoolQuery mkBoolQuery must mustNot should = BoolQuery must mustNot should Nothing Nothing Nothing data BoostingQuery = BoostingQuery { positiveQuery :: Query , negativeQuery :: Query , negativeBoost :: Boost } deriving (Eq, Show) data CommonTermsQuery = CommonTermsQuery { commonField :: FieldName , commonQuery :: QueryString , commonCutoffFrequency :: CutoffFrequency , commonLowFreqOperator :: BooleanOperator , commonHighFreqOperator :: BooleanOperator , commonMinimumShouldMatch :: Maybe CommonMinimumMatch , commonBoost :: Maybe Boost , commonAnalyzer :: Maybe Analyzer , commonDisableCoord :: Maybe DisableCoord } deriving (Eq, Show) data CommonMinimumMatch = CommonMinimumMatchHighLow MinimumMatchHighLow | CommonMinimumMatch MinimumMatch deriving (Eq, Show) data MinimumMatchHighLow = MinimumMatchHighLow { lowFreq :: MinimumMatch , highFreq :: MinimumMatch } deriving (Eq, Show) data Filter = AndFilter [Filter] Cache | OrFilter [Filter] Cache | NotFilter Filter Cache | IdentityFilter | BoolFilter BoolMatch | ExistsFilter FieldName -- always cached | GeoBoundingBoxFilter GeoBoundingBoxConstraint | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache | GeoDistanceRangeFilter GeoPoint DistanceRange | GeoPolygonFilter FieldName [LatLon] | IdsFilter MappingName [DocId] | LimitFilter Int | MissingFilter FieldName Existence NullValue | PrefixFilter FieldName PrefixValue Cache | RangeFilter FieldName RangeValue RangeExecution Cache | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey | TermFilter Term Cache deriving (Eq, Show) data ZeroTermsQuery = ZeroTermsNone | ZeroTermsAll deriving (Eq, Show) data RangeExecution = RangeExecutionIndex | RangeExecutionFielddata deriving (Eq, Show) newtype Regexp = Regexp Text deriving (Eq, Show) data RegexpFlags = AllRegexpFlags | NoRegexpFlags | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show) data RegexpFlag = AnyString | Automaton | Complement | Empty | Intersection | Interval deriving (Eq, Show) newtype LessThan = LessThan Double deriving (Eq, Show) newtype LessThanEq = LessThanEq Double deriving (Eq, Show) newtype GreaterThan = GreaterThan Double deriving (Eq, Show) newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Show) newtype LessThanD = LessThanD UTCTime deriving (Eq, Show) newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Show) newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Show) newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Show) data RangeValue = RangeDateLte LessThanEqD | RangeDateLt LessThanD | RangeDateGte GreaterThanEqD | RangeDateGt GreaterThanD | RangeDateGtLt GreaterThanD LessThanD | RangeDateGteLte GreaterThanEqD LessThanEqD | RangeDateGteLt GreaterThanEqD LessThanD | RangeDateGtLte GreaterThanD LessThanEqD | RangeDoubleLte LessThanEq | RangeDoubleLt LessThan | RangeDoubleGte GreaterThanEq | RangeDoubleGt GreaterThan | RangeDoubleGtLt GreaterThan LessThan | RangeDoubleGteLte GreaterThanEq LessThanEq | RangeDoubleGteLt GreaterThanEq LessThan | RangeDoubleGtLte GreaterThan LessThanEq deriving (Eq, Show) rangeValueToPair :: RangeValue -> [Pair] rangeValueToPair rv = case rv of RangeDateLte (LessThanEqD t) -> ["lte" .= t] RangeDateGte (GreaterThanEqD t) -> ["gte" .= t] RangeDateLt (LessThanD t) -> ["lt" .= t] RangeDateGt (GreaterThanD t) -> ["gt" .= t] RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g] RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g] RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g] RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g] RangeDoubleLte (LessThanEq t) -> ["lte" .= t] RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t] RangeDoubleLt (LessThan t) -> ["lt" .= t] RangeDoubleGt (GreaterThan t) -> ["gt" .= t] RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g] RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g] RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g] RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g] data Term = Term { termField :: Text , termValue :: Text } deriving (Eq, Show) data BoolMatch = MustMatch Term Cache | MustNotMatch Term Cache | ShouldMatch [Term] Cache deriving (Eq, Show) -- "memory" or "indexed" data GeoFilterType = GeoFilterMemory | GeoFilterIndexed deriving (Eq, Show) data LatLon = LatLon { lat :: Double , lon :: Double } deriving (Eq, Show) data GeoBoundingBox = GeoBoundingBox { topLeft :: LatLon , bottomRight :: LatLon } deriving (Eq, Show) data GeoBoundingBoxConstraint = GeoBoundingBoxConstraint { geoBBField :: FieldName , constraintBox :: GeoBoundingBox , bbConstraintcache :: Cache , geoType :: GeoFilterType } deriving (Eq, Show) data GeoPoint = GeoPoint { geoField :: FieldName , latLon :: LatLon} deriving (Eq, Show) data DistanceUnit = Miles | Yards | Feet | Inches | Kilometers | Meters | Centimeters | Millimeters | NauticalMiles deriving (Eq, Show) data DistanceType = Arc | SloppyArc -- doesn't exist <1.0 | Plane deriving (Eq, Show) data OptimizeBbox = OptimizeGeoFilterType GeoFilterType | NoOptimizeBbox deriving (Eq, Show) data Distance = Distance { coefficient :: Double , unit :: DistanceUnit } deriving (Eq, Show) data DistanceRange = DistanceRange { distanceFrom :: Distance , distanceTo :: Distance } deriving (Eq, Show) data SearchResult a = SearchResult { took :: Int , timedOut :: Bool , shards :: ShardResult , searchHits :: SearchHits a , aggregations :: Maybe AggregationResults } deriving (Eq, Show) type Score = Maybe Double data SearchHits a = SearchHits { hitsTotal :: Int , maxScore :: Score , hits :: [Hit a] } deriving (Eq, Show) instance Monoid (SearchHits a) where mempty = SearchHits 0 Nothing mempty mappend (SearchHits ta ma ha) (SearchHits tb mb hb) = SearchHits (ta + tb) (max ma mb) (ha <> hb) data Hit a = Hit { hitIndex :: IndexName , hitType :: MappingName , hitDocId :: DocId , hitScore :: Score , hitSource :: a , hitHighlight :: Maybe HitHighlight } deriving (Eq, Show) data ShardResult = ShardResult { shardTotal :: Int , shardsSuccessful :: Int , shardsFailed :: Int } deriving (Eq, Show, Generic) type HitHighlight = M.Map Text [Text] showText :: Show a => a -> Text showText = T.pack . show type Aggregations = M.Map Text Aggregation emptyAggregations :: Aggregations emptyAggregations = M.empty mkAggregations :: Text -> Aggregation -> Aggregations mkAggregations name aggregation = M.insert name aggregation emptyAggregations data TermOrder = TermOrder{ termSortField :: Text , termSortOrder :: SortOrder } deriving (Eq, Show) data TermInclusion = TermInclusion Text | TermPattern Text Text deriving (Eq, Show) data CollectionMode = BreadthFirst | DepthFirst deriving (Eq, Show) data ExecutionHint = Ordinals | GlobalOrdinals | GlobalOrdinalsHash | GlobalOrdinalsLowCardinality | Map deriving (Eq, Show) data TimeInterval = Weeks | Days | Hours | Minutes | Seconds deriving (Eq) data Interval = Year | Quarter | Month | Week | Day | Hour | Minute | Second | FractionalInterval Float TimeInterval deriving (Eq, Show) data Aggregation = TermsAgg TermsAggregation | DateHistogramAgg DateHistogramAggregation deriving (Eq, Show) data TermsAggregation = TermsAggregation { term :: Either Text Text , termInclude :: Maybe TermInclusion , termExclude :: Maybe TermInclusion , termOrder :: Maybe TermOrder , termMinDocCount :: Maybe Int , termSize :: Maybe Int , termShardSize :: Maybe Int , termCollectMode :: Maybe CollectionMode , termExecutionHint :: Maybe ExecutionHint , termAggs :: Maybe Aggregations } deriving (Eq, Show) data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName , dateInterval :: Interval , dateFormat :: Maybe Text , datePreZone :: Maybe Text , datePostZone :: Maybe Text , datePreOffset :: Maybe Text , datePostOffset :: Maybe Text , dateAggs :: Maybe Aggregations } deriving (Eq, Show) mkTermsAggregation :: Text -> TermsAggregation mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing mkTermsScriptAggregation :: Text -> TermsAggregation mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing instance ToJSON TermOrder where toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder] instance ToJSON TermInclusion where toJSON (TermInclusion x) = toJSON x toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern, "flags" .= flags] instance ToJSON CollectionMode where toJSON BreadthFirst = "breadth_first" toJSON DepthFirst = "depth_first" instance ToJSON ExecutionHint where toJSON Ordinals = "ordinals" toJSON GlobalOrdinals = "global_ordinals" toJSON GlobalOrdinalsHash = "global_ordinals_hash" toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality" toJSON Map = "map" instance ToJSON Interval where toJSON Year = "year" toJSON Quarter = "quarter" toJSON Month = "month" toJSON Week = "week" toJSON Day = "day" toJSON Hour = "hour" toJSON Minute = "minute" toJSON Second = "second" toJSON (FractionalInterval fraction interval) = toJSON $ show fraction ++ show interval instance Show TimeInterval where show Weeks = "w" show Days = "d" show Hours = "h" show Minutes = "m" show Seconds = "s" instance ToJSON Aggregation where toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) = omitNulls ["terms" .= omitNulls [ toJSON' term, "include" .= include, "exclude" .= exclude, "order" .= order, "min_doc_count" .= minDocCount, "size" .= size, "shard_size" .= shardSize, "collect_mode" .= collectMode, "execution_hint" .= executionHint ], "aggs" .= termAggs ] where toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y } toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) = omitNulls ["date_histogram" .= omitNulls [ "field" .= field, "interval" .= interval, "format" .= format, "pre_zone" .= preZone, "post_zone" .= postZone, "pre_offset" .= preOffset, "post_offset" .= postOffset ], "aggs" .= dateHistoAggs ] type AggregationResults = M.Map Text Value class BucketAggregation a where key :: a -> Text docCount :: a -> Int aggs :: a -> Maybe AggregationResults data Bucket a = Bucket { buckets :: [a]} deriving (Show) data TermsResult = TermsResult { termKey :: Text , termsDocCount :: Int , termsAggs :: Maybe AggregationResults } deriving (Show) data DateHistogramResult = DateHistogramResult { dateKey :: Int , dateKeyStr :: Maybe Text , dateDocCount :: Int , dateHistogramAggs :: Maybe AggregationResults } deriving (Show) toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult) toTerms t a = M.lookup t a >>= deserialize where deserialize = parseMaybe parseJSON toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult) toDateHistogram t a = M.lookup t a >>= deserialize where deserialize = parseMaybe parseJSON instance BucketAggregation TermsResult where key = termKey docCount = termsDocCount aggs = termsAggs instance BucketAggregation DateHistogramResult where key = showText . dateKey docCount = dateDocCount aggs = dateHistogramAggs instance (FromJSON a, BucketAggregation a) => FromJSON (Bucket a) where parseJSON (Object v) = Bucket <$> v .: "buckets" parseJSON _ = mempty instance FromJSON TermsResult where parseJSON (Object v) = TermsResult <$> v .: "key" <*> v .: "doc_count" <*> v .:? "aggregations" parseJSON _ = mempty instance FromJSON DateHistogramResult where parseJSON (Object v) = DateHistogramResult <$> v .: "key" <*> v .:? "key_as_string" <*> v .: "doc_count" <*> v .:? "aggregations" parseJSON _ = mempty instance Monoid Filter where mempty = IdentityFilter mappend a b = AndFilter [a, b] defaultCache instance Seminearring Filter where a <||> b = OrFilter [a, b] defaultCache instance ToJSON Filter where toJSON (AndFilter filters cache) = object ["and" .= object [ "filters" .= fmap toJSON filters , "_cache" .= cache]] toJSON (OrFilter filters cache) = object ["or" .= object [ "filters" .= fmap toJSON filters , "_cache" .= cache]] toJSON (NotFilter notFilter cache) = object ["not" .= object ["filter" .= notFilter , "_cache" .= cache]] toJSON (IdentityFilter) = object ["match_all" .= object []] toJSON (TermFilter (Term termFilterField termFilterValue) cache) = object ["term" .= object base] where base = [termFilterField .= termFilterValue, "_cache" .= cache] toJSON (ExistsFilter (FieldName fieldName)) = object ["exists" .= object ["field" .= fieldName]] toJSON (BoolFilter boolMatch) = object ["bool" .= boolMatch] toJSON (GeoBoundingBoxFilter bbConstraint) = object ["geo_bounding_box" .= bbConstraint] toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon) distance distanceType optimizeBbox cache) = object ["geo_distance" .= object ["distance" .= distance , "distance_type" .= distanceType , "optimize_bbox" .= optimizeBbox , distanceGeoField .= geoDistLatLon , "_cache" .= cache]] toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon) (DistanceRange geoDistRangeDistFrom drDistanceTo)) = object ["geo_distance_range" .= object ["from" .= geoDistRangeDistFrom , "to" .= drDistanceTo , gddrField .= drLatLon]] toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) = object ["geo_polygon" .= object [geoPolygonFilterField .= object ["points" .= fmap toJSON latLons]]] toJSON (IdsFilter (MappingName mappingName) values) = object ["ids" .= object ["type" .= mappingName , "values" .= fmap unpackId values]] toJSON (LimitFilter limit) = object ["limit" .= object ["value" .= limit]] toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) = object ["missing" .= object ["field" .= fieldName , "existence" .= existence , "null_value" .= nullValue]] toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) = object ["prefix" .= object [fieldName .= fieldValue , "_cache" .= cache]] toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) = object ["range" .= object [ fieldName .= object (rangeValueToPair rangeValue) , "execution" .= rangeExecution , "_cache" .= cache]] toJSON (RegexpFilter (FieldName fieldName) (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) = object ["regexp" .= object [fieldName .= object ["value" .= regexText , "flags" .= flags] , "_name" .= cacheName , "_cache" .= cache , "_cache_key" .= cacheKey]] instance ToJSON GeoPoint where toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) = object [ geoPointField .= geoPointLatLon ] instance ToJSON Query where toJSON (TermQuery (Term termQueryField termQueryValue) boost) = object [ "term" .= object [termQueryField .= object merged]] where base = [ "value" .= termQueryValue ] boosted = maybe [] (return . ("boost" .=)) boost merged = mappend base boosted toJSON (TermsQuery terms) = object [ "terms" .= object conjoined ] where conjoined = [ getTermsField terms .= fmap (toJSON . getTermValue) (toList terms)] getTermsField ((Term f _ ) :| _) = f getTermValue (Term _ v) = v toJSON (IdsQuery idsQueryMappingName docIds) = object [ "ids" .= object conjoined ] where conjoined = [ "type" .= idsQueryMappingName , "values" .= fmap toJSON docIds ] toJSON (QueryQueryStringQuery qQueryStringQuery) = object [ "query_string" .= qQueryStringQuery ] toJSON (QueryMatchQuery matchQuery) = object [ "match" .= matchQuery ] toJSON (QueryMultiMatchQuery multiMatchQuery) = toJSON multiMatchQuery toJSON (QueryBoolQuery boolQuery) = object [ "bool" .= boolQuery ] toJSON (QueryBoostingQuery boostingQuery) = object [ "boosting" .= boostingQuery ] toJSON (QueryCommonTermsQuery commonTermsQuery) = object [ "common" .= commonTermsQuery ] toJSON (ConstantScoreFilter csFilter boost) = object [ "constant_score" .= csFilter , "boost" .= boost] toJSON (ConstantScoreQuery query boost) = object [ "constant_score" .= query , "boost" .= boost] toJSON (QueryDisMaxQuery disMaxQuery) = object [ "dis_max" .= disMaxQuery ] toJSON (QueryFilteredQuery qFilteredQuery) = object [ "filtered" .= qFilteredQuery ] toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) = object [ "fuzzy_like_this" .= fuzzyQuery ] toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) = object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ] toJSON (QueryFuzzyQuery fuzzyQuery) = object [ "fuzzy" .= fuzzyQuery ] toJSON (QueryHasChildQuery childQuery) = object [ "has_child" .= childQuery ] toJSON (QueryHasParentQuery parentQuery) = object [ "has_parent" .= parentQuery ] toJSON (QueryIndicesQuery qIndicesQuery) = object [ "indices" .= qIndicesQuery ] toJSON (MatchAllQuery boost) = object [ "match_all" .= omitNulls [ "boost" .= boost ] ] toJSON (QueryMoreLikeThisQuery query) = object [ "more_like_this" .= query ] toJSON (QueryMoreLikeThisFieldQuery query) = object [ "more_like_this_field" .= query ] toJSON (QueryNestedQuery query) = object [ "nested" .= query ] toJSON (QueryPrefixQuery query) = object [ "prefix" .= query ] toJSON (QueryRangeQuery query) = object [ "range" .= query ] toJSON (QueryRegexpQuery query) = object [ "regexp" .= query ] toJSON (QuerySimpleQueryStringQuery query) = object [ "simple_query_string" .= query ] omitNulls :: [(Text, Value)] -> Value omitNulls = object . filter notNull where notNull (_, Null) = False notNull (_, Array a) = (not . V.null) a notNull _ = True instance ToJSON SimpleQueryStringQuery where toJSON SimpleQueryStringQuery {..} = omitNulls (base ++ maybeAdd) where base = [ "query" .= simpleQueryStringQuery ] maybeAdd = [ "fields" .= simpleQueryStringField , "default_operator" .= simpleQueryStringOperator , "analyzer" .= simpleQueryStringAnalyzer , "flags" .= simpleQueryStringFlags , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded , "locale" .= simpleQueryStringLocale ] instance ToJSON FieldOrFields where toJSON (FofField fieldName) = toJSON fieldName toJSON (FofFields fieldNames) = toJSON fieldNames instance ToJSON SimpleQueryFlag where toJSON SimpleQueryAll = "ALL" toJSON SimpleQueryNone = "NONE" toJSON SimpleQueryAnd = "AND" toJSON SimpleQueryOr = "OR" toJSON SimpleQueryPrefix = "PREFIX" toJSON SimpleQueryPhrase = "PHRASE" toJSON SimpleQueryPrecedence = "PRECEDENCE" toJSON SimpleQueryEscape = "ESCAPE" toJSON SimpleQueryWhitespace = "WHITESPACE" toJSON SimpleQueryFuzzy = "FUZZY" toJSON SimpleQueryNear = "NEAR" toJSON SimpleQuerySlop = "SLOP" instance ToJSON RegexpQuery where toJSON (RegexpQuery (FieldName rqQueryField) (Regexp regexpQueryQuery) rqQueryFlags rqQueryBoost) = object [ rqQueryField .= omitNulls base ] where base = [ "value" .= regexpQueryQuery , "flags" .= rqQueryFlags , "boost" .= rqQueryBoost ] instance ToJSON QueryStringQuery where toJSON (QueryStringQuery qsQueryString qsDefaultField qsOperator qsAnalyzer qsAllowWildcard qsLowercaseExpanded qsEnablePositionIncrements qsFuzzyMaxExpansions qsFuzziness qsFuzzyPrefixLength qsPhraseSlop qsBoost qsAnalyzeWildcard qsGeneratePhraseQueries qsMinimumShouldMatch qsLenient qsLocale) = omitNulls base where base = [ "query" .= qsQueryString , "default_field" .= qsDefaultField , "default_operator" .= qsOperator , "analyzer" .= qsAnalyzer , "allow_leading_wildcard" .= qsAllowWildcard , "lowercase_expanded_terms" .= qsLowercaseExpanded , "enable_position_increments" .= qsEnablePositionIncrements , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions , "fuzziness" .= qsFuzziness , "fuzzy_prefix_length" .= qsFuzzyPrefixLength , "phrase_slop" .= qsPhraseSlop , "boost" .= qsBoost , "analyze_wildcard" .= qsAnalyzeWildcard , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries , "minimum_should_match" .= qsMinimumShouldMatch , "lenient" .= qsLenient , "locale" .= qsLocale ] instance ToJSON RangeQuery where toJSON (RangeQuery (FieldName fieldName) range boost) = object [ fieldName .= conjoined ] where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range) instance ToJSON PrefixQuery where toJSON (PrefixQuery (FieldName fieldName) queryValue boost) = object [ fieldName .= omitNulls base ] where base = [ "value" .= queryValue , "boost" .= boost ] instance ToJSON NestedQuery where toJSON (NestedQuery nqPath nqScoreType nqQuery) = object [ "path" .= nqPath , "score_mode" .= nqScoreType , "query" .= nqQuery ] instance ToJSON MoreLikeThisFieldQuery where toJSON (MoreLikeThisFieldQuery text (FieldName fieldName) percent mtf mqt stopwords mindf maxdf minwl maxwl boostTerms boost analyzer) = object [ fieldName .= omitNulls base ] where base = [ "like_text" .= text , "percent_terms_to_match" .= percent , "min_term_freq" .= mtf , "max_query_terms" .= mqt , "stop_words" .= stopwords , "min_doc_freq" .= mindf , "max_doc_freq" .= maxdf , "min_word_length" .= minwl , "max_word_length" .= maxwl , "boost_terms" .= boostTerms , "boost" .= boost , "analyzer" .= analyzer ] instance ToJSON MoreLikeThisQuery where toJSON (MoreLikeThisQuery text fields percent mtf mqt stopwords mindf maxdf minwl maxwl boostTerms boost analyzer) = omitNulls base where base = [ "like_text" .= text , "fields" .= fields , "percent_terms_to_match" .= percent , "min_term_freq" .= mtf , "max_query_terms" .= mqt , "stop_words" .= stopwords , "min_doc_freq" .= mindf , "max_doc_freq" .= maxdf , "min_word_length" .= minwl , "max_word_length" .= maxwl , "boost_terms" .= boostTerms , "boost" .= boost , "analyzer" .= analyzer ] instance ToJSON IndicesQuery where toJSON (IndicesQuery indices query noMatch) = omitNulls [ "indices" .= indices , "no_match_query" .= noMatch , "query" .= query ] instance ToJSON HasParentQuery where toJSON (HasParentQuery queryType query scoreType) = omitNulls [ "parent_type" .= queryType , "score_type" .= scoreType , "query" .= query ] instance ToJSON HasChildQuery where toJSON (HasChildQuery queryType query scoreType) = omitNulls [ "query" .= query , "score_type" .= scoreType , "type" .= queryType ] instance ToJSON FuzzyQuery where toJSON (FuzzyQuery (FieldName fieldName) queryText prefixLength maxEx fuzziness boost) = object [ fieldName .= omitNulls base ] where base = [ "value" .= queryText , "fuzziness" .= fuzziness , "prefix_length" .= prefixLength , "boost" .= boost , "max_expansions" .= maxEx ] instance ToJSON FuzzyLikeFieldQuery where toJSON (FuzzyLikeFieldQuery (FieldName fieldName) fieldText maxTerms ignoreFreq fuzziness prefixLength boost analyzer) = object [ fieldName .= omitNulls [ "like_text" .= fieldText , "max_query_terms" .= maxTerms , "ignore_tf" .= ignoreFreq , "fuzziness" .= fuzziness , "prefix_length" .= prefixLength , "analyzer" .= analyzer , "boost" .= boost ]] instance ToJSON FuzzyLikeThisQuery where toJSON (FuzzyLikeThisQuery fields text maxTerms ignoreFreq fuzziness prefixLength boost analyzer) = omitNulls base where base = [ "fields" .= fields , "like_text" .= text , "max_query_terms" .= maxTerms , "ignore_tf" .= ignoreFreq , "fuzziness" .= fuzziness , "prefix_length" .= prefixLength , "analyzer" .= analyzer , "boost" .= boost ] instance ToJSON FilteredQuery where toJSON (FilteredQuery query fFilter) = object [ "query" .= query , "filter" .= fFilter ] instance ToJSON DisMaxQuery where toJSON (DisMaxQuery queries tiebreaker boost) = omitNulls base where base = [ "queries" .= queries , "boost" .= boost , "tie_breaker" .= tiebreaker ] instance ToJSON CommonTermsQuery where toJSON (CommonTermsQuery (FieldName fieldName) (QueryString query) cf lfo hfo msm boost analyzer disableCoord) = object [fieldName .= omitNulls base ] where base = [ "query" .= query , "cutoff_frequency" .= cf , "low_freq_operator" .= lfo , "minimum_should_match" .= msm , "boost" .= boost , "analyzer" .= analyzer , "disable_coord" .= disableCoord , "high_freq_operator" .= hfo ] instance ToJSON CommonMinimumMatch where toJSON (CommonMinimumMatch mm) = toJSON mm toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) = object [ "low_freq" .= lowF , "high_freq" .= highF ] instance ToJSON BoostingQuery where toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) = object [ "positive" .= bqPositiveQuery , "negative" .= bqNegativeQuery , "negative_boost" .= bqNegativeBoost ] instance ToJSON BoolQuery where toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) = omitNulls base where base = [ "must" .= mustM , "must_not" .= notM , "should" .= shouldM , "minimum_should_match" .= bqMin , "boost" .= boost , "disable_coord" .= disableCoord ] instance ToJSON MatchQuery where toJSON (MatchQuery (FieldName fieldName) (QueryString mqQueryString) booleanOperator zeroTermsQuery cutoffFrequency matchQueryType analyzer maxExpansions lenient) = object [ fieldName .= omitNulls base ] where base = [ "query" .= mqQueryString , "operator" .= booleanOperator , "zero_terms_query" .= zeroTermsQuery , "cutoff_frequency" .= cutoffFrequency , "type" .= matchQueryType , "analyzer" .= analyzer , "max_expansions" .= maxExpansions , "lenient" .= lenient ] instance ToJSON MultiMatchQuery where toJSON (MultiMatchQuery fields (QueryString query) boolOp ztQ tb mmqt cf analyzer maxEx lenient) = object ["multi_match" .= omitNulls base] where base = [ "fields" .= fmap toJSON fields , "query" .= query , "operator" .= boolOp , "zero_terms_query" .= ztQ , "tiebreaker" .= tb , "type" .= mmqt , "cutoff_frequency" .= cf , "analyzer" .= analyzer , "max_expansions" .= maxEx , "lenient" .= lenient ] instance ToJSON MultiMatchQueryType where toJSON MultiMatchBestFields = "best_fields" toJSON MultiMatchMostFields = "most_fields" toJSON MultiMatchCrossFields = "cross_fields" toJSON MultiMatchPhrase = "phrase" toJSON MultiMatchPhrasePrefix = "phrase_prefix" instance ToJSON BooleanOperator where toJSON And = String "and" toJSON Or = String "or" instance ToJSON ZeroTermsQuery where toJSON ZeroTermsNone = String "none" toJSON ZeroTermsAll = String "all" instance ToJSON MatchQueryType where toJSON MatchPhrase = "phrase" toJSON MatchPhrasePrefix = "phrase_prefix" instance ToJSON FieldName where toJSON (FieldName fieldName) = String fieldName instance ToJSON ReplicaCount instance ToJSON ShardCount instance ToJSON CutoffFrequency instance ToJSON Analyzer instance ToJSON MaxExpansions instance ToJSON Lenient instance ToJSON Boost instance ToJSON Version instance ToJSON Tiebreaker instance ToJSON MinimumMatch instance ToJSON DisableCoord instance ToJSON PrefixLength instance ToJSON Fuzziness instance ToJSON IgnoreTermFrequency instance ToJSON MaxQueryTerms instance ToJSON TypeName instance ToJSON IndexName instance ToJSON BoostTerms instance ToJSON MaxWordLength instance ToJSON MinWordLength instance ToJSON MaxDocFrequency instance ToJSON MinDocFrequency instance ToJSON PhraseSlop instance ToJSON StopWord instance ToJSON QueryPath instance ToJSON MinimumTermFrequency instance ToJSON PercentMatch instance ToJSON MappingName instance ToJSON DocId instance ToJSON QueryString instance ToJSON AllowLeadingWildcard instance ToJSON LowercaseExpanded instance ToJSON AnalyzeWildcard instance ToJSON GeneratePhraseQueries instance ToJSON Locale instance ToJSON EnablePositionIncrements instance FromJSON Version instance FromJSON IndexName instance FromJSON MappingName instance FromJSON DocId instance FromJSON Status where parseJSON (Object v) = Status <$> v .:? "ok" <*> v .: "status" <*> v .: "name" <*> v .: "version" <*> v .: "tagline" parseJSON _ = empty instance ToJSON IndexSettings where toJSON (IndexSettings s r) = object ["settings" .= object ["shards" .= s, "replicas" .= r]] instance (FromJSON a) => FromJSON (EsResult a) where parseJSON (Object v) = EsResult <$> v .: "_index" <*> v .: "_type" <*> v .: "_id" <*> v .: "_version" <*> v .:? "found" <*> v .: "_source" parseJSON _ = empty instance ToJSON Search where toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize) = omitNulls [ "query" .= query , "filter" .= sFilter , "sort" .= sort , "aggregations" .= searchAggs , "highlight" .= highlight , "from" .= sFrom , "size" .= sSize , "track_scores" .= sTrackSortScores] instance ToJSON FieldHighlight where toJSON (FieldHighlight (FieldName fName) (Just fSettings)) = object [ fName .= fSettings ] toJSON (FieldHighlight (FieldName fName) Nothing) = object [ fName .= emptyObject ] instance ToJSON Highlights where toJSON (Highlights global fields) = omitNulls (("fields" .= fields) : highlightSettingsPairs global) instance ToJSON HighlightSettings where toJSON hs = omitNulls (highlightSettingsPairs (Just hs)) highlightSettingsPairs :: Maybe HighlightSettings -> [Pair] highlightSettingsPairs Nothing = [] highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh) highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph) highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh) plainHighPairs :: Maybe PlainHighlight -> [Pair] plainHighPairs Nothing = [] plainHighPairs (Just (PlainHighlight plCom plNonPost)) = [ "type" .= String "plain"] ++ commonHighlightPairs plCom ++ nonPostingsToPairs plNonPost postHighPairs :: Maybe PostingsHighlight -> [Pair] postHighPairs Nothing = [] postHighPairs (Just (PostingsHighlight pCom)) = ("type" .= String "postings") : commonHighlightPairs pCom fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair] fastVectorHighPairs Nothing = [] fastVectorHighPairs (Just (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars fvBoundMaxScan fvFragOff fvMatchedFields fvPhraseLim)) = [ "type" .= String "fvh" , "boundary_chars" .= fvBoundChars , "boundary_max_scan" .= fvBoundMaxScan , "fragment_offset" .= fvFragOff , "matched_fields" .= fvMatchedFields , "phraseLimit" .= fvPhraseLim] ++ commonHighlightPairs fvCom ++ nonPostingsToPairs fvNonPostSettings commonHighlightPairs :: Maybe CommonHighlight -> [Pair] commonHighlightPairs Nothing = [] commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder chNoMatchSize chHighlightQuery chRequireFieldMatch)) = [ "order" .= chScore , "force_source" .= chForceSource , "encoder" .= chEncoder , "no_match_size" .= chNoMatchSize , "highlight_query" .= chHighlightQuery , "require_fieldMatch" .= chRequireFieldMatch] ++ highlightTagToPairs chTag nonPostingsToPairs :: Maybe NonPostings -> [Pair] nonPostingsToPairs Nothing = [] nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) = [ "fragment_size" .= npFragSize , "number_of_fragments" .= npNumOfFrags] instance ToJSON HighlightEncoder where toJSON DefaultEncoder = String "default" toJSON HTMLEncoder = String "html" highlightTagToPairs :: Maybe HighlightTag -> [Pair] highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"] highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre , "post_tags" .= post] highlightTagToPairs Nothing = [] instance ToJSON SortSpec where toJSON (DefaultSortSpec (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped dsSortMode dsMissingSort dsNestedFilter)) = object [dsSortFieldName .= omitNulls base] where base = [ "order" .= dsSortOrder , "ignore_unmapped" .= dsIgnoreUnmapped , "mode" .= dsSortMode , "missing" .= dsMissingSort , "nested_filter" .= dsNestedFilter ] toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) = object [ "unit" .= units , field .= gdsLatLon , "order" .= gdsSortOrder ] instance ToJSON SortOrder where toJSON Ascending = String "asc" toJSON Descending = String "desc" instance ToJSON SortMode where toJSON SortMin = String "min" toJSON SortMax = String "max" toJSON SortSum = String "sum" toJSON SortAvg = String "avg" instance ToJSON Missing where toJSON LastMissing = String "_last" toJSON FirstMissing = String "_first" toJSON (CustomMissing txt) = String txt instance ToJSON ScoreType where toJSON ScoreTypeMax = "max" toJSON ScoreTypeAvg = "avg" toJSON ScoreTypeSum = "sum" toJSON ScoreTypeNone = "none" instance ToJSON Distance where toJSON (Distance dCoefficient dUnit) = String boltedTogether where coefText = showText dCoefficient (String unitText) = toJSON dUnit boltedTogether = mappend coefText unitText instance ToJSON DistanceUnit where toJSON Miles = String "mi" toJSON Yards = String "yd" toJSON Feet = String "ft" toJSON Inches = String "in" toJSON Kilometers = String "km" toJSON Meters = String "m" toJSON Centimeters = String "cm" toJSON Millimeters = String "mm" toJSON NauticalMiles = String "nmi" instance ToJSON DistanceType where toJSON Arc = String "arc" toJSON SloppyArc = String "sloppy_arc" toJSON Plane = String "plane" instance ToJSON OptimizeBbox where toJSON NoOptimizeBbox = String "none" toJSON (OptimizeGeoFilterType gft) = toJSON gft instance ToJSON GeoBoundingBoxConstraint where toJSON (GeoBoundingBoxConstraint (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') = object [gbbcGeoBBField .= gbbcConstraintBox , "_cache" .= cache , "type" .= type'] instance ToJSON GeoFilterType where toJSON GeoFilterMemory = String "memory" toJSON GeoFilterIndexed = String "indexed" instance ToJSON GeoBoundingBox where toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) = object ["top_left" .= gbbTopLeft , "bottom_right" .= gbbBottomRight] instance ToJSON LatLon where toJSON (LatLon lLat lLon) = object ["lat" .= lLat , "lon" .= lLon] -- index for smaller ranges, fielddata for longer ranges instance ToJSON RangeExecution where toJSON RangeExecutionIndex = "index" toJSON RangeExecutionFielddata = "fielddata" instance ToJSON RegexpFlags where toJSON AllRegexpFlags = String "ALL" toJSON NoRegexpFlags = String "NONE" toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs where flagStrs = map flagStr . nub $ h:fs flagStr AnyString = "ANYSTRING" flagStr Automaton = "AUTOMATON" flagStr Complement = "COMPLEMENT" flagStr Empty = "EMPTY" flagStr Intersection = "INTERSECTION" flagStr Interval = "INTERVAL" instance ToJSON Term where toJSON (Term field value) = object ["term" .= object [field .= value]] instance ToJSON BoolMatch where toJSON (MustMatch term cache) = object ["must" .= term, "_cache" .= cache] toJSON (MustNotMatch term cache) = object ["must_not" .= term, "_cache" .= cache] toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms, "_cache" .= cache] instance (FromJSON a) => FromJSON (SearchResult a) where parseJSON (Object v) = SearchResult <$> v .: "took" <*> v .: "timed_out" <*> v .: "_shards" <*> v .: "hits" <*> v .:? "aggregations" parseJSON _ = empty instance (FromJSON a) => FromJSON (SearchHits a) where parseJSON (Object v) = SearchHits <$> v .: "total" <*> v .: "max_score" <*> v .: "hits" parseJSON _ = empty instance (FromJSON a) => FromJSON (Hit a) where parseJSON (Object v) = Hit <$> v .: "_index" <*> v .: "_type" <*> v .: "_id" <*> v .: "_score" <*> v .: "_source" <*> v .:? "highlight" parseJSON _ = empty instance FromJSON ShardResult where parseJSON (Object v) = ShardResult <$> v .: "total" <*> v .: "successful" <*> v .: "failed" parseJSON _ = empty