diff --git a/Database/Bloodhound.hs b/Database/Bloodhound.hs --- a/Database/Bloodhound.hs +++ b/Database/Bloodhound.hs @@ -1,7 +1,9 @@ module Database.Bloodhound ( module Database.Bloodhound.Client , module Database.Bloodhound.Types + , module Database.Bloodhound.Types.Instances ) where import Database.Bloodhound.Client import Database.Bloodhound.Types +import Database.Bloodhound.Types.Instances diff --git a/Database/Bloodhound/Client.hs b/Database/Bloodhound/Client.hs --- a/Database/Bloodhound/Client.hs +++ b/Database/Bloodhound/Client.hs @@ -1,6 +1,9 @@ module Database.Bloodhound.Client ( createIndex , deleteIndex + , indexExists + , openIndex + , closeIndex , createMapping , deleteMapping , indexDocument @@ -13,6 +16,10 @@ , refreshIndex , mkSearch , bulk + , pageSearch + , mkShardCount + , mkReplicaCount + , getStatus ) where @@ -22,13 +29,12 @@ import Data.List (foldl', intercalate, intersperse) import Data.Maybe (fromMaybe) import Data.Text (Text) -import Network.HTTP.Conduit +import Network.HTTP.Client import qualified Network.HTTP.Types.Method as NHTM import qualified Network.HTTP.Types.Status as NHTS -import Prelude hiding (head) +import Prelude hiding (head, filter) import Database.Bloodhound.Types -import Database.Bloodhound.Types.Class import Database.Bloodhound.Types.Instances -- find way to avoid destructuring Servers and Indexes? @@ -48,38 +54,42 @@ | n > 1000 = Nothing -- ... | otherwise = Just (ReplicaCount n) -responseIsError :: Reply -> Bool -responseIsError resp = NHTS.statusCode (responseStatus resp) > 299 - +emptyBody :: L.ByteString emptyBody = L.pack "" dispatch :: Method -> String -> Maybe L.ByteString -> IO Reply -dispatch method url body = do +dispatch dMethod url body = do initReq <- parseUrl url let reqBody = RequestBodyLBS $ fromMaybe emptyBody body - let req = initReq { method = method + let req = initReq { method = dMethod , requestBody = reqBody , checkStatus = \_ _ _ -> Nothing} - withManager $ httpLbs req + withManager defaultManagerSettings $ httpLbs req joinPath :: [String] -> String joinPath = intercalate "/" -delete = flip (dispatch NHTM.methodDelete) $ Nothing -get = flip (dispatch NHTM.methodGet) $ Nothing -head = flip (dispatch NHTM.methodHead) $ Nothing +-- Shortcut functions for HTTP methods +delete :: String -> IO Reply +delete = flip (dispatch NHTM.methodDelete) Nothing +get :: String -> IO Reply +get = flip (dispatch NHTM.methodGet) Nothing +head :: String -> IO Reply +head = flip (dispatch NHTM.methodHead) Nothing +put :: String -> Maybe L.ByteString -> IO Reply put = dispatch NHTM.methodPost +post :: String -> Maybe L.ByteString -> IO Reply post = dispatch NHTM.methodPost -- indexDocument s ix name doc = put (root s ix name doc) (Just encode doc) -- http://hackage.haskell.org/package/http-client-lens-0.1.0/docs/Network-HTTP-Client-Lens.html -- https://github.com/supki/libjenkins/blob/master/src/Jenkins/Rest/Internal.hs -getStatus :: Server -> IO (Maybe (Status Version)) +getStatus :: Server -> IO (Maybe Status) getStatus (Server server) = do request <- parseUrl $ joinPath [server] - response <- withManager $ httpLbs request + response <- withManager defaultManagerSettings $ httpLbs request return $ decode (responseBody response) createIndex :: Server -> IndexSettings -> IndexName -> IO Reply @@ -95,13 +105,14 @@ respIsTwoHunna :: Reply -> Bool respIsTwoHunna resp = NHTS.statusCode (responseStatus resp) == 200 +existentialQuery :: String -> IO (Reply, Bool) existentialQuery url = do reply <- head url return (reply, respIsTwoHunna reply) indexExists :: Server -> IndexName -> IO Bool indexExists (Server server) (IndexName indexName) = do - (reply, exists) <- existentialQuery url + (_, exists) <- existentialQuery url return exists where url = joinPath [server, indexName] @@ -110,6 +121,7 @@ post url Nothing where url = joinPath [server, indexName, "_refresh"] +stringifyOCIndex :: OpenCloseIndex -> String stringifyOCIndex oci = case oci of OpenIndex -> "_open" CloseIndex -> "_close" @@ -134,9 +146,9 @@ body = Just $ encode mapping deleteMapping :: Server -> IndexName -> MappingName -> IO Reply -deleteMapping (Server server) (IndexName indexName) (MappingName mappingName) = +deleteMapping (Server server) (IndexName indexName) + (MappingName mappingName) = delete $ joinPath [server, indexName, mappingName, "_mapping"] - indexDocument :: ToJSON doc => Server -> IndexName -> MappingName -> doc -> DocId -> IO Reply indexDocument (Server server) (IndexName indexName) @@ -163,14 +175,14 @@ collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n") mash :: Builder -> [L.ByteString] -> Builder -mash builder xs = foldl' (\b x -> mappend b (lazyByteString x)) builder xs +mash = foldl' (\b x -> mappend b (lazyByteString x)) mkMetadataValue :: Text -> String -> String -> String -> Value mkMetadataValue operation indexName mappingName docId = object [operation .= - object ["_index" .= indexName - , "_type" .= mappingName - , "_id" .= docId]] + object [ "_index" .= indexName + , "_type" .= mappingName + , "_id" .= docId]] getStreamChunk :: BulkOperation -> [L.ByteString] getStreamChunk (BulkIndex (IndexName indexName) @@ -200,14 +212,15 @@ getDocument :: Server -> IndexName -> MappingName -> DocId -> IO Reply -getDocument (Server server) (IndexName indexName) (MappingName mappingName) (DocId docId) = +getDocument (Server server) (IndexName indexName) + (MappingName mappingName) (DocId docId) = get $ joinPath [server, indexName, mappingName, docId] documentExists :: Server -> IndexName -> MappingName -> DocId -> IO Bool documentExists (Server server) (IndexName indexName) (MappingName mappingName) (DocId docId) = do - (reply, exists) <- existentialQuery url + (_, exists) <- existentialQuery url return exists where url = joinPath [server, indexName, mappingName, docId] @@ -215,20 +228,20 @@ dispatchSearch url search = post url (Just (encode search)) searchAll :: Server -> Search -> IO Reply -searchAll (Server server) search = dispatchSearch url search where +searchAll (Server server) = dispatchSearch url where url = joinPath [server, "_search"] searchByIndex :: Server -> IndexName -> Search -> IO Reply -searchByIndex (Server server) (IndexName indexName) search = dispatchSearch url search where +searchByIndex (Server server) (IndexName indexName) = dispatchSearch url where url = joinPath [server, indexName, "_search"] searchByType :: Server -> IndexName -> MappingName -> Search -> IO Reply searchByType (Server server) (IndexName indexName) - (MappingName mappingName) search = dispatchSearch url search where + (MappingName mappingName) = dispatchSearch url where url = joinPath [server, indexName, mappingName, "_search"] mkSearch :: Maybe Query -> Maybe Filter -> Search mkSearch query filter = Search query filter Nothing False 0 10 pageSearch :: Int -> Int -> Search -> Search -pageSearch from size search = search { from = from, size = size } +pageSearch pageFrom pageSize search = search { from = pageFrom, size = pageSize } diff --git a/Database/Bloodhound/Types.hs b/Database/Bloodhound/Types.hs --- a/Database/Bloodhound/Types.hs +++ b/Database/Bloodhound/Types.hs @@ -1,5 +1,13 @@ {-# LANGUAGE DeriveGeneric #-} +{-| Data types for describing actions and data structures performed to interact + with Elasticsearch. The two main buckets your queries against Elasticsearch + will fall into are 'Query's and 'Filter's. 'Filter's are more like + traditional database constraints and often have preferable performance + properties. 'Query's support human-written textual queries, such as fuzzy + queries. +-} + module Database.Bloodhound.Types ( defaultCache , defaultIndexSettings @@ -13,13 +21,15 @@ , mkMatchQuery , mkMultiMatchQuery , mkBoolQuery + , mkRangeQuery + , mkQueryStringQuery , Version(..) , Status(..) , Existence(..) , NullValue(..) , IndexSettings(..) , Server(..) - , Reply(..) + , Reply , EsResult(..) , Query(..) , Search(..) @@ -59,14 +69,14 @@ , BulkOperation(..) , ReplicaCount(..) , ShardCount(..) - , Sort(..) + , Sort , SortMode(..) , SortOrder(..) , SortSpec(..) , DefaultSort(..) , Missing(..) , OpenCloseIndex(..) - , Method(..) + , Method , Boost(..) , MatchQuery(..) , MultiMatchQuery(..) @@ -119,6 +129,17 @@ , QueryPath(..) , MinimumTermFrequency(..) , PercentMatch(..) + , FieldDefinition(..) + , MappingField(..) + , Mapping(..) + , AllowLeadingWildcard(..) + , LowercaseExpanded(..) + , GeneratePhraseQueries(..) + , Locale(..) + , AnalyzeWildcard(..) + , EnablePositionIncrements(..) + , SimpleQueryFlag(..) + , FieldOrFields(..) ) where import Data.Aeson @@ -128,33 +149,51 @@ import Data.Time.Clock (UTCTime) import Database.Bloodhound.Types.Class import GHC.Generics (Generic) -import Network.HTTP.Conduit +import Network.HTTP.Client import qualified Network.HTTP.Types.Method as NHTM + +{-| 'Version' is embedded in 'Status' -} data Version = Version { number :: Text , build_hash :: Text , build_timestamp :: UTCTime , build_snapshot :: Bool - , lucene_version :: Text } deriving (Show, Generic) + , lucene_version :: Text } deriving (Eq, Show, Generic) -data Status a = Status { ok :: Bool - , status :: Int - , name :: Text - , version :: a - , tagline :: Text } deriving (Eq, Show) +{-| '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 :: 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 = IndexSettings (ShardCount 3) (ReplicaCount 2) - -data Strategy = RoundRobinStrat | RandomStrat | HeadStrat deriving (Eq, Show) - +{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -} +defaultIndexSettings :: IndexSettings +defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2) -type Reply = Network.HTTP.Conduit.Response L.ByteString +{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.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 @@ -172,15 +211,27 @@ MappingField { mappingFieldName :: FieldName , fieldDefinition :: FieldDefinition } deriving (Eq, Show) -data Mapping = Mapping { typeName :: TypeName - , fields :: [MappingField] } deriving (Eq, Show) +{-| Support for type reification of 'Mapping's is currently incomplete, for + now the mapping API verbiage expects a 'ToJSON'able blob. +-} +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 @@ -188,11 +239,27 @@ , 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 @@ -202,71 +269,190 @@ , 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 sortOrder = DefaultSort fieldName sortOrder False Nothing Nothing Nothing +mkSort fieldName sOrder = DefaultSort fieldName sOrder False Nothing Nothing Nothing -type Cache = Bool -- caching on/off -defaultCache = False +{-| '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) -newtype ShardCount = ShardCount Int deriving (Eq, Show, Generic) -newtype ReplicaCount = ReplicaCount Int deriving (Eq, Show, Generic) -newtype Server = Server String deriving (Eq, Show) -newtype IndexName = IndexName String deriving (Eq, Generic, Show) -newtype MappingName = MappingName String deriving (Eq, Generic, Show) -newtype DocId = DocId String deriving (Eq, Generic, Show) -newtype QueryString = QueryString Text deriving (Eq, Show) -newtype FieldName = FieldName Text deriving (Eq, Show) -newtype CacheName = CacheName Text deriving (Eq, Show) -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) -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) -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) -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) -newtype AllowLeadingWildcard = AllowLeadingWildcard Bool deriving (Eq, Show) -newtype LowercaseExpanded = LowercaseExpanded Bool deriving (Eq, Show) -newtype EnablePositionIncrements = EnablePositionIncrements Bool deriving (Eq, Show) -newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Show) -newtype GeneratePhraseQueries = GeneratePhraseQueries Bool deriving (Eq, Show) -newtype Locale = Locale Text deriving (Eq, Show) -newtype MaxWordLength = MaxWordLength Int deriving (Eq, Show, Generic) -newtype MinWordLength = MinWordLength Int deriving (Eq, Show, Generic) -newtype PhraseSlop = PhraseSlop Int deriving (Eq, Show, Generic) -newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Show, Generic) -newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, Generic) +{-| '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 String deriving (Eq, Show) + +{-| 'IndexName' is used to describe which index to query/create/delete +-} +newtype IndexName = IndexName String deriving (Eq, Generic, Show) + +{-| 'MappingName' is part of mappings which are how ES describes and schematizes + the data in the indices. +-} +newtype MappingName = MappingName String 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 String 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 -> String unpackId (DocId docId) = docId @@ -282,201 +468,228 @@ , from :: From , size :: Size } deriving (Eq, Show) -data Query = TermQuery Term (Maybe Boost) - | TermsQuery [Term] MinimumMatch - | 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 Query = + TermQuery Term (Maybe Boost) + | TermsQuery [Term] MinimumMatch + | 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 - , regexpQueryCacheName :: CacheName - , regexpQueryCache :: Cache - , regexpQueryCacheKey :: CacheKey } deriving (Eq, Show) + , regexpQueryBoost :: Maybe Boost + } deriving (Eq, Show) data RangeQuery = RangeQuery { rangeQueryField :: FieldName , rangeQueryRange :: Either HalfRange Range , rangeQueryBoost :: Boost } deriving (Eq, Show) +mkRangeQuery :: FieldName -> Either HalfRange Range -> 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) + 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) +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 FieldOrFields - , 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) + 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) -data FieldOrFields = FofField FieldName +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) + PrefixQuery + { prefixQueryField :: FieldName + , prefixQueryPrefixValue :: Text + , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show) data NestedQuery = - NestedQuery { nestedQueryPath :: QueryPath - , nestedQueryScoreType :: ScoreType - , nestedQuery :: Query } deriving (Eq, Show) + 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) + 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) - + 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) + 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) + HasParentQuery + { hasParentQueryType :: TypeName + , hasParentQuery :: Query + , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Show) data HasChildQuery = - HasChildQuery { hasChildQueryType :: TypeName - , hasChildQuery :: Query - , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Show) + HasChildQuery + { hasChildQueryType :: TypeName + , hasChildQuery :: Query + , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Show) -data ScoreType = ScoreTypeMax - | ScoreTypeSum - | ScoreTypeAvg - | ScoreTypeNone 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 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) + 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) + 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) + 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 DisMaxQuery = + DisMaxQuery { disMaxQueries :: [Query] + -- default 0.0 + , disMaxTiebreaker :: Tiebreaker + , disMaxBoost :: Maybe Boost + } deriving (Eq, Show) + data MatchQuery = MatchQuery { matchQueryField :: FieldName , matchQueryQueryString :: QueryString @@ -488,11 +701,15 @@ , 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 MatchQueryType = + MatchPhrase + | MatchPhrasePrefix deriving (Eq, Show) data MultiMatchQuery = MultiMatchQuery { multiMatchQueryFields :: [FieldName] @@ -506,30 +723,40 @@ , 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 fields query = - MultiMatchQuery fields query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing +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 MultiMatchQueryType = + MultiMatchBestFields + | MultiMatchMostFields + | MultiMatchCrossFields + | MultiMatchPhrase + | MultiMatchPhrasePrefix deriving (Eq, Show) -data BoolQuery = BoolQuery { boolQueryMustMatch :: Maybe Query - , boolQueryMustNotMatch :: Maybe Query - , boolQueryShouldMatch :: Maybe [Query] - , boolQueryMinimumShouldMatch :: Maybe MinimumMatch - , boolQueryBoost :: Maybe Boost - , boolQueryDisableCoord :: Maybe DisableCoord - } deriving (Eq, Show) +data BoolQuery = + BoolQuery { boolQueryMustMatch :: Maybe Query + , boolQueryMustNotMatch :: Maybe Query + , boolQueryShouldMatch :: Maybe [Query] + , boolQueryMinimumShouldMatch :: Maybe MinimumMatch + , boolQueryBoost :: Maybe Boost + , boolQueryDisableCoord :: Maybe DisableCoord + } deriving (Eq, Show) mkBoolQuery :: Maybe Query -> Maybe Query -> Maybe [Query] -> BoolQuery -mkBoolQuery must mustNot should = BoolQuery must mustNot should Nothing Nothing Nothing +mkBoolQuery must mustNot should = + BoolQuery must mustNot should Nothing Nothing Nothing -data BoostingQuery = BoostingQuery { positiveQuery :: Query - , negativeQuery :: Query - , negativeBoost :: Boost } deriving (Eq, Show) +data BoostingQuery = + BoostingQuery { positiveQuery :: Query + , negativeQuery :: Query + , negativeBoost :: Boost } deriving (Eq, Show) data CommonTermsQuery = CommonTermsQuery { commonField :: FieldName @@ -543,8 +770,10 @@ , commonDisableCoord :: Maybe DisableCoord } deriving (Eq, Show) -data CommonMinimumMatch = CommonMinimumMatchHighLow MinimumMatchHighLow - | CommonMinimumMatch MinimumMatch deriving (Eq, Show) +data CommonMinimumMatch = + CommonMinimumMatchHighLow MinimumMatchHighLow + | CommonMinimumMatch MinimumMatch + deriving (Eq, Show) data MinimumMatchHighLow = MinimumMatchHighLow { lowFreq :: MinimumMatch @@ -552,7 +781,7 @@ data Filter = AndFilter [Filter] Cache | OrFilter [Filter] Cache - | NotFilter Filter Cache + | NotFilter Filter Cache | IdentityFilter | BoolFilter BoolMatch | ExistsFilter FieldName -- always cached @@ -568,7 +797,8 @@ | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey deriving (Eq, Show) -data ZeroTermsQuery = ZeroTermsNone | ZeroTermsAll deriving (Eq, Show) +data ZeroTermsQuery = ZeroTermsNone + | ZeroTermsAll deriving (Eq, Show) -- lt, lte | gt, gte newtype LessThan = LessThan Double deriving (Eq, Show) @@ -599,9 +829,9 @@ halfRangeToKV (HalfRangeGte (GreaterThanEq n)) = ("gte", n) rangeToKV :: Range -> (Text, Double, Text, Double) -rangeToKV (RangeLtGt (LessThan m) (GreaterThan n)) = ("lt", m, "gt", n) +rangeToKV (RangeLtGt (LessThan m) (GreaterThan n)) = ("lt", m, "gt", n) rangeToKV (RangeLtGte (LessThan m) (GreaterThanEq n)) = ("lt", m, "gte", n) -rangeToKV (RangeLteGt (LessThanEq m) (GreaterThan n)) = ("lte", m, "gt", n) +rangeToKV (RangeLteGt (LessThanEq m) (GreaterThan n)) = ("lte", m, "gt", n) rangeToKV (RangeLteGte (LessThanEq m) (GreaterThanEq n)) = ("lte", m, "gte", n) -- phew. Coulda used Agda style case breaking there but, you know, whatever. :) @@ -617,7 +847,6 @@ data GeoFilterType = GeoFilterMemory | GeoFilterIndexed deriving (Eq, Show) - data LatLon = LatLon { lat :: Double , lon :: Double } deriving (Eq, Show) @@ -689,8 +918,8 @@ maybeJson field (Just value) = [field .= toJSON value] maybeJson _ _ = [] --- maybeJsonF :: (ToJSON (f Value), ToJSON a, Functor f) => --- Text -> Maybe (f a) -> [(Text, Value)] +maybeJsonF :: (ToJSON (f Value), ToJSON a, Functor f) => + Text -> Maybe (f a) -> [(Text, Value)] maybeJsonF field (Just value) = [field .= fmap toJSON value] maybeJsonF _ _ = [] diff --git a/Database/Bloodhound/Types/Class.hs b/Database/Bloodhound/Types/Class.hs --- a/Database/Bloodhound/Types/Class.hs +++ b/Database/Bloodhound/Types/Class.hs @@ -2,7 +2,6 @@ ( Seminearring(..) ) where -import Data.Aeson import Data.Monoid class Monoid a => Seminearring a where diff --git a/Database/Bloodhound/Types/Instances.hs b/Database/Bloodhound/Types/Instances.hs --- a/Database/Bloodhound/Types/Instances.hs +++ b/Database/Bloodhound/Types/Instances.hs @@ -12,8 +12,8 @@ import Data.Monoid import qualified Data.Text as T import Database.Bloodhound.Types -import Database.Bloodhound.Types.Class -import Data.Scientific +import Database.Bloodhound.Types.Class () +import Prelude hiding (filter) instance Monoid Filter where mempty = IdentityFilter @@ -50,25 +50,25 @@ object ["geo_bounding_box" .= toJSON bbConstraint , "type" .= toJSON filterType] - toJSON (GeoDistanceFilter (GeoPoint (FieldName geoField) latLon) + toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon) distance distanceType optimizeBbox cache) = object ["geo_distance" .= object ["distance" .= toJSON distance , "distance_type" .= toJSON distanceType , "optimize_bbox" .= optimizeBbox - , geoField .= toJSON latLon + , distanceGeoField .= toJSON geoDistLatLon , "_cache" .= cache]] - toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName geoField) latLon) - (DistanceRange distanceFrom distanceTo)) = + toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon) + (DistanceRange geoDistRangeDistFrom drDistanceTo)) = object ["geo_distance_range" .= - object ["from" .= toJSON distanceFrom - , "to" .= toJSON distanceTo - , geoField .= toJSON latLon]] + object ["from" .= toJSON geoDistRangeDistFrom + , "to" .= toJSON drDistanceTo + , gddrField .= toJSON drLatLon]] - toJSON (GeoPolygonFilter (FieldName geoField) latLons) = + toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) = object ["geo_polygon" .= - object [geoField .= + object [geoPolygonFilterField .= object ["points" .= fmap toJSON latLons]]] toJSON (IdsFilter (MappingName mappingName) values) = @@ -120,19 +120,33 @@ , "_cache_key" .= cacheKey]] instance ToJSON GeoPoint where - toJSON (GeoPoint (FieldName geoField) latLon) = - object [ geoField .= toJSON latLon ] + toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) = + object [ geoPointField .= toJSON geoPointLatLon ] instance ToJSON Query where - toJSON (TermQuery (Term termField termValue) boost) = + toJSON (TermQuery (Term termQueryField termQueryValue) boost) = object [ "term" .= - object [termField .= object merged]] + object [termQueryField .= object merged]] where - base = [ "value" .= termValue ] + base = [ "value" .= termQueryValue ] boosted = maybe [] (return . ("boost" .=)) boost merged = mappend base boosted + toJSON (TermsQuery terms termsQueryMinimumMatch) = + object [ "terms" .= object conjoined ] + where conjoined = + [ "tags" .= fmap toJSON terms + , "minimum_should_match" .= toJSON termsQueryMinimumMatch ] + + toJSON (IdsQuery idsQueryMappingName docIds) = + object [ "ids" .= object conjoined ] + where conjoined = [ "type" .= toJSON idsQueryMappingName + , "values" .= fmap toJSON docIds ] + + toJSON (QueryQueryStringQuery qQueryStringQuery) = + object [ "query_string" .= toJSON qQueryStringQuery ] + toJSON (QueryMatchQuery matchQuery) = object [ "match" .= toJSON matchQuery ] @@ -159,8 +173,8 @@ toJSON (QueryDisMaxQuery disMaxQuery) = object [ "dis_max" .= toJSON disMaxQuery ] - toJSON (QueryFilteredQuery filteredQuery) = - object [ "filtered" .= toJSON filteredQuery ] + toJSON (QueryFilteredQuery qFilteredQuery) = + object [ "filtered" .= toJSON qFilteredQuery ] toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) = object [ "fuzzy_like_this" .= toJSON fuzzyQuery ] @@ -177,8 +191,8 @@ toJSON (QueryHasParentQuery parentQuery) = object [ "has_parent" .= toJSON parentQuery ] - toJSON (QueryIndicesQuery indicesQuery) = - object [ "indices" .= toJSON indicesQuery ] + toJSON (QueryIndicesQuery qIndicesQuery) = + object [ "indices" .= toJSON qIndicesQuery ] toJSON (MatchAllQuery boost) = object [ "match_all" .= object maybeAdd ] @@ -196,11 +210,110 @@ toJSON (QueryPrefixQuery query) = object [ "prefix" .= toJSON query ] + toJSON (QueryRangeQuery query) = + object [ "range" .= toJSON query ] + toJSON (QueryRegexpQuery query) = + object [ "regexp" .= toJSON query ] + + toJSON (QuerySimpleQueryStringQuery query) = + object [ "simple_query_string" .= toJSON query ] + + mField :: (ToJSON a, Functor f) => T.Text -> f a -> f (T.Text, Value) mField field = fmap ((field .=) . toJSON) +instance ToJSON SimpleQueryStringQuery where + toJSON (SimpleQueryStringQuery sqsQueryString + sqsFields sqsBoolean sqsAnalyzer + sqsFlags sqsLowercaseExpanded sqsLocale) = + object conjoined + where base = [ "query" .= toJSON sqsQueryString ] + maybeAdd = + catMaybes [ mField "fields" sqsFields + , mField "default_operator" sqsBoolean + , mField "analyzer" sqsAnalyzer + , mField "flags" sqsFlags + , mField "lowercase_expanded_terms" sqsLowercaseExpanded + , mField "locale" sqsLocale ] + conjoined = base ++ maybeAdd +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 .= object conjoined ] + where base = [ "value" .= regexpQueryQuery + , "flags" .= toJSON rqQueryFlags ] + maybeAdd = catMaybes [ mField "boost" rqQueryBoost ] + conjoined = base ++ maybeAdd + +instance ToJSON QueryStringQuery where + toJSON (QueryStringQuery qsQueryString + qsDefaultField qsOperator + qsAnalyzer qsAllowWildcard + qsLowercaseExpanded qsEnablePositionIncrements + qsFuzzyMaxExpansions qsFuzziness + qsFuzzyPrefixLength qsPhraseSlop + qsBoost qsAnalyzeWildcard + qsGeneratePhraseQueries qsMinimumShouldMatch + qsLenient qsLocale) = + object conjoined + where + base = [ "query" .= toJSON qsQueryString ] + maybeAdd = + catMaybes [ mField "default_field" qsDefaultField + , mField "default_operator" qsOperator + , mField "analyzer" qsAnalyzer + , mField "allow_leading_wildcard" qsAllowWildcard + , mField "lowercase_expanded_terms" qsLowercaseExpanded + , mField "enable_position_increments" qsEnablePositionIncrements + , mField "fuzzy_max_expansions" qsFuzzyMaxExpansions + , mField "fuzziness" qsFuzziness + , mField "fuzzy_prefix_length" qsFuzzyPrefixLength + , mField "phrase_slop" qsPhraseSlop + , mField "boost" qsBoost + , mField "analyze_wildcard" qsAnalyzeWildcard + , mField "auto_generate_phrase_queries" qsGeneratePhraseQueries + , mField "minimum_should_match" qsMinimumShouldMatch + , mField "lenient" qsLenient + , mField "locale" qsLocale ] + conjoined = base ++ maybeAdd + +instance ToJSON RangeQuery where + toJSON (RangeQuery (FieldName fieldName) (Right range) boost) = + object [ fieldName .= conjoined ] + where conjoined = [ "boost" .= toJSON boost + , lessKey .= lessVal + , greaterKey .= greaterVal ] + (lessKey, lessVal, greaterKey, greaterVal) = rangeToKV range + + toJSON (RangeQuery (FieldName fieldName) (Left halfRange) boost) = + object [ fieldName .= conjoined ] + where conjoined = [ "boost" .= toJSON boost + , key .= val ] + (key, val) = halfRangeToKV halfRange + instance ToJSON PrefixQuery where toJSON (PrefixQuery (FieldName fieldName) queryValue boost) = object [ fieldName .= object conjoined ] @@ -358,20 +471,20 @@ , "high_freq" .= toJSON highF ] instance ToJSON BoostingQuery where - toJSON (BoostingQuery positiveQuery negativeQuery negativeBoost) = - object [ "positive" .= toJSON positiveQuery - , "negative" .= toJSON negativeQuery - , "negative_boost" .= toJSON negativeBoost ] + toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) = + object [ "positive" .= toJSON bqPositiveQuery + , "negative" .= toJSON bqNegativeQuery + , "negative_boost" .= toJSON bqNegativeBoost ] instance ToJSON BoolQuery where - toJSON (BoolQuery mustM notM shouldM min boost disableCoord) = + toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) = object filtered where filtered = catMaybes [ mField "must" mustM , mField "must_not" notM , mField "should" shouldM - , mField "minimum_should_match" min + , mField "minimum_should_match" bqMin , mField "boost" boost , mField "disable_coord" disableCoord ] @@ -459,13 +572,22 @@ 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 a) => FromJSON (Status a) where +instance FromJSON Status where parseJSON (Object v) = Status <$> v .: "ok" <*> v .: "status" <*> @@ -491,14 +613,14 @@ instance ToJSON Search where - toJSON (Search query filter sort trackSortScores from size) = + toJSON (Search query filter sort sTrackSortScores sFrom sSize) = object merged where lQuery = maybeJson "query" query lFilter = maybeJson "filter" filter lSort = maybeJsonF "sort" sort - merged = mconcat [[ "from" .= from - , "size" .= size - , "track_scores" .= trackSortScores] + merged = mconcat [[ "from" .= sFrom + , "size" .= sSize + , "track_scores" .= sTrackSortScores] , lQuery , lFilter , lSort] @@ -506,20 +628,20 @@ instance ToJSON SortSpec where toJSON (DefaultSortSpec - (DefaultSort (FieldName sortFieldName) sortOrder ignoreUnmapped - sortMode missingSort nestedFilter)) = - object [sortFieldName .= object merged] where - base = ["order" .= toJSON sortOrder - , "ignore_unmapped" .= ignoreUnmapped] - lSortMode = maybeJson "mode" sortMode - lMissingSort = maybeJson "missing" missingSort - lNestedFilter = maybeJson "nested_filter" nestedFilter + (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped + dsSortMode dsMissingSort dsNestedFilter)) = + object [dsSortFieldName .= object merged] where + base = ["order" .= toJSON dsSortOrder + , "ignore_unmapped" .= dsIgnoreUnmapped] + lSortMode = maybeJson "mode" dsSortMode + lMissingSort = maybeJson "missing" dsMissingSort + lNestedFilter = maybeJson "nested_filter" dsNestedFilter merged = mconcat [base, lSortMode, lMissingSort, lNestedFilter] - toJSON (GeoDistanceSortSpec sortOrder (GeoPoint (FieldName field) latLon) units) = + toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) = object [ "unit" .= toJSON units - , field .= toJSON latLon - , "order" .= toJSON sortOrder ] + , field .= toJSON gdsLatLon + , "order" .= toJSON gdsSortOrder ] instance ToJSON SortOrder where @@ -548,10 +670,10 @@ instance ToJSON Distance where - toJSON (Distance coefficient unit) = + toJSON (Distance dCoefficient dUnit) = String boltedTogether where - coefText = showText coefficient - (String unitText) = (toJSON unit) + coefText = showText dCoefficient + (String unitText) = toJSON dUnit boltedTogether = mappend coefText unitText @@ -579,8 +701,9 @@ instance ToJSON GeoBoundingBoxConstraint where - toJSON (GeoBoundingBoxConstraint (FieldName geoBBField) constraintBox cache) = - object [geoBBField .= toJSON constraintBox + toJSON (GeoBoundingBoxConstraint + (FieldName gbbcGeoBBField) gbbcConstraintBox cache) = + object [gbbcGeoBBField .= toJSON gbbcConstraintBox , "_cache" .= cache] @@ -590,15 +713,15 @@ instance ToJSON GeoBoundingBox where - toJSON (GeoBoundingBox topLeft bottomRight) = - object ["top_left" .= toJSON topLeft - , "bottom_right" .= toJSON bottomRight] + toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) = + object ["top_left" .= toJSON gbbTopLeft + , "bottom_right" .= toJSON gbbBottomRight] instance ToJSON LatLon where - toJSON (LatLon lat lon) = - object ["lat" .= lat - , "lon" .= lon] + toJSON (LatLon lLat lLon) = + object ["lat" .= lLat + , "lon" .= lLon] -- index for smaller ranges, fielddata for longer ranges diff --git a/bloodhound.cabal b/bloodhound.cabal --- a/bloodhound.cabal +++ b/bloodhound.cabal @@ -1,11 +1,8 @@ --- Initial bloodhound.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - name: bloodhound -version: 0.1.0.1 +version: 0.1.0.2 synopsis: ElasticSearch client library for Haskell description: ElasticSearch made awesome for Haskell hackers -homepage: github.com/bitemyapp/bloodhound +homepage: https://github.com/bitemyapp/bloodhound license: Apache-2.0 license-file: LICENSE author: Chris Allen @@ -20,7 +17,7 @@ location: https://github.com/bitemyapp/bloodhound.git library - ghc-options: -Wall + ghc-options: -Wall -fno-warn-orphans default-extensions: OverloadedStrings exposed-modules: Database.Bloodhound Database.Bloodhound.Client @@ -30,15 +27,11 @@ build-depends: base >= 4.3 && <5, bytestring >= 0.10.2, aeson >= 0.7, - aeson-pretty >= 0.7, conduit >= 1.0, - http-conduit >= 2.0, + http-client >= 0.3, time >= 1.4, text >= 0.11, - http-types >= 0.8, - blaze-builder >= 0.3, - unix >= 2.6, - scientific + http-types >= 0.8 default-language: Haskell2010 test-suite tests @@ -46,19 +39,13 @@ default-extensions: OverloadedStrings type: exitcode-stdio-1.0 main-is: tests.hs - -- ghc-options: -w -threaded -rtsopts -with-rtsopts=-N hs-source-dirs: tests build-depends: base, bloodhound, - http-conduit, + http-client, http-types, - bytestring >= 0.10.2, hspec >= 1.8, - QuickCheck >= 2.5, text >= 0.11, time >= 1.4, - aeson >= 0.7, - aeson-pretty >= 0.7, - random >= 1.0, - quickcheck-instances >= 0.3 + aeson >= 0.7 default-language: Haskell2010 diff --git a/tests/tests.hs b/tests/tests.hs --- a/tests/tests.hs +++ b/tests/tests.hs @@ -4,13 +4,11 @@ import Database.Bloodhound import Data.Aeson --- import Data.Aeson.Encode.Pretty --- import Data.ByteString.Lazy.Char8 (putStrLn) import Data.Time.Calendar (Day(..)) import Data.Time.Clock (secondsToDiffTime, UTCTime(..)) import Data.Text (Text) import GHC.Generics (Generic) -import Network.HTTP.Conduit +import Network.HTTP.Client import qualified Network.HTTP.Types.Status as NHTS import Prelude hiding (filter, putStrLn) import Test.Hspec @@ -18,7 +16,7 @@ testServer :: Server testServer = Server "http://localhost:9200" testIndex :: IndexName -testIndex = IndexName "twitter" +testIndex = IndexName "bloodhound-tests-twitter-1" testMapping :: MappingName testMapping = MappingName "tweet" @@ -52,8 +50,8 @@ instance ToJSON TweetMapping where toJSON TweetMapping = object ["tweet" .= - object ["properties" .= - object ["location" .= object ["type" .= ("geo_point" :: Text)]]]] + object ["properties" .= + object ["location" .= object ["type" .= ("geo_point" :: Text)]]]] exampleTweet :: Tweet exampleTweet = Tweet { user = "bitemyapp" @@ -133,10 +131,10 @@ _ <- insertData let firstTest = BulkTest "blah" let secondTest = BulkTest "bloo" - let firstDoc = BulkIndex (IndexName "twitter") - (MappingName "tweet") (DocId "2") (object ["name" .= String "blah"]) - let secondDoc = BulkCreate (IndexName "twitter") - (MappingName "tweet") (DocId "3") (object ["name" .= String "bloo"]) + let firstDoc = BulkIndex testIndex + testMapping (DocId "2") (object ["name" .= String "blah"]) + let secondDoc = BulkCreate testIndex + testMapping (DocId "3") (object ["name" .= String "bloo"]) let stream = [firstDoc, secondDoc] _ <- bulk testServer stream _ <- refreshIndex testServer testIndex