bloodhound 0.1.0.1 → 0.1.0.2
raw patch · 7 files changed
+707/−356 lines, 7 filesdep +http-clientdep −QuickCheckdep −aeson-prettydep −blaze-builderdep ~aesondep ~bytestringdep ~timenew-uploader
Dependencies added: http-client
Dependencies removed: QuickCheck, aeson-pretty, blaze-builder, http-conduit, quickcheck-instances, random, scientific, unix
Dependency ranges changed: aeson, bytestring, time
Files
- Database/Bloodhound.hs +2/−0
- Database/Bloodhound/Client.hs +40/−27
- Database/Bloodhound/Types.hs +474/−245
- Database/Bloodhound/Types/Class.hs +0/−1
- Database/Bloodhound/Types/Instances.hs +176/−53
- bloodhound.cabal +7/−20
- tests/tests.hs +8/−10
Database/Bloodhound.hs view
@@ -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
Database/Bloodhound/Client.hs view
@@ -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 }
Database/Bloodhound/Types.hs view
@@ -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. + <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>+-}++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.++ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>+-}+ 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.++ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>+-} 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.++ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk>+-} 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.++<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>+-} 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.++<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>+-} 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.++<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>+-} 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.++<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>+-} 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 _ _ = []
Database/Bloodhound/Types/Class.hs view
@@ -2,7 +2,6 @@ ( Seminearring(..) ) where -import Data.Aeson import Data.Monoid class Monoid a => Seminearring a where
Database/Bloodhound/Types/Instances.hs view
@@ -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
bloodhound.cabal view
@@ -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
tests/tests.hs view
@@ -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