mirror of
https://github.com/typeable/bloodhound.git
synced 2025-01-07 07:07:04 +03:00
Chris Allen
commit
3939fc6ae1
@ -25,7 +25,7 @@ before_install:
|
||||
- sudo apt-get install cabal-install-1.20 ghc-$GHCVER
|
||||
- sudo apt-get install happy-1.19.3
|
||||
- export PATH=/opt/ghc/$GHCVER/bin:/opt/happy/1.19.3/bin:$PATH
|
||||
- wget https://download.elasticsearch.org/elasticsearch/elasticsearch/elasticsearch-$ESVER.deb
|
||||
- wget --no-check-certificate https://download.elasticsearch.org/elasticsearch/elasticsearch/elasticsearch-$ESVER.deb
|
||||
- sudo dpkg --force-all -i elasticsearch-$ESVER.deb
|
||||
- sudo service elasticsearch start
|
||||
|
||||
|
||||
54
README.md
54
README.md
@ -57,6 +57,7 @@ Index Operations
|
||||
|
||||
:set -XDeriveGeneric
|
||||
:{
|
||||
import Control.Applicative
|
||||
import Database.Bloodhound
|
||||
import Data.Aeson
|
||||
import Data.Either (Either(..))
|
||||
@ -72,14 +73,17 @@ import qualified Network.HTTP.Types.Status as NHTS
|
||||
let testServer = (Server "http://localhost:9200")
|
||||
let testIndex = IndexName "twitter"
|
||||
let testMapping = MappingName "tweet"
|
||||
let withBH' = withBH defaultManagerSettings testServer
|
||||
|
||||
-- defaultIndexSettings is exported by Database.Bloodhound as well
|
||||
let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
|
||||
|
||||
-- createIndex returns IO Reply
|
||||
-- createIndex returns MonadBH m => m Reply. You can use withBH for
|
||||
one-off commands or you can use runBH to group together commands
|
||||
and to pass in your own HTTP manager for pipelining.
|
||||
|
||||
-- response :: Reply, Reply is a synonym for Network.HTTP.Conduit.Response
|
||||
response <- createIndex testServer defaultIndexSettings testIndex
|
||||
response <- withBH' $ createIndex defaultIndexSettings testIndex
|
||||
:}
|
||||
|
||||
```
|
||||
@ -91,7 +95,7 @@ response <- createIndex testServer defaultIndexSettings testIndex
|
||||
``` {.haskell}
|
||||
|
||||
-- response :: Reply
|
||||
response <- deleteIndex testServer testIndex
|
||||
response <- withBH' $ deleteIndex testIndex
|
||||
|
||||
```
|
||||
|
||||
@ -125,7 +129,7 @@ Response {responseStatus = Status {statusCode = 404, statusMessage = "Not Found"
|
||||
|
||||
``` {.haskell}
|
||||
|
||||
resp <- refreshIndex testServer testIndex
|
||||
resp <- withBH' $ refreshIndex testIndex
|
||||
|
||||
```
|
||||
|
||||
@ -168,7 +172,7 @@ instance ToJSON TweetMapping where
|
||||
object ["type" .= ("geo_point" :: Text)]]]]
|
||||
:}
|
||||
|
||||
resp <- putMapping testServer testIndex testMapping TweetMapping
|
||||
resp <- withBH' $ putMapping testIndex testMapping TweetMapping
|
||||
|
||||
```
|
||||
|
||||
@ -176,7 +180,7 @@ resp <- putMapping testServer testIndex testMapping TweetMapping
|
||||
|
||||
``` {.haskell}
|
||||
|
||||
resp <- deleteMapping testServer testIndex testMapping
|
||||
resp <- withBH' $ deleteMapping testIndex testMapping
|
||||
|
||||
```
|
||||
|
||||
@ -221,7 +225,7 @@ instance FromJSON Location
|
||||
-- λ> encode $ Location 10.0 10.0
|
||||
-- "{\"lat\":10,\"lon\":10}"
|
||||
|
||||
resp <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
|
||||
resp <- withBH' $ indexDocument testIndex testMapping exampleTweet (DocId "1")
|
||||
|
||||
```
|
||||
|
||||
@ -243,7 +247,7 @@ Response {responseStatus =
|
||||
|
||||
``` {.haskell}
|
||||
|
||||
resp <- deleteDocument testServer testIndex testMapping (DocId "1")
|
||||
resp <- withBH' $ deleteDocument testIndex testMapping (DocId "1")
|
||||
|
||||
```
|
||||
|
||||
@ -253,7 +257,7 @@ resp <- deleteDocument testServer testIndex testMapping (DocId "1")
|
||||
|
||||
-- n.b., you'll need the earlier imports. responseBody is from http-conduit
|
||||
|
||||
resp <- getDocument testServer testIndex testMapping (DocId "1")
|
||||
resp <- withBH' $ getDocument testIndex testMapping (DocId "1")
|
||||
|
||||
-- responseBody :: Response body -> body
|
||||
let body = responseBody resp
|
||||
@ -328,8 +332,8 @@ let sndOp = BulkIndex testIndex
|
||||
let stream = [firstDoc, secondDoc]
|
||||
|
||||
-- Fire off the actual bulk request
|
||||
-- bulk :: Server -> [BulkOperation] -> IO Reply
|
||||
resp <- bulk testServer stream
|
||||
-- bulk :: Vector BulkOperation -> IO Reply
|
||||
resp <- withBH' $ bulk stream
|
||||
:}
|
||||
|
||||
```
|
||||
@ -363,8 +367,8 @@ let firstDocEncoded = encode firstDoc :: L.ByteString
|
||||
let encodedOperations = encodeBulkOperations stream
|
||||
|
||||
-- to insert into a particular server
|
||||
-- bulk :: Server -> V.Vector BulkOperation -> IO Reply
|
||||
_ <- bulk testServer stream
|
||||
-- bulk :: V.Vector BulkOperation -> IO Reply
|
||||
_ <- withBH' $ bulk stream
|
||||
|
||||
```
|
||||
|
||||
@ -379,7 +383,7 @@ Search
|
||||
|
||||
-- exported by the Client module, just defaults some stuff.
|
||||
-- mkSearch :: Maybe Query -> Maybe Filter -> Search
|
||||
-- mkSearch query filter = Search query filter Nothing False 0 10
|
||||
-- mkSearch query filter = Search query filter Nothing False (From 0) (Size 10)
|
||||
|
||||
let query = TermQuery (Term "user" "bitemyapp") Nothing
|
||||
|
||||
@ -393,7 +397,7 @@ let filter = IdentityFilter <&&> IdentityFilter
|
||||
let search = mkSearch (Just query) (Just filter)
|
||||
|
||||
-- you can also searchByType and specify the mapping name.
|
||||
reply <- searchByIndex testServer testIndex search
|
||||
reply <- withBH' $ searchByIndex testIndex search
|
||||
|
||||
let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
|
||||
|
||||
@ -484,7 +488,7 @@ let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
|
||||
-- -> From -> Size
|
||||
|
||||
-- just add more sortspecs to the list if you want tie-breakers.
|
||||
let search = Search Nothing (Just IdentityFilter) (Just [sortSpec]) False 0 10
|
||||
let search = Search Nothing (Just IdentityFilter) (Just [sortSpec]) False (From 0) (Size 10)
|
||||
|
||||
```
|
||||
|
||||
@ -534,7 +538,7 @@ let queryFilter = IdentityFilter <&&> IdentityFilter
|
||||
|
||||
let search = mkSearch Nothing (Just queryFilter)
|
||||
|
||||
reply <- searchByType testServer testIndex testMapping search
|
||||
reply <- withBH' $ searchByType testIndex testMapping search
|
||||
|
||||
```
|
||||
|
||||
@ -748,7 +752,7 @@ Aggregations are part of the reply structure of every search, in the form of
|
||||
-- Lift decode and response body to be in the IO monad.
|
||||
let decode' = liftM decode
|
||||
let responseBody' = liftM responseBody
|
||||
let reply = searchByIndex testServer testIndex search
|
||||
let reply = withBH' $ searchByIndex testIndex search
|
||||
let response = decode' $ responseBody' reply :: IO (Maybe (SearchResult Tweet))
|
||||
|
||||
-- Now that we have our response, we can extract our terms aggregation result -- which is a list of buckets.
|
||||
@ -857,6 +861,20 @@ Buckets can be extracted from a using
|
||||
|
||||
For more information on the Date Histogram Aggregation, see: <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-aggregations-bucket-datehistogram-aggregation.html>
|
||||
|
||||
|
||||
Contributors
|
||||
============
|
||||
|
||||
* [Chris Allen](https://github.com/bitemyapp)
|
||||
* [Liam Atkinson](https://github.com/latkins)
|
||||
* [Christopher Guiney](https://github.com/chrisguiney)
|
||||
* [Curtis Carter](https://github.com/ccarter)
|
||||
* [Michael Xavier](https://github.com/MichaelXavier)
|
||||
* [Bob Long](https://github.com/bobjflong)
|
||||
* [Maximilian Tagher](https://github.com/MaxGabriel)
|
||||
* [Anna Kopp](https://github.com/annakopp)
|
||||
* [Matvey B. Aksenov](https://github.com/supki)
|
||||
|
||||
Possible future functionality
|
||||
=============================
|
||||
|
||||
|
||||
@ -35,8 +35,13 @@ library
|
||||
semigroups >= 0.15 && <0.17,
|
||||
time >= 1.4 && <1.6,
|
||||
text >= 0.11 && <1.3,
|
||||
mtl >= 1.0 && <2.3,
|
||||
transformers >= 0.2 && <0.5,
|
||||
http-types >= 0.8 && <0.9,
|
||||
vector >= 0.10.9 && <0.11
|
||||
vector >= 0.10.9 && <0.11,
|
||||
uri-bytestring >= 0.1 && <0.2,
|
||||
exceptions,
|
||||
data-default-class
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite tests
|
||||
@ -56,7 +61,8 @@ test-suite tests
|
||||
semigroups,
|
||||
QuickCheck,
|
||||
vector,
|
||||
unordered-containers >= 0.2.5.0 && <0.3
|
||||
unordered-containers >= 0.2.5.0 && <0.3,
|
||||
mtl
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite doctests
|
||||
@ -64,8 +70,11 @@ test-suite doctests
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: doctests.hs
|
||||
hs-source-dirs: tests
|
||||
build-depends: base,
|
||||
directory,
|
||||
doctest,
|
||||
doctest-prop,
|
||||
filepath
|
||||
if impl(ghc >= 7.8)
|
||||
build-depends: base,
|
||||
directory,
|
||||
doctest,
|
||||
doctest-prop,
|
||||
filepath
|
||||
else
|
||||
buildable: False
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -20,8 +21,8 @@ module Database.Bloodhound.Client
|
||||
-- and typeclass instances for the functions that make use of them.
|
||||
|
||||
-- $setup
|
||||
|
||||
createIndex
|
||||
withBH
|
||||
, createIndex
|
||||
, deleteIndex
|
||||
, indexExists
|
||||
, openIndex
|
||||
@ -49,17 +50,24 @@ module Database.Bloodhound.Client
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Control.Monad.Catch
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Aeson
|
||||
import Data.ByteString.Lazy.Builder
|
||||
import qualified Data.ByteString.Lazy.Char8 as L
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.ByteString.Lazy.Char8 as L
|
||||
import Data.Default.Class
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Data.Vector as V
|
||||
import Network.HTTP.Client
|
||||
import qualified Network.HTTP.Types.Method as NHTM
|
||||
import qualified Network.HTTP.Types.Status as NHTS
|
||||
import Prelude hiding (filter, head)
|
||||
import qualified Network.HTTP.Types.Method as NHTM
|
||||
import qualified Network.HTTP.Types.Status as NHTS
|
||||
import Prelude hiding (filter, head)
|
||||
import URI.ByteString hiding (Query)
|
||||
|
||||
import Database.Bloodhound.Types
|
||||
|
||||
@ -69,12 +77,12 @@ import Database.Bloodhound.Types
|
||||
-- >>> import Database.Bloodhound
|
||||
-- >>> import Test.DocTest.Prop (assert)
|
||||
-- >>> let testServer = (Server "http://localhost:9200")
|
||||
-- >>> let runBH' = withBH defaultManagerSettings testServer
|
||||
-- >>> let testIndex = IndexName "twitter"
|
||||
-- >>> let testMapping = MappingName "tweet"
|
||||
-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
|
||||
-- >>> data TweetMapping = TweetMapping deriving (Eq, Show)
|
||||
-- >>> _ <- deleteIndex testServer testIndex
|
||||
-- >>> _ <- deleteMapping testServer testIndex testMapping
|
||||
-- >>> _ <- runBH' $ deleteIndex testIndex >> deleteMapping testIndex testMapping
|
||||
-- >>> import GHC.Generics
|
||||
-- >>> import Data.Time.Calendar (Day (..))
|
||||
-- >>> import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
|
||||
@ -133,29 +141,49 @@ mkReplicaCount n
|
||||
emptyBody :: L.ByteString
|
||||
emptyBody = L.pack ""
|
||||
|
||||
dispatch :: Method -> String -> Maybe L.ByteString
|
||||
-> IO Reply
|
||||
dispatch :: MonadBH m => Method -> Text -> Maybe L.ByteString
|
||||
-> m Reply
|
||||
dispatch dMethod url body = do
|
||||
initReq <- parseUrl url
|
||||
initReq <- liftIO $ parseUrl' url
|
||||
let reqBody = RequestBodyLBS $ fromMaybe emptyBody body
|
||||
let req = initReq { method = dMethod
|
||||
, requestBody = reqBody
|
||||
, checkStatus = \_ _ _ -> Nothing}
|
||||
withManager defaultManagerSettings $ httpLbs req
|
||||
mgr <- bhManager <$> getBHEnv
|
||||
liftIO $ httpLbs req mgr
|
||||
|
||||
joinPath :: [String] -> String
|
||||
joinPath = intercalate "/"
|
||||
joinPath' :: [Text] -> Text
|
||||
joinPath' = T.intercalate "/"
|
||||
|
||||
joinPath :: MonadBH m => [Text] -> m Text
|
||||
joinPath ps = do
|
||||
Server s <- bhServer <$> getBHEnv
|
||||
return $ joinPath' (s:ps)
|
||||
|
||||
bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c
|
||||
bindM2 f ma mb = join (f <$> ma <*> mb)
|
||||
|
||||
-- | Convenience function that sets up a mananager and BHEnv and runs
|
||||
-- the given set of bloodhound operations. Connections will be
|
||||
-- pipelined automatically in accordance with the given manager
|
||||
-- settings in IO. If you've got your own monad transformer stack, you
|
||||
-- should use 'runBH' directly.
|
||||
withBH :: ManagerSettings -> Server -> BH IO a -> IO a
|
||||
withBH ms s f = withManager ms $ \mgr -> do
|
||||
let env = BHEnv { bhServer = s
|
||||
, bhManager = mgr }
|
||||
runBH env f
|
||||
|
||||
-- Shortcut functions for HTTP methods
|
||||
delete :: String -> IO Reply
|
||||
delete :: MonadBH m => Text -> m Reply
|
||||
delete = flip (dispatch NHTM.methodDelete) Nothing
|
||||
get :: String -> IO Reply
|
||||
get :: MonadBH m => Text -> m Reply
|
||||
get = flip (dispatch NHTM.methodGet) Nothing
|
||||
head :: String -> IO Reply
|
||||
head :: MonadBH m => Text -> m Reply
|
||||
head = flip (dispatch NHTM.methodHead) Nothing
|
||||
put :: String -> Maybe L.ByteString -> IO Reply
|
||||
put :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
|
||||
put = dispatch NHTM.methodPost
|
||||
post :: String -> Maybe L.ByteString -> IO Reply
|
||||
post :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
|
||||
post = dispatch NHTM.methodPost
|
||||
|
||||
-- indexDocument s ix name doc = put (root </> s </> ix </> name </> doc) (Just encode doc)
|
||||
@ -164,39 +192,41 @@ post = dispatch NHTM.methodPost
|
||||
|
||||
-- | 'getStatus' fetches the 'Status' of a 'Server'
|
||||
--
|
||||
-- >>> serverStatus <- getStatus testServer
|
||||
-- >>> serverStatus <- runBH' getStatus
|
||||
-- >>> fmap status (serverStatus)
|
||||
-- Just 200
|
||||
getStatus :: Server -> IO (Maybe Status)
|
||||
getStatus (Server server) = do
|
||||
request <- parseUrl $ joinPath [server]
|
||||
response <- withManager defaultManagerSettings $ httpLbs request
|
||||
getStatus :: MonadBH m => m (Maybe Status)
|
||||
getStatus = do
|
||||
url <- joinPath []
|
||||
request <- liftIO $ parseUrl' url
|
||||
mgr <- bhManager <$> getBHEnv
|
||||
response <- liftIO $ httpLbs request mgr
|
||||
return $ decode (responseBody response)
|
||||
|
||||
-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.
|
||||
--
|
||||
-- >>> response <- createIndex testServer defaultIndexSettings (IndexName "didimakeanindex")
|
||||
-- >>> response <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
|
||||
-- >>> respIsTwoHunna response
|
||||
-- True
|
||||
-- >>> indexExists testServer (IndexName "didimakeanindex")
|
||||
-- >>> runBH' $ indexExists (IndexName "didimakeanindex")
|
||||
-- True
|
||||
createIndex :: Server -> IndexSettings -> IndexName -> IO Reply
|
||||
createIndex (Server server) indexSettings (IndexName indexName) =
|
||||
put url body
|
||||
where url = joinPath [server, indexName]
|
||||
createIndex :: MonadBH m => IndexSettings -> IndexName -> m Reply
|
||||
createIndex indexSettings (IndexName indexName) =
|
||||
bindM2 put url (return body)
|
||||
where url = joinPath [indexName]
|
||||
body = Just $ encode indexSettings
|
||||
|
||||
-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.
|
||||
--
|
||||
-- >>> response <- createIndex testServer defaultIndexSettings (IndexName "didimakeanindex")
|
||||
-- >>> response <- deleteIndex testServer (IndexName "didimakeanindex")
|
||||
-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
|
||||
-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
|
||||
-- >>> respIsTwoHunna response
|
||||
-- True
|
||||
-- >>> indexExists testServer testIndex
|
||||
-- >>> runBH' $ indexExists testIndex
|
||||
-- False
|
||||
deleteIndex :: Server -> IndexName -> IO Reply
|
||||
deleteIndex (Server server) (IndexName indexName) =
|
||||
delete $ joinPath [server, indexName]
|
||||
deleteIndex :: MonadBH m => IndexName -> m Reply
|
||||
deleteIndex (IndexName indexName) =
|
||||
delete =<< joinPath [indexName]
|
||||
|
||||
statusCodeIs :: Int -> Reply -> Bool
|
||||
statusCodeIs n resp = NHTS.statusCode (responseStatus resp) == n
|
||||
@ -204,7 +234,7 @@ statusCodeIs n resp = NHTS.statusCode (responseStatus resp) == n
|
||||
respIsTwoHunna :: Reply -> Bool
|
||||
respIsTwoHunna = statusCodeIs 200
|
||||
|
||||
existentialQuery :: String -> IO (Reply, Bool)
|
||||
existentialQuery :: MonadBH m => Text -> m (Reply, Bool)
|
||||
existentialQuery url = do
|
||||
reply <- head url
|
||||
return (reply, respIsTwoHunna reply)
|
||||
@ -212,99 +242,98 @@ existentialQuery url = do
|
||||
-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
|
||||
-- in IO
|
||||
--
|
||||
-- >>> exists <- indexExists testServer testIndex
|
||||
indexExists :: Server -> IndexName -> IO Bool
|
||||
indexExists (Server server) (IndexName indexName) = do
|
||||
(_, exists) <- existentialQuery url
|
||||
-- >>> exists <- runBH' $ indexExists testIndex
|
||||
indexExists :: MonadBH m => IndexName -> m Bool
|
||||
indexExists (IndexName indexName) = do
|
||||
(_, exists) <- existentialQuery =<< joinPath [indexName]
|
||||
return exists
|
||||
where url = joinPath [server, indexName]
|
||||
|
||||
-- | 'refreshIndex' will force a refresh on an index. You must
|
||||
-- do this if you want to read what you wrote.
|
||||
--
|
||||
-- >>> _ <- createIndex testServer defaultIndexSettings testIndex
|
||||
-- >>> _ <- refreshIndex testServer testIndex
|
||||
refreshIndex :: Server -> IndexName -> IO Reply
|
||||
refreshIndex (Server server) (IndexName indexName) =
|
||||
post url Nothing
|
||||
where url = joinPath [server, indexName, "_refresh"]
|
||||
-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
|
||||
-- >>> _ <- runBH' $ refreshIndex testIndex
|
||||
refreshIndex :: MonadBH m => IndexName -> m Reply
|
||||
refreshIndex (IndexName indexName) =
|
||||
bindM2 post url (return Nothing)
|
||||
where url = joinPath [indexName, "_refresh"]
|
||||
|
||||
stringifyOCIndex :: OpenCloseIndex -> String
|
||||
stringifyOCIndex :: OpenCloseIndex -> Text
|
||||
stringifyOCIndex oci = case oci of
|
||||
OpenIndex -> "_open"
|
||||
CloseIndex -> "_close"
|
||||
|
||||
openOrCloseIndexes :: OpenCloseIndex -> Server -> IndexName -> IO Reply
|
||||
openOrCloseIndexes oci (Server server) (IndexName indexName) =
|
||||
post url Nothing
|
||||
openOrCloseIndexes :: MonadBH m => OpenCloseIndex -> IndexName -> m Reply
|
||||
openOrCloseIndexes oci (IndexName indexName) =
|
||||
bindM2 post url (return Nothing)
|
||||
where ociString = stringifyOCIndex oci
|
||||
url = joinPath [server, indexName, ociString]
|
||||
url = joinPath [indexName, ociString]
|
||||
|
||||
-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at
|
||||
-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at
|
||||
-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
|
||||
--
|
||||
-- >>> reply <- openIndex testServer testIndex
|
||||
openIndex :: Server -> IndexName -> IO Reply
|
||||
-- >>> reply <- runBH' $ openIndex testIndex
|
||||
openIndex :: MonadBH m => IndexName -> m Reply
|
||||
openIndex = openOrCloseIndexes OpenIndex
|
||||
|
||||
-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at
|
||||
-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at
|
||||
-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
|
||||
--
|
||||
-- >>> reply <- closeIndex testServer testIndex
|
||||
closeIndex :: Server -> IndexName -> IO Reply
|
||||
-- >>> reply <- runBH' $ closeIndex testIndex
|
||||
closeIndex :: MonadBH m => IndexName -> m Reply
|
||||
closeIndex = openOrCloseIndexes CloseIndex
|
||||
|
||||
-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas
|
||||
-- for documents in indexes.
|
||||
--
|
||||
-- >>> _ <- createIndex testServer defaultIndexSettings testIndex
|
||||
-- >>> resp <- putMapping testServer testIndex testMapping TweetMapping
|
||||
-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
|
||||
-- >>> resp <- runBH' $ putMapping testIndex testMapping TweetMapping
|
||||
-- >>> print resp
|
||||
-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","21")], responseBody = "{\"acknowledged\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
|
||||
putMapping :: ToJSON a => Server -> IndexName
|
||||
-> MappingName -> a -> IO Reply
|
||||
putMapping (Server server) (IndexName indexName) (MappingName mappingName) mapping =
|
||||
put url body
|
||||
where url = joinPath [server, indexName, mappingName, "_mapping"]
|
||||
putMapping :: (MonadBH m, ToJSON a) => IndexName
|
||||
-> MappingName -> a -> m Reply
|
||||
putMapping (IndexName indexName) (MappingName mappingName) mapping =
|
||||
bindM2 put url (return body)
|
||||
where url = joinPath [indexName, mappingName, "_mapping"]
|
||||
body = Just $ encode mapping
|
||||
|
||||
-- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.
|
||||
-- Mappings are schemas for documents in indexes.
|
||||
--
|
||||
-- >>> _ <- createIndex testServer defaultIndexSettings testIndex
|
||||
-- >>> _ <- putMapping testServer testIndex testMapping TweetMapping
|
||||
-- >>> resp <- deleteMapping testServer testIndex testMapping
|
||||
-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
|
||||
-- >>> _ <- runBH' $ putMapping testIndex testMapping TweetMapping
|
||||
-- >>> resp <- runBH' $ deleteMapping testIndex testMapping
|
||||
-- >>> print resp
|
||||
-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","21")], responseBody = "{\"acknowledged\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
|
||||
deleteMapping :: Server -> IndexName -> MappingName -> IO Reply
|
||||
deleteMapping (Server server) (IndexName indexName)
|
||||
deleteMapping :: MonadBH m => IndexName -> MappingName -> m Reply
|
||||
deleteMapping (IndexName indexName)
|
||||
(MappingName mappingName) =
|
||||
delete $ joinPath [server, indexName, mappingName, "_mapping"]
|
||||
delete =<< joinPath [indexName, mappingName, "_mapping"]
|
||||
|
||||
-- | 'indexDocument' is the primary way to save a single document in
|
||||
-- Elasticsearch. The document itself is simply something we can
|
||||
-- convert into a JSON 'Value'. The 'DocId' will function as the
|
||||
-- primary key for the document.
|
||||
--
|
||||
-- >>> resp <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
|
||||
-- >>> resp <- runBH' $ indexDocument testIndex testMapping exampleTweet (DocId "1")
|
||||
-- >>> print resp
|
||||
-- Response {responseStatus = Status {statusCode = 201, statusMessage = "Created"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","74")], responseBody = "{\"_index\":\"twitter\",\"_type\":\"tweet\",\"_id\":\"1\",\"_version\":1,\"created\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
|
||||
indexDocument :: ToJSON doc => Server -> IndexName -> MappingName
|
||||
-> doc -> DocId -> IO Reply
|
||||
indexDocument (Server server) (IndexName indexName)
|
||||
indexDocument :: (ToJSON doc, MonadBH m) => IndexName -> MappingName
|
||||
-> doc -> DocId -> m Reply
|
||||
indexDocument (IndexName indexName)
|
||||
(MappingName mappingName) document (DocId docId) =
|
||||
put url body
|
||||
where url = joinPath [server, indexName, mappingName, docId]
|
||||
bindM2 put url (return body)
|
||||
where url = joinPath [indexName, mappingName, docId]
|
||||
body = Just (encode document)
|
||||
|
||||
-- | 'deleteDocument' is the primary way to delete a single document.
|
||||
--
|
||||
-- >>> _ <- deleteDocument testServer testIndex testMapping (DocId "1")
|
||||
deleteDocument :: Server -> IndexName -> MappingName
|
||||
-> DocId -> IO Reply
|
||||
deleteDocument (Server server) (IndexName indexName)
|
||||
-- >>> _ <- runBH' $ deleteDocument testIndex testMapping (DocId "1")
|
||||
deleteDocument :: MonadBH m => IndexName -> MappingName
|
||||
-> DocId -> m Reply
|
||||
deleteDocument (IndexName indexName)
|
||||
(MappingName mappingName) (DocId docId) =
|
||||
delete $ joinPath [server, indexName, mappingName, docId]
|
||||
delete =<< joinPath [indexName, mappingName, docId]
|
||||
|
||||
-- | 'bulk' uses
|
||||
-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html Elasticsearch's bulk API>
|
||||
@ -314,12 +343,12 @@ deleteDocument (Server server) (IndexName indexName)
|
||||
-- server to be performed. I changed from [BulkOperation] to a Vector due to memory overhead.
|
||||
--
|
||||
-- >>> let stream = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]
|
||||
-- >>> _ <- bulk testServer stream
|
||||
-- >>> _ <- refreshIndex testServer testIndex
|
||||
bulk :: Server -> V.Vector BulkOperation -> IO Reply
|
||||
bulk (Server server) bulkOps = post url body where
|
||||
url = joinPath [server, "_bulk"]
|
||||
body = Just $ encodeBulkOperations bulkOps
|
||||
-- >>> _ <- runBH' $ bulk stream
|
||||
-- >>> _ <- runBH' $ refreshIndex testIndex
|
||||
bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
|
||||
bulk bulkOps = bindM2 post url (return body)
|
||||
where url = joinPath ["_bulk"]
|
||||
body = Just $ encodeBulkOperations bulkOps
|
||||
|
||||
-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
|
||||
-- into an 'L.ByteString'
|
||||
@ -336,7 +365,7 @@ encodeBulkOperations stream = collapsed where
|
||||
mash :: Builder -> V.Vector L.ByteString -> Builder
|
||||
mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))
|
||||
|
||||
mkBulkStreamValue :: Text -> String -> String -> String -> Value
|
||||
mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
|
||||
mkBulkStreamValue operation indexName mappingName docId =
|
||||
object [operation .=
|
||||
object [ "_index" .= indexName
|
||||
@ -379,26 +408,26 @@ encodeBulkOperation (BulkUpdate (IndexName indexName)
|
||||
-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.
|
||||
-- The 'DocId' is the primary key for your Elasticsearch document.
|
||||
--
|
||||
-- >>> yourDoc <- getDocument testServer testIndex testMapping (DocId "1")
|
||||
getDocument :: Server -> IndexName -> MappingName
|
||||
-> DocId -> IO Reply
|
||||
getDocument (Server server) (IndexName indexName)
|
||||
-- >>> yourDoc <- runBH' $ getDocument testIndex testMapping (DocId "1")
|
||||
getDocument :: MonadBH m => IndexName -> MappingName
|
||||
-> DocId -> m Reply
|
||||
getDocument (IndexName indexName)
|
||||
(MappingName mappingName) (DocId docId) =
|
||||
get $ joinPath [server, indexName, mappingName, docId]
|
||||
get =<< joinPath [indexName, mappingName, docId]
|
||||
|
||||
-- | 'documentExists' enables you to check if a document exists. Returns 'Bool'
|
||||
-- in IO
|
||||
--
|
||||
-- >>> exists <- documentExists testServer testIndex testMapping (DocId "1")
|
||||
documentExists :: Server -> IndexName -> MappingName
|
||||
-> DocId -> IO Bool
|
||||
documentExists (Server server) (IndexName indexName)
|
||||
-- >>> exists <- runBH' $ documentExists testIndex testMapping (DocId "1")
|
||||
documentExists :: MonadBH m => IndexName -> MappingName
|
||||
-> DocId -> m Bool
|
||||
documentExists (IndexName indexName)
|
||||
(MappingName mappingName) (DocId docId) = do
|
||||
(_, exists) <- existentialQuery url
|
||||
return exists where
|
||||
url = joinPath [server, indexName, mappingName, docId]
|
||||
(_, exists) <- existentialQuery =<< url
|
||||
return exists
|
||||
where url = joinPath [indexName, mappingName, docId]
|
||||
|
||||
dispatchSearch :: String -> Search -> IO Reply
|
||||
dispatchSearch :: MonadBH m => Text -> Search -> m Reply
|
||||
dispatchSearch url search = post url (Just (encode search))
|
||||
|
||||
-- | 'searchAll', given a 'Search', will perform that search against all indexes
|
||||
@ -406,31 +435,32 @@ dispatchSearch url search = post url (Just (encode search))
|
||||
--
|
||||
-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
|
||||
-- >>> let search = mkSearch (Just query) Nothing
|
||||
-- >>> reply <- searchAll testServer search
|
||||
searchAll :: Server -> Search -> IO Reply
|
||||
searchAll (Server server) = dispatchSearch url where
|
||||
url = joinPath [server, "_search"]
|
||||
-- >>> reply <- runBH' $ searchAll search
|
||||
searchAll :: MonadBH m => Search -> m Reply
|
||||
searchAll = bindM2 dispatchSearch url . return
|
||||
where url = joinPath ["_search"]
|
||||
|
||||
-- | 'searchByIndex', given a 'Search' and an 'IndexName', will perform that search
|
||||
-- against all mappings within an index on an Elasticsearch server.
|
||||
--
|
||||
-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
|
||||
-- >>> let search = mkSearch (Just query) Nothing
|
||||
-- >>> reply <- searchByIndex testServer testIndex search
|
||||
searchByIndex :: Server -> IndexName -> Search -> IO Reply
|
||||
searchByIndex (Server server) (IndexName indexName) = dispatchSearch url where
|
||||
url = joinPath [server, indexName, "_search"]
|
||||
-- >>> reply <- runBH' $ searchByIndex testIndex search
|
||||
searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
|
||||
searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
|
||||
where url = joinPath [indexName, "_search"]
|
||||
|
||||
-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
|
||||
-- search against a specific mapping within an index on an Elasticsearch server.
|
||||
--
|
||||
-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
|
||||
-- >>> let search = mkSearch (Just query) Nothing
|
||||
-- >>> reply <- searchByType testServer testIndex testMapping search
|
||||
searchByType :: Server -> IndexName -> MappingName -> Search -> IO Reply
|
||||
searchByType (Server server) (IndexName indexName)
|
||||
(MappingName mappingName) = dispatchSearch url where
|
||||
url = joinPath [server, indexName, mappingName, "_search"]
|
||||
-- >>> reply <- runBH' $ searchByType testIndex testMapping search
|
||||
searchByType :: MonadBH m => IndexName -> MappingName -> Search
|
||||
-> m Reply
|
||||
searchByType (IndexName indexName)
|
||||
(MappingName mappingName) = bindM2 dispatchSearch url . return
|
||||
where url = joinPath [indexName, mappingName, "_search"]
|
||||
|
||||
-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'
|
||||
-- to Nothing in case you only care about your 'Query' and 'Filter'. Use record update
|
||||
@ -439,9 +469,9 @@ searchByType (Server server) (IndexName indexName)
|
||||
--
|
||||
-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
|
||||
-- >>> mkSearch (Just query) Nothing
|
||||
-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = 0, size = 10}
|
||||
-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10}
|
||||
mkSearch :: Maybe Query -> Maybe Filter -> Search
|
||||
mkSearch query filter = Search query filter Nothing Nothing Nothing False 0 10
|
||||
mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10)
|
||||
|
||||
-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
|
||||
-- the 'Query' and the 'Aggregation'.
|
||||
@ -451,7 +481,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False 0 10
|
||||
-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
|
||||
-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
|
||||
mkAggregateSearch :: Maybe Query -> Aggregations -> Search
|
||||
mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False 0 0
|
||||
mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0)
|
||||
|
||||
-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
|
||||
-- the 'Query' and the 'Aggregation'.
|
||||
@ -460,7 +490,7 @@ mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSear
|
||||
-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
|
||||
-- >>> let search = mkHighlightSearch (Just query) testHighlight
|
||||
mkHighlightSearch :: Maybe Query -> Highlights -> Search
|
||||
mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False 0 10
|
||||
mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10)
|
||||
|
||||
-- | 'pageSearch' is a helper function that takes a search and assigns the from
|
||||
-- and size fields for the search. The from parameter defines the offset
|
||||
@ -470,11 +500,39 @@ mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing
|
||||
-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
|
||||
-- >>> let search = mkSearch (Just query) Nothing
|
||||
-- >>> search
|
||||
-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = 0, size = 10}
|
||||
-- >>> pageSearch 10 100 search
|
||||
-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = 10, size = 100}
|
||||
pageSearch :: Int -- ^ The result offset
|
||||
-> Int -- ^ The number of results to return
|
||||
-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10}
|
||||
-- >>> pageSearch (From 10) (Size 100) search
|
||||
-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 10, size = Size 100}
|
||||
pageSearch :: From -- ^ The result offset
|
||||
-> Size -- ^ The number of results to return
|
||||
-> Search -- ^ The current seach
|
||||
-> Search -- ^ The paged search
|
||||
pageSearch resultOffset pageSize search = search { from = resultOffset, size = pageSize }
|
||||
|
||||
parseUrl' :: MonadThrow m => Text -> m Request
|
||||
parseUrl' t =
|
||||
case parseURI laxURIParserOptions (T.encodeUtf8 t) of
|
||||
Right uri -> setURI def uri
|
||||
Left e -> throwM $ InvalidUrlException (T.unpack t) ("Invalid URL: " ++ show e)
|
||||
|
||||
setURI :: MonadThrow m => Request -> URI -> m Request
|
||||
setURI req URI{..} = do
|
||||
Authority {..} <- maybe missingUA return uriAuthority
|
||||
let req' = req { secure = isSecure
|
||||
, host = hostBS authorityHost
|
||||
, port = thePort
|
||||
, path = uriPath
|
||||
}
|
||||
thePort = maybe defPort portNumber authorityPort
|
||||
addAuth = maybe id addAuth' authorityUserInfo
|
||||
return $ setQueryString theQueryString $ addAuth req'
|
||||
where
|
||||
missingUA = throwM $ InvalidUrlException "N/A" "Missing URI host/port"
|
||||
addAuth' UserInfo {..} = applyBasicProxyAuth uiUsername uiPassword
|
||||
defPort
|
||||
| isSecure = 443
|
||||
| otherwise = 80
|
||||
isSecure = case uriScheme of
|
||||
Scheme "https" -> True
|
||||
_ -> False
|
||||
theQueryString = [(k , Just v) | (k, v) <- queryPairs uriQuery]
|
||||
|
||||
@ -1,6 +1,11 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -39,6 +44,10 @@ module Database.Bloodhound.Types
|
||||
, toTerms
|
||||
, toDateHistogram
|
||||
, omitNulls
|
||||
, BH
|
||||
, runBH
|
||||
, BHEnv(..)
|
||||
, MonadBH(..)
|
||||
, Version(..)
|
||||
, Status(..)
|
||||
, Existence(..)
|
||||
@ -51,6 +60,9 @@ module Database.Bloodhound.Types
|
||||
, Search(..)
|
||||
, SearchResult(..)
|
||||
, SearchHits(..)
|
||||
, TrackSortScores
|
||||
, From(..)
|
||||
, Size(..)
|
||||
, ShardResult(..)
|
||||
, Hit(..)
|
||||
, Filter(..)
|
||||
@ -138,6 +150,8 @@ module Database.Bloodhound.Types
|
||||
, IgnoreTermFrequency(..)
|
||||
, MaxQueryTerms(..)
|
||||
, ScoreType(..)
|
||||
, Score
|
||||
, Cache
|
||||
, TypeName(..)
|
||||
, BoostTerms(..)
|
||||
, MaxWordLength(..)
|
||||
@ -194,13 +208,16 @@ module Database.Bloodhound.Types
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad.Error
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Writer
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types (Pair, emptyObject, parseMaybe)
|
||||
import qualified Data.ByteString.Lazy.Char8 as L
|
||||
import Data.List (nub)
|
||||
import Data.List.NonEmpty (NonEmpty(..), toList)
|
||||
import Data.List.NonEmpty (NonEmpty (..), toList)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Monoid
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Clock (UTCTime)
|
||||
@ -222,6 +239,52 @@ import Database.Bloodhound.Types.Class
|
||||
-- defaultIndexSettings is exported by Database.Bloodhound as well
|
||||
-- no trailing slashes in servers, library handles building the path.
|
||||
|
||||
{-| Common environment for Elasticsearch calls. Connections will be
|
||||
pipelined according to the provided HTTP connection manager.
|
||||
-}
|
||||
data BHEnv = BHEnv { bhServer :: Server
|
||||
, bhManager :: Manager
|
||||
}
|
||||
|
||||
{-| All API calls to Elasticsearch operate within
|
||||
MonadBH. The idea is that it can be easily embedded in your
|
||||
own monad transformer stack. A default instance for a ReaderT and
|
||||
alias 'BH' is provided for the simple case.
|
||||
-}
|
||||
class (Functor m, Applicative m, MonadIO m) => MonadBH m where
|
||||
getBHEnv :: m BHEnv
|
||||
|
||||
newtype BH m a = BH {
|
||||
unBH :: ReaderT BHEnv m a
|
||||
} deriving ( Functor
|
||||
, Applicative
|
||||
, Monad
|
||||
, MonadIO
|
||||
, MonadState s
|
||||
, MonadWriter w
|
||||
, MonadError e
|
||||
, Alternative
|
||||
, MonadPlus
|
||||
, MonadFix)
|
||||
|
||||
instance MonadTrans BH where
|
||||
lift = BH . lift
|
||||
|
||||
instance (MonadReader r m) => MonadReader r (BH m) where
|
||||
ask = lift ask
|
||||
local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
|
||||
local f (m r)
|
||||
|
||||
instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
|
||||
getBHEnv = BH getBHEnv
|
||||
|
||||
|
||||
instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where
|
||||
getBHEnv = ask
|
||||
|
||||
runBH :: BHEnv -> BH m a -> m a
|
||||
runBH e f = runReaderT (unBH f) e
|
||||
|
||||
{-| 'Version' is embedded in 'Status' -}
|
||||
data Version = Version { number :: Text
|
||||
, build_hash :: Text
|
||||
@ -400,22 +463,22 @@ 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)
|
||||
newtype Server = Server Text deriving (Eq, Show)
|
||||
|
||||
{-| 'IndexName' is used to describe which index to query/create/delete
|
||||
-}
|
||||
newtype IndexName = IndexName String deriving (Eq, Generic, Show)
|
||||
newtype IndexName = IndexName Text deriving (Eq, Generic, Show)
|
||||
|
||||
{-| 'MappingName' is part of mappings which are how ES describes and schematizes
|
||||
the data in the indices.
|
||||
-}
|
||||
newtype MappingName = MappingName String deriving (Eq, Generic, Show)
|
||||
newtype MappingName = MappingName Text deriving (Eq, Generic, Show)
|
||||
|
||||
{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
|
||||
Can be set by the user or created by ES itself. Often used in client
|
||||
functions for poking at specific documents.
|
||||
-}
|
||||
newtype DocId = DocId String deriving (Eq, Generic, Show)
|
||||
newtype DocId = DocId Text deriving (Eq, Generic, Show)
|
||||
|
||||
{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
|
||||
-}
|
||||
@ -526,12 +589,12 @@ newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, Generic)
|
||||
|
||||
{-| 'unpackId' is a silly convenience function that gets used once.
|
||||
-}
|
||||
unpackId :: DocId -> String
|
||||
unpackId :: DocId -> Text
|
||||
unpackId (DocId docId) = docId
|
||||
|
||||
type TrackSortScores = Bool
|
||||
type From = Int
|
||||
type Size = Int
|
||||
newtype From = From Int deriving (Eq, Show, ToJSON)
|
||||
newtype Size = Size Int deriving (Eq, Show, ToJSON)
|
||||
|
||||
data Search = Search { queryBody :: Maybe Query
|
||||
, filterBody :: Maybe Filter
|
||||
@ -1195,29 +1258,29 @@ instance Show TimeInterval where
|
||||
instance ToJSON Aggregation where
|
||||
toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
|
||||
omitNulls ["terms" .= omitNulls [ toJSON' term,
|
||||
"include" .= toJSON include,
|
||||
"exclude" .= toJSON exclude,
|
||||
"order" .= toJSON order,
|
||||
"min_doc_count" .= toJSON minDocCount,
|
||||
"size" .= toJSON size,
|
||||
"shard_size" .= toJSON shardSize,
|
||||
"collect_mode" .= toJSON collectMode,
|
||||
"execution_hint" .= toJSON executionHint
|
||||
"include" .= include,
|
||||
"exclude" .= exclude,
|
||||
"order" .= order,
|
||||
"min_doc_count" .= minDocCount,
|
||||
"size" .= size,
|
||||
"shard_size" .= shardSize,
|
||||
"collect_mode" .= collectMode,
|
||||
"execution_hint" .= executionHint
|
||||
],
|
||||
"aggs" .= toJSON termAggs ]
|
||||
"aggs" .= termAggs ]
|
||||
where
|
||||
toJSON' x = case x of { Left y -> "field" .= toJSON y; Right y -> "script" .= toJSON y }
|
||||
toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
|
||||
|
||||
toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =
|
||||
omitNulls ["date_histogram" .= omitNulls [ "field" .= toJSON field,
|
||||
"interval" .= toJSON interval,
|
||||
"format" .= toJSON format,
|
||||
"pre_zone" .= toJSON preZone,
|
||||
"post_zone" .= toJSON postZone,
|
||||
"pre_offset" .= toJSON preOffset,
|
||||
"post_offset" .= toJSON postOffset
|
||||
omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
|
||||
"interval" .= interval,
|
||||
"format" .= format,
|
||||
"pre_zone" .= preZone,
|
||||
"post_zone" .= postZone,
|
||||
"pre_offset" .= preOffset,
|
||||
"post_offset" .= postOffset
|
||||
],
|
||||
"aggs" .= toJSON dateHistoAggs ]
|
||||
"aggs" .= dateHistoAggs ]
|
||||
|
||||
type AggregationResults = M.Map Text Value
|
||||
|
||||
@ -1295,7 +1358,7 @@ instance ToJSON Filter where
|
||||
|
||||
toJSON (NotFilter notFilter cache) =
|
||||
object ["not" .=
|
||||
object ["filter" .= toJSON notFilter
|
||||
object ["filter" .= notFilter
|
||||
, "_cache" .= cache]]
|
||||
|
||||
toJSON (IdentityFilter) =
|
||||
@ -1311,26 +1374,26 @@ instance ToJSON Filter where
|
||||
["field" .= fieldName]]
|
||||
|
||||
toJSON (BoolFilter boolMatch) =
|
||||
object ["bool" .= toJSON boolMatch]
|
||||
object ["bool" .= boolMatch]
|
||||
|
||||
toJSON (GeoBoundingBoxFilter bbConstraint) =
|
||||
object ["geo_bounding_box" .= toJSON bbConstraint]
|
||||
object ["geo_bounding_box" .= bbConstraint]
|
||||
|
||||
toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)
|
||||
distance distanceType optimizeBbox cache) =
|
||||
object ["geo_distance" .=
|
||||
object ["distance" .= toJSON distance
|
||||
, "distance_type" .= toJSON distanceType
|
||||
object ["distance" .= distance
|
||||
, "distance_type" .= distanceType
|
||||
, "optimize_bbox" .= optimizeBbox
|
||||
, distanceGeoField .= toJSON geoDistLatLon
|
||||
, distanceGeoField .= geoDistLatLon
|
||||
, "_cache" .= cache]]
|
||||
|
||||
toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
|
||||
(DistanceRange geoDistRangeDistFrom drDistanceTo)) =
|
||||
object ["geo_distance_range" .=
|
||||
object ["from" .= toJSON geoDistRangeDistFrom
|
||||
, "to" .= toJSON drDistanceTo
|
||||
, gddrField .= toJSON drLatLon]]
|
||||
object ["from" .= geoDistRangeDistFrom
|
||||
, "to" .= drDistanceTo
|
||||
, gddrField .= drLatLon]]
|
||||
|
||||
toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =
|
||||
object ["geo_polygon" .=
|
||||
@ -1340,7 +1403,7 @@ instance ToJSON Filter where
|
||||
toJSON (IdsFilter (MappingName mappingName) values) =
|
||||
object ["ids" .=
|
||||
object ["type" .= mappingName
|
||||
, "values" .= fmap (T.pack . unpackId) values]]
|
||||
, "values" .= fmap unpackId values]]
|
||||
|
||||
toJSON (LimitFilter limit) =
|
||||
object ["limit" .= object ["value" .= limit]]
|
||||
@ -1359,7 +1422,7 @@ instance ToJSON Filter where
|
||||
toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =
|
||||
object ["range" .=
|
||||
object [ fieldName .= object (rangeValueToPair rangeValue)
|
||||
, "execution" .= toJSON rangeExecution
|
||||
, "execution" .= rangeExecution
|
||||
, "_cache" .= cache]]
|
||||
|
||||
toJSON (RegexpFilter (FieldName fieldName)
|
||||
@ -1367,14 +1430,14 @@ instance ToJSON Filter where
|
||||
object ["regexp" .=
|
||||
object [fieldName .=
|
||||
object ["value" .= regexText
|
||||
, "flags" .= toJSON flags]
|
||||
, "flags" .= flags]
|
||||
, "_name" .= cacheName
|
||||
, "_cache" .= cache
|
||||
, "_cache_key" .= cacheKey]]
|
||||
|
||||
instance ToJSON GeoPoint where
|
||||
toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
|
||||
object [ geoPointField .= toJSON geoPointLatLon ]
|
||||
object [ geoPointField .= geoPointLatLon ]
|
||||
|
||||
|
||||
instance ToJSON Query where
|
||||
@ -1394,82 +1457,82 @@ instance ToJSON Query where
|
||||
getTermValue (Term _ v) = v
|
||||
toJSON (IdsQuery idsQueryMappingName docIds) =
|
||||
object [ "ids" .= object conjoined ]
|
||||
where conjoined = [ "type" .= toJSON idsQueryMappingName
|
||||
where conjoined = [ "type" .= idsQueryMappingName
|
||||
, "values" .= fmap toJSON docIds ]
|
||||
|
||||
toJSON (QueryQueryStringQuery qQueryStringQuery) =
|
||||
object [ "query_string" .= toJSON qQueryStringQuery ]
|
||||
object [ "query_string" .= qQueryStringQuery ]
|
||||
|
||||
toJSON (QueryMatchQuery matchQuery) =
|
||||
object [ "match" .= toJSON matchQuery ]
|
||||
object [ "match" .= matchQuery ]
|
||||
|
||||
toJSON (QueryMultiMatchQuery multiMatchQuery) =
|
||||
toJSON multiMatchQuery
|
||||
|
||||
toJSON (QueryBoolQuery boolQuery) =
|
||||
object [ "bool" .= toJSON boolQuery ]
|
||||
object [ "bool" .= boolQuery ]
|
||||
|
||||
toJSON (QueryBoostingQuery boostingQuery) =
|
||||
object [ "boosting" .= toJSON boostingQuery ]
|
||||
object [ "boosting" .= boostingQuery ]
|
||||
|
||||
toJSON (QueryCommonTermsQuery commonTermsQuery) =
|
||||
object [ "common" .= toJSON commonTermsQuery ]
|
||||
object [ "common" .= commonTermsQuery ]
|
||||
|
||||
toJSON (ConstantScoreFilter csFilter boost) =
|
||||
object [ "constant_score" .= toJSON csFilter
|
||||
, "boost" .= toJSON boost]
|
||||
object [ "constant_score" .= csFilter
|
||||
, "boost" .= boost]
|
||||
|
||||
toJSON (ConstantScoreQuery query boost) =
|
||||
object [ "constant_score" .= toJSON query
|
||||
, "boost" .= toJSON boost]
|
||||
object [ "constant_score" .= query
|
||||
, "boost" .= boost]
|
||||
|
||||
toJSON (QueryDisMaxQuery disMaxQuery) =
|
||||
object [ "dis_max" .= toJSON disMaxQuery ]
|
||||
object [ "dis_max" .= disMaxQuery ]
|
||||
|
||||
toJSON (QueryFilteredQuery qFilteredQuery) =
|
||||
object [ "filtered" .= toJSON qFilteredQuery ]
|
||||
object [ "filtered" .= qFilteredQuery ]
|
||||
|
||||
toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
|
||||
object [ "fuzzy_like_this" .= toJSON fuzzyQuery ]
|
||||
object [ "fuzzy_like_this" .= fuzzyQuery ]
|
||||
|
||||
toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
|
||||
object [ "fuzzy_like_this_field" .= toJSON fuzzyFieldQuery ]
|
||||
object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
|
||||
|
||||
toJSON (QueryFuzzyQuery fuzzyQuery) =
|
||||
object [ "fuzzy" .= toJSON fuzzyQuery ]
|
||||
object [ "fuzzy" .= fuzzyQuery ]
|
||||
|
||||
toJSON (QueryHasChildQuery childQuery) =
|
||||
object [ "has_child" .= toJSON childQuery ]
|
||||
object [ "has_child" .= childQuery ]
|
||||
|
||||
toJSON (QueryHasParentQuery parentQuery) =
|
||||
object [ "has_parent" .= toJSON parentQuery ]
|
||||
object [ "has_parent" .= parentQuery ]
|
||||
|
||||
toJSON (QueryIndicesQuery qIndicesQuery) =
|
||||
object [ "indices" .= toJSON qIndicesQuery ]
|
||||
object [ "indices" .= qIndicesQuery ]
|
||||
|
||||
toJSON (MatchAllQuery boost) =
|
||||
object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
|
||||
|
||||
toJSON (QueryMoreLikeThisQuery query) =
|
||||
object [ "more_like_this" .= toJSON query ]
|
||||
object [ "more_like_this" .= query ]
|
||||
|
||||
toJSON (QueryMoreLikeThisFieldQuery query) =
|
||||
object [ "more_like_this_field" .= toJSON query ]
|
||||
object [ "more_like_this_field" .= query ]
|
||||
|
||||
toJSON (QueryNestedQuery query) =
|
||||
object [ "nested" .= toJSON query ]
|
||||
object [ "nested" .= query ]
|
||||
|
||||
toJSON (QueryPrefixQuery query) =
|
||||
object [ "prefix" .= toJSON query ]
|
||||
object [ "prefix" .= query ]
|
||||
|
||||
toJSON (QueryRangeQuery query) =
|
||||
object [ "range" .= toJSON query ]
|
||||
object [ "range" .= query ]
|
||||
|
||||
toJSON (QueryRegexpQuery query) =
|
||||
object [ "regexp" .= toJSON query ]
|
||||
object [ "regexp" .= query ]
|
||||
|
||||
toJSON (QuerySimpleQueryStringQuery query) =
|
||||
object [ "simple_query_string" .= toJSON query ]
|
||||
object [ "simple_query_string" .= query ]
|
||||
|
||||
|
||||
omitNulls :: [(Text, Value)] -> Value
|
||||
@ -1482,7 +1545,7 @@ omitNulls = object . filter notNull where
|
||||
instance ToJSON SimpleQueryStringQuery where
|
||||
toJSON SimpleQueryStringQuery {..} =
|
||||
omitNulls (base ++ maybeAdd)
|
||||
where base = [ "query" .= toJSON simpleQueryStringQuery ]
|
||||
where base = [ "query" .= simpleQueryStringQuery ]
|
||||
maybeAdd = [ "fields" .= simpleQueryStringField
|
||||
, "default_operator" .= simpleQueryStringOperator
|
||||
, "analyzer" .= simpleQueryStringAnalyzer
|
||||
@ -1518,7 +1581,7 @@ instance ToJSON RegexpQuery where
|
||||
rqQueryBoost) =
|
||||
object [ rqQueryField .= omitNulls base ]
|
||||
where base = [ "value" .= regexpQueryQuery
|
||||
, "flags" .= toJSON rqQueryFlags
|
||||
, "flags" .= rqQueryFlags
|
||||
, "boost" .= rqQueryBoost ]
|
||||
|
||||
|
||||
@ -1534,7 +1597,7 @@ instance ToJSON QueryStringQuery where
|
||||
qsLenient qsLocale) =
|
||||
omitNulls base
|
||||
where
|
||||
base = [ "query" .= toJSON qsQueryString
|
||||
base = [ "query" .= qsQueryString
|
||||
, "default_field" .= qsDefaultField
|
||||
, "default_operator" .= qsOperator
|
||||
, "analyzer" .= qsAnalyzer
|
||||
@ -1556,21 +1619,21 @@ instance ToJSON QueryStringQuery where
|
||||
instance ToJSON RangeQuery where
|
||||
toJSON (RangeQuery (FieldName fieldName) range boost) =
|
||||
object [ fieldName .= conjoined ]
|
||||
where conjoined = [ "boost" .= toJSON boost ] ++ (rangeValueToPair range)
|
||||
where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
|
||||
|
||||
|
||||
instance ToJSON PrefixQuery where
|
||||
toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
|
||||
object [ fieldName .= omitNulls base ]
|
||||
where base = [ "value" .= toJSON queryValue
|
||||
where base = [ "value" .= queryValue
|
||||
, "boost" .= boost ]
|
||||
|
||||
|
||||
instance ToJSON NestedQuery where
|
||||
toJSON (NestedQuery nqPath nqScoreType nqQuery) =
|
||||
object [ "path" .= toJSON nqPath
|
||||
, "score_mode" .= toJSON nqScoreType
|
||||
, "query" .= toJSON nqQuery ]
|
||||
object [ "path" .= nqPath
|
||||
, "score_mode" .= nqScoreType
|
||||
, "query" .= nqQuery ]
|
||||
|
||||
|
||||
instance ToJSON MoreLikeThisFieldQuery where
|
||||
@ -1578,7 +1641,7 @@ instance ToJSON MoreLikeThisFieldQuery where
|
||||
percent mtf mqt stopwords mindf maxdf
|
||||
minwl maxwl boostTerms boost analyzer) =
|
||||
object [ fieldName .= omitNulls base ]
|
||||
where base = [ "like_text" .= toJSON text
|
||||
where base = [ "like_text" .= text
|
||||
, "percent_terms_to_match" .= percent
|
||||
, "min_term_freq" .= mtf
|
||||
, "max_query_terms" .= mqt
|
||||
@ -1597,7 +1660,7 @@ instance ToJSON MoreLikeThisQuery where
|
||||
mtf mqt stopwords mindf maxdf
|
||||
minwl maxwl boostTerms boost analyzer) =
|
||||
omitNulls base
|
||||
where base = [ "like_text" .= toJSON text
|
||||
where base = [ "like_text" .= text
|
||||
, "fields" .= fields
|
||||
, "percent_terms_to_match" .= percent
|
||||
, "min_term_freq" .= mtf
|
||||
@ -1614,34 +1677,34 @@ instance ToJSON MoreLikeThisQuery where
|
||||
|
||||
instance ToJSON IndicesQuery where
|
||||
toJSON (IndicesQuery indices query noMatch) =
|
||||
omitNulls [ "indices" .= toJSON indices
|
||||
, "no_match_query" .= toJSON noMatch
|
||||
, "query" .= toJSON query ]
|
||||
omitNulls [ "indices" .= indices
|
||||
, "no_match_query" .= noMatch
|
||||
, "query" .= query ]
|
||||
|
||||
|
||||
instance ToJSON HasParentQuery where
|
||||
toJSON (HasParentQuery queryType query scoreType) =
|
||||
omitNulls [ "parent_type" .= toJSON queryType
|
||||
, "score_type" .= toJSON scoreType
|
||||
, "query" .= toJSON query ]
|
||||
omitNulls [ "parent_type" .= queryType
|
||||
, "score_type" .= scoreType
|
||||
, "query" .= query ]
|
||||
|
||||
|
||||
instance ToJSON HasChildQuery where
|
||||
toJSON (HasChildQuery queryType query scoreType) =
|
||||
omitNulls [ "query" .= toJSON query
|
||||
, "score_type" .= toJSON scoreType
|
||||
, "type" .= toJSON queryType ]
|
||||
omitNulls [ "query" .= query
|
||||
, "score_type" .= scoreType
|
||||
, "type" .= queryType ]
|
||||
|
||||
|
||||
instance ToJSON FuzzyQuery where
|
||||
toJSON (FuzzyQuery (FieldName fieldName) queryText
|
||||
prefixLength maxEx fuzziness boost) =
|
||||
object [ fieldName .= omitNulls base ]
|
||||
where base = [ "value" .= toJSON queryText
|
||||
, "fuzziness" .= toJSON fuzziness
|
||||
, "prefix_length" .= toJSON prefixLength
|
||||
, "boost" .= toJSON boost
|
||||
, "max_expansions" .= toJSON maxEx ]
|
||||
where base = [ "value" .= queryText
|
||||
, "fuzziness" .= fuzziness
|
||||
, "prefix_length" .= prefixLength
|
||||
, "boost" .= boost
|
||||
, "max_expansions" .= maxEx ]
|
||||
|
||||
|
||||
instance ToJSON FuzzyLikeFieldQuery where
|
||||
@ -1649,41 +1712,41 @@ instance ToJSON FuzzyLikeFieldQuery where
|
||||
fieldText maxTerms ignoreFreq fuzziness prefixLength
|
||||
boost analyzer) =
|
||||
object [ fieldName .=
|
||||
omitNulls [ "like_text" .= toJSON fieldText
|
||||
, "max_query_terms" .= toJSON maxTerms
|
||||
, "ignore_tf" .= toJSON ignoreFreq
|
||||
, "fuzziness" .= toJSON fuzziness
|
||||
, "prefix_length" .= toJSON prefixLength
|
||||
, "analyzer" .= toJSON analyzer
|
||||
, "boost" .= toJSON boost ]]
|
||||
omitNulls [ "like_text" .= fieldText
|
||||
, "max_query_terms" .= maxTerms
|
||||
, "ignore_tf" .= ignoreFreq
|
||||
, "fuzziness" .= fuzziness
|
||||
, "prefix_length" .= prefixLength
|
||||
, "analyzer" .= analyzer
|
||||
, "boost" .= boost ]]
|
||||
|
||||
|
||||
instance ToJSON FuzzyLikeThisQuery where
|
||||
toJSON (FuzzyLikeThisQuery fields text maxTerms
|
||||
ignoreFreq fuzziness prefixLength boost analyzer) =
|
||||
omitNulls base
|
||||
where base = [ "fields" .= toJSON fields
|
||||
, "like_text" .= toJSON text
|
||||
, "max_query_terms" .= toJSON maxTerms
|
||||
, "ignore_tf" .= toJSON ignoreFreq
|
||||
, "fuzziness" .= toJSON fuzziness
|
||||
, "prefix_length" .= toJSON prefixLength
|
||||
, "analyzer" .= toJSON analyzer
|
||||
, "boost" .= toJSON boost ]
|
||||
where base = [ "fields" .= fields
|
||||
, "like_text" .= text
|
||||
, "max_query_terms" .= maxTerms
|
||||
, "ignore_tf" .= ignoreFreq
|
||||
, "fuzziness" .= fuzziness
|
||||
, "prefix_length" .= prefixLength
|
||||
, "analyzer" .= analyzer
|
||||
, "boost" .= boost ]
|
||||
|
||||
|
||||
instance ToJSON FilteredQuery where
|
||||
toJSON (FilteredQuery query fFilter) =
|
||||
object [ "query" .= toJSON query
|
||||
, "filter" .= toJSON fFilter ]
|
||||
object [ "query" .= query
|
||||
, "filter" .= fFilter ]
|
||||
|
||||
|
||||
instance ToJSON DisMaxQuery where
|
||||
toJSON (DisMaxQuery queries tiebreaker boost) =
|
||||
omitNulls base
|
||||
where base = [ "queries" .= toJSON queries
|
||||
, "boost" .= toJSON boost
|
||||
, "tie_breaker" .= toJSON tiebreaker ]
|
||||
where base = [ "queries" .= queries
|
||||
, "boost" .= boost
|
||||
, "tie_breaker" .= tiebreaker ]
|
||||
|
||||
|
||||
instance ToJSON CommonTermsQuery where
|
||||
@ -1691,38 +1754,38 @@ instance ToJSON CommonTermsQuery where
|
||||
(QueryString query) cf lfo hfo msm
|
||||
boost analyzer disableCoord) =
|
||||
object [fieldName .= omitNulls base ]
|
||||
where base = [ "query" .= toJSON query
|
||||
, "cutoff_frequency" .= toJSON cf
|
||||
, "low_freq_operator" .= toJSON lfo
|
||||
, "minimum_should_match" .= toJSON msm
|
||||
, "boost" .= toJSON boost
|
||||
, "analyzer" .= toJSON analyzer
|
||||
, "disable_coord" .= toJSON disableCoord
|
||||
, "high_freq_operator" .= toJSON hfo ]
|
||||
where base = [ "query" .= query
|
||||
, "cutoff_frequency" .= cf
|
||||
, "low_freq_operator" .= lfo
|
||||
, "minimum_should_match" .= msm
|
||||
, "boost" .= boost
|
||||
, "analyzer" .= analyzer
|
||||
, "disable_coord" .= disableCoord
|
||||
, "high_freq_operator" .= hfo ]
|
||||
|
||||
|
||||
instance ToJSON CommonMinimumMatch where
|
||||
toJSON (CommonMinimumMatch mm) = toJSON mm
|
||||
toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
|
||||
object [ "low_freq" .= toJSON lowF
|
||||
, "high_freq" .= toJSON highF ]
|
||||
object [ "low_freq" .= lowF
|
||||
, "high_freq" .= highF ]
|
||||
|
||||
instance ToJSON BoostingQuery where
|
||||
toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
|
||||
object [ "positive" .= toJSON bqPositiveQuery
|
||||
, "negative" .= toJSON bqNegativeQuery
|
||||
, "negative_boost" .= toJSON bqNegativeBoost ]
|
||||
object [ "positive" .= bqPositiveQuery
|
||||
, "negative" .= bqNegativeQuery
|
||||
, "negative_boost" .= bqNegativeBoost ]
|
||||
|
||||
|
||||
instance ToJSON BoolQuery where
|
||||
toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =
|
||||
omitNulls base
|
||||
where base = [ "must" .= toJSON mustM
|
||||
, "must_not" .= toJSON notM
|
||||
, "should" .= toJSON shouldM
|
||||
, "minimum_should_match" .= toJSON bqMin
|
||||
, "boost" .= toJSON boost
|
||||
, "disable_coord" .= toJSON disableCoord ]
|
||||
where base = [ "must" .= mustM
|
||||
, "must_not" .= notM
|
||||
, "should" .= shouldM
|
||||
, "minimum_should_match" .= bqMin
|
||||
, "boost" .= boost
|
||||
, "disable_coord" .= disableCoord ]
|
||||
|
||||
|
||||
instance ToJSON MatchQuery where
|
||||
@ -1732,13 +1795,13 @@ instance ToJSON MatchQuery where
|
||||
analyzer maxExpansions lenient) =
|
||||
object [ fieldName .= omitNulls base ]
|
||||
where base = [ "query" .= mqQueryString
|
||||
, "operator" .= toJSON booleanOperator
|
||||
, "zero_terms_query" .= toJSON zeroTermsQuery
|
||||
, "cutoff_frequency" .= toJSON cutoffFrequency
|
||||
, "type" .= toJSON matchQueryType
|
||||
, "analyzer" .= toJSON analyzer
|
||||
, "max_expansions" .= toJSON maxExpansions
|
||||
, "lenient" .= toJSON lenient ]
|
||||
, "operator" .= booleanOperator
|
||||
, "zero_terms_query" .= zeroTermsQuery
|
||||
, "cutoff_frequency" .= cutoffFrequency
|
||||
, "type" .= matchQueryType
|
||||
, "analyzer" .= analyzer
|
||||
, "max_expansions" .= maxExpansions
|
||||
, "lenient" .= lenient ]
|
||||
|
||||
|
||||
instance ToJSON MultiMatchQuery where
|
||||
@ -1747,14 +1810,14 @@ instance ToJSON MultiMatchQuery where
|
||||
object ["multi_match" .= omitNulls base]
|
||||
where base = [ "fields" .= fmap toJSON fields
|
||||
, "query" .= query
|
||||
, "operator" .= toJSON boolOp
|
||||
, "zero_terms_query" .= toJSON ztQ
|
||||
, "tiebreaker" .= toJSON tb
|
||||
, "type" .= toJSON mmqt
|
||||
, "cutoff_frequency" .= toJSON cf
|
||||
, "analyzer" .= toJSON analyzer
|
||||
, "max_expansions" .= toJSON maxEx
|
||||
, "lenient" .= toJSON lenient ]
|
||||
, "operator" .= boolOp
|
||||
, "zero_terms_query" .= ztQ
|
||||
, "tiebreaker" .= tb
|
||||
, "type" .= mmqt
|
||||
, "cutoff_frequency" .= cf
|
||||
, "analyzer" .= analyzer
|
||||
, "max_expansions" .= maxEx
|
||||
, "lenient" .= lenient ]
|
||||
|
||||
|
||||
instance ToJSON MultiMatchQueryType where
|
||||
@ -1866,7 +1929,7 @@ instance ToJSON FieldHighlight where
|
||||
|
||||
instance ToJSON Highlights where
|
||||
toJSON (Highlights global fields) =
|
||||
omitNulls (("fields" .= toJSON fields)
|
||||
omitNulls (("fields" .= fields)
|
||||
: highlightSettingsPairs global)
|
||||
|
||||
instance ToJSON HighlightSettings where
|
||||
@ -1944,16 +2007,16 @@ instance ToJSON SortSpec where
|
||||
(DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
|
||||
dsSortMode dsMissingSort dsNestedFilter)) =
|
||||
object [dsSortFieldName .= omitNulls base] where
|
||||
base = [ "order" .= toJSON dsSortOrder
|
||||
base = [ "order" .= dsSortOrder
|
||||
, "ignore_unmapped" .= dsIgnoreUnmapped
|
||||
, "mode" .= dsSortMode
|
||||
, "missing" .= dsMissingSort
|
||||
, "nested_filter" .= dsNestedFilter ]
|
||||
|
||||
toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
|
||||
object [ "unit" .= toJSON units
|
||||
, field .= toJSON gdsLatLon
|
||||
, "order" .= toJSON gdsSortOrder ]
|
||||
object [ "unit" .= units
|
||||
, field .= gdsLatLon
|
||||
, "order" .= gdsSortOrder ]
|
||||
|
||||
|
||||
instance ToJSON SortOrder where
|
||||
@ -2015,7 +2078,7 @@ instance ToJSON OptimizeBbox where
|
||||
instance ToJSON GeoBoundingBoxConstraint where
|
||||
toJSON (GeoBoundingBoxConstraint
|
||||
(FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
|
||||
object [gbbcGeoBBField .= toJSON gbbcConstraintBox
|
||||
object [gbbcGeoBBField .= gbbcConstraintBox
|
||||
, "_cache" .= cache
|
||||
, "type" .= type']
|
||||
|
||||
@ -2027,8 +2090,8 @@ instance ToJSON GeoFilterType where
|
||||
|
||||
instance ToJSON GeoBoundingBox where
|
||||
toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
|
||||
object ["top_left" .= toJSON gbbTopLeft
|
||||
, "bottom_right" .= toJSON gbbBottomRight]
|
||||
object ["top_left" .= gbbTopLeft
|
||||
, "bottom_right" .= gbbBottomRight]
|
||||
|
||||
|
||||
instance ToJSON LatLon where
|
||||
@ -2061,9 +2124,9 @@ instance ToJSON Term where
|
||||
|
||||
|
||||
instance ToJSON BoolMatch where
|
||||
toJSON (MustMatch term cache) = object ["must" .= toJSON term,
|
||||
toJSON (MustMatch term cache) = object ["must" .= term,
|
||||
"_cache" .= cache]
|
||||
toJSON (MustNotMatch term cache) = object ["must_not" .= toJSON term,
|
||||
toJSON (MustNotMatch term cache) = object ["must_not" .= term,
|
||||
"_cache" .= cache]
|
||||
toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
|
||||
"_cache" .= cache]
|
||||
|
||||
226
tests/tests.hs
226
tests/tests.hs
@ -6,8 +6,9 @@ module Main where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Control.Monad.Reader
|
||||
import Data.Aeson
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.List (nub)
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
@ -34,15 +35,18 @@ testIndex = IndexName "bloodhound-tests-twitter-1"
|
||||
testMapping :: MappingName
|
||||
testMapping = MappingName "tweet"
|
||||
|
||||
withTestEnv :: BH IO a -> IO a
|
||||
withTestEnv = withBH defaultManagerSettings testServer
|
||||
|
||||
validateStatus :: Response body -> Int -> Expectation
|
||||
validateStatus resp expected =
|
||||
(NHTS.statusCode $ responseStatus resp)
|
||||
`shouldBe` (expected :: Int)
|
||||
|
||||
createExampleIndex :: IO Reply
|
||||
createExampleIndex = createIndex testServer defaultIndexSettings testIndex
|
||||
deleteExampleIndex :: IO Reply
|
||||
deleteExampleIndex = deleteIndex testServer testIndex
|
||||
createExampleIndex :: BH IO Reply
|
||||
createExampleIndex = createIndex defaultIndexSettings testIndex
|
||||
deleteExampleIndex :: BH IO Reply
|
||||
deleteExampleIndex = deleteIndex testIndex
|
||||
|
||||
data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)
|
||||
|
||||
@ -70,18 +74,16 @@ mkServerVersion [majorVer, minorVer, patchVer] =
|
||||
Just (ServerVersion majorVer minorVer patchVer)
|
||||
mkServerVersion _ = Nothing
|
||||
|
||||
getServerVersion :: Server -> IO (Maybe ServerVersion)
|
||||
getServerVersion s = liftM extractVersion (getStatus s)
|
||||
getServerVersion :: IO (Maybe ServerVersion)
|
||||
getServerVersion = liftM extractVersion (withTestEnv getStatus)
|
||||
where
|
||||
version' = T.splitOn "." . number . version
|
||||
toInt = read . T.unpack
|
||||
parseVersion v = map toInt (version' v)
|
||||
extractVersion = join . liftM (mkServerVersion . parseVersion)
|
||||
|
||||
|
||||
|
||||
testServerBranch :: IO (Maybe ServerVersion)
|
||||
testServerBranch = getServerVersion testServer >>= \v -> return $ liftM serverBranch v
|
||||
testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v
|
||||
|
||||
atleast :: ServerVersion -> IO Bool
|
||||
atleast v = testServerBranch >>= \x -> return $ x >= Just (serverBranch v)
|
||||
@ -136,60 +138,63 @@ otherTweet = Tweet { user = "notmyapp"
|
||||
, age = 1000
|
||||
, location = Location 40.12 (-71.34) }
|
||||
|
||||
insertData :: IO ()
|
||||
insertData :: BH IO ()
|
||||
insertData = do
|
||||
_ <- deleteExampleIndex
|
||||
_ <- createExampleIndex
|
||||
_ <- putMapping testServer testIndex testMapping TweetMapping
|
||||
_ <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
|
||||
_ <- refreshIndex testServer testIndex
|
||||
_ <- putMapping testIndex testMapping TweetMapping
|
||||
_ <- indexDocument testIndex testMapping exampleTweet (DocId "1")
|
||||
_ <- refreshIndex testIndex
|
||||
return ()
|
||||
|
||||
insertOther :: IO ()
|
||||
insertOther :: BH IO ()
|
||||
insertOther = do
|
||||
_ <- indexDocument testServer testIndex testMapping otherTweet (DocId "2")
|
||||
_ <- refreshIndex testServer testIndex
|
||||
_ <- indexDocument testIndex testMapping otherTweet (DocId "2")
|
||||
_ <- refreshIndex testIndex
|
||||
return ()
|
||||
|
||||
searchTweet :: Search -> IO (Either String Tweet)
|
||||
searchTweet :: Search -> BH IO (Either String Tweet)
|
||||
searchTweet search = do
|
||||
reply <- searchByIndex testServer testIndex search
|
||||
reply <- searchByIndex testIndex search
|
||||
let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
|
||||
let myTweet = fmap (hitSource . head . hits . searchHits) result
|
||||
return myTweet
|
||||
|
||||
searchExpectNoResults :: Search -> IO ()
|
||||
searchExpectNoResults :: Search -> BH IO ()
|
||||
searchExpectNoResults search = do
|
||||
reply <- searchByIndex testServer testIndex search
|
||||
reply <- searchByIndex testIndex search
|
||||
let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
|
||||
let emptyHits = fmap (hits . searchHits) result
|
||||
emptyHits `shouldBe` Right []
|
||||
liftIO $
|
||||
emptyHits `shouldBe` Right []
|
||||
|
||||
searchExpectAggs :: Search -> IO ()
|
||||
searchExpectAggs :: Search -> BH IO ()
|
||||
searchExpectAggs search = do
|
||||
reply <- searchAll testServer search
|
||||
reply <- searchAll search
|
||||
let isEmpty x = return (M.null x)
|
||||
let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
|
||||
(result >>= aggregations >>= isEmpty) `shouldBe` Just False
|
||||
liftIO $
|
||||
(result >>= aggregations >>= isEmpty) `shouldBe` Just False
|
||||
|
||||
searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) => Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> IO ()
|
||||
searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) => Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
|
||||
searchValidBucketAgg search aggKey extractor = do
|
||||
reply <- searchAll testServer search
|
||||
reply <- searchAll search
|
||||
let bucketDocs = docCount . head . buckets
|
||||
let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
|
||||
let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
|
||||
count `shouldBe` Just 1
|
||||
liftIO $
|
||||
count `shouldBe` Just 1
|
||||
|
||||
searchTermsAggHint :: [ExecutionHint] -> IO ()
|
||||
searchTermsAggHint :: [ExecutionHint] -> BH IO ()
|
||||
searchTermsAggHint hints = do
|
||||
let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
|
||||
let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
|
||||
forM_ hints $ searchExpectAggs . search
|
||||
forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
|
||||
|
||||
searchTweetHighlight :: Search -> IO (Either String (Maybe HitHighlight))
|
||||
searchTweetHighlight :: Search -> BH IO (Either String (Maybe HitHighlight))
|
||||
searchTweetHighlight search = do
|
||||
reply <- searchByIndex testServer testIndex search
|
||||
reply <- searchByIndex testIndex search
|
||||
let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
|
||||
let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
|
||||
return myHighlight
|
||||
@ -223,26 +228,27 @@ main :: IO ()
|
||||
main = hspec $ do
|
||||
|
||||
describe "index create/delete API" $ do
|
||||
it "creates and then deletes the requested index" $ do
|
||||
it "creates and then deletes the requested index" $ withTestEnv $ do
|
||||
-- priming state.
|
||||
_ <- deleteExampleIndex
|
||||
resp <- createExampleIndex
|
||||
deleteResp <- deleteExampleIndex
|
||||
validateStatus resp 200
|
||||
validateStatus deleteResp 200
|
||||
liftIO $ do
|
||||
validateStatus resp 200
|
||||
validateStatus deleteResp 200
|
||||
|
||||
|
||||
describe "document API" $ do
|
||||
it "indexes, gets, and then deletes the generated document" $ do
|
||||
it "indexes, gets, and then deletes the generated document" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
docInserted <- getDocument testServer testIndex testMapping (DocId "1")
|
||||
docInserted <- getDocument testIndex testMapping (DocId "1")
|
||||
let newTweet = eitherDecode
|
||||
(responseBody docInserted) :: Either String (EsResult Tweet)
|
||||
fmap _source newTweet `shouldBe` Right exampleTweet
|
||||
liftIO $ (fmap _source newTweet `shouldBe` Right exampleTweet)
|
||||
|
||||
|
||||
describe "bulk API" $ do
|
||||
it "inserts all documents we request" $ do
|
||||
it "inserts all documents we request" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let firstTest = BulkTest "blah"
|
||||
let secondTest = BulkTest "bloo"
|
||||
@ -251,49 +257,54 @@ main = hspec $ do
|
||||
let secondDoc = BulkCreate testIndex
|
||||
testMapping (DocId "3") (toJSON secondTest)
|
||||
let stream = V.fromList [firstDoc, secondDoc]
|
||||
_ <- bulk testServer stream
|
||||
_ <- refreshIndex testServer testIndex
|
||||
fDoc <- getDocument testServer testIndex testMapping (DocId "2")
|
||||
sDoc <- getDocument testServer testIndex testMapping (DocId "3")
|
||||
_ <- bulk stream
|
||||
_ <- refreshIndex testIndex
|
||||
fDoc <- getDocument testIndex testMapping (DocId "2")
|
||||
sDoc <- getDocument testIndex testMapping (DocId "3")
|
||||
let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
|
||||
let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
|
||||
fmap _source maybeFirst `shouldBe` Right firstTest
|
||||
fmap _source maybeSecond `shouldBe` Right secondTest
|
||||
liftIO $ do
|
||||
fmap _source maybeFirst `shouldBe` Right firstTest
|
||||
fmap _source maybeSecond `shouldBe` Right secondTest
|
||||
|
||||
|
||||
describe "query API" $ do
|
||||
it "returns document for term query and identity filter" $ do
|
||||
it "returns document for term query and identity filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let query = TermQuery (Term "user" "bitemyapp") Nothing
|
||||
let filter = IdentityFilter <&&> IdentityFilter
|
||||
let search = mkSearch (Just query) (Just filter)
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "returns document for terms query and identity filter" $ do
|
||||
it "returns document for terms query and identity filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let query = TermsQuery (NE.fromList [(Term "user" "bitemyapp")])
|
||||
let filter = IdentityFilter <&&> IdentityFilter
|
||||
let search = mkSearch (Just query) (Just filter)
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "returns document for match query" $ do
|
||||
it "returns document for match query" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
|
||||
let search = mkSearch (Just query) Nothing
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "returns document for multi-match query" $ do
|
||||
it "returns document for multi-match query" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let fields = [FieldName "user", FieldName "message"]
|
||||
let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")
|
||||
let search = mkSearch (Just query) Nothing
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "returns document for bool query" $ do
|
||||
it "returns document for bool query" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let innerQuery = QueryMatchQuery $
|
||||
mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
|
||||
@ -301,18 +312,20 @@ main = hspec $ do
|
||||
mkBoolQuery [innerQuery] [] []
|
||||
let search = mkSearch (Just query) Nothing
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "returns document for boosting query" $ do
|
||||
it "returns document for boosting query" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
|
||||
let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
|
||||
let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
|
||||
let search = mkSearch (Just query) Nothing
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "returns document for common terms query" $ do
|
||||
it "returns document for common terms query" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let query = QueryCommonTermsQuery $
|
||||
CommonTermsQuery (FieldName "user")
|
||||
@ -321,55 +334,61 @@ main = hspec $ do
|
||||
Or Or Nothing Nothing Nothing Nothing
|
||||
let search = mkSearch (Just query) Nothing
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
|
||||
describe "sorting" $ do
|
||||
it "returns documents in the right order" $ do
|
||||
it "returns documents in the right order" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
_ <- insertOther
|
||||
let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
|
||||
let search = Search Nothing
|
||||
(Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
|
||||
False 0 10
|
||||
reply <- searchByIndex testServer testIndex search
|
||||
False (From 0) (Size 10)
|
||||
reply <- searchByIndex testIndex search
|
||||
let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
|
||||
let myTweet = fmap (hitSource . head . hits . searchHits) result
|
||||
myTweet `shouldBe` Right otherTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right otherTweet
|
||||
|
||||
|
||||
describe "filtering API" $ do
|
||||
it "returns document for composed boolmatch and identity" $ do
|
||||
it "returns document for composed boolmatch and identity" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
|
||||
<&&> IdentityFilter
|
||||
let search = mkSearch Nothing (Just queryFilter)
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "returns document for term filter" $ do
|
||||
it "returns document for term filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let termFilter = TermFilter (Term "user" "bitemyapp") False
|
||||
let search = mkSearch Nothing (Just termFilter)
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "returns document for existential filter" $ do
|
||||
it "returns document for existential filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "returns document for geo boundingbox filter" $ do
|
||||
it "returns document for geo boundingbox filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
|
||||
let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
|
||||
let geoFilter = GeoBoundingBoxFilter bbConstraint
|
||||
let search = mkSearch Nothing (Just geoFilter)
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "doesn't return document for nonsensical boundingbox filter" $ do
|
||||
it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
|
||||
let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
|
||||
@ -377,7 +396,7 @@ main = hspec $ do
|
||||
let search = mkSearch Nothing (Just geoFilter)
|
||||
searchExpectNoResults search
|
||||
|
||||
it "returns document for geo distance filter" $ do
|
||||
it "returns document for geo distance filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
|
||||
let distance = Distance 10.0 Miles
|
||||
@ -385,18 +404,20 @@ main = hspec $ do
|
||||
let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
|
||||
let search = mkSearch Nothing (Just geoFilter)
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "returns document for geo distance range filter" $ do
|
||||
it "returns document for geo distance range filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
|
||||
let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
|
||||
let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
|
||||
let search = mkSearch Nothing (Just geoFilter)
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "doesn't return document for wild geo distance range filter" $ do
|
||||
it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
|
||||
let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
|
||||
@ -404,7 +425,7 @@ main = hspec $ do
|
||||
let search = mkSearch Nothing (Just geoFilter)
|
||||
searchExpectNoResults search
|
||||
|
||||
it "returns document for geo polygon filter" $ do
|
||||
it "returns document for geo polygon filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let points = [LatLon 40.0 (-70.00),
|
||||
LatLon 40.0 (-72.00),
|
||||
@ -413,9 +434,10 @@ main = hspec $ do
|
||||
let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
|
||||
let search = mkSearch Nothing (Just geoFilter)
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "doesn't return document for bad geo polygon filter" $ do
|
||||
it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let points = [LatLon 40.0 (-70.00),
|
||||
LatLon 40.0 (-71.00),
|
||||
@ -425,23 +447,25 @@ main = hspec $ do
|
||||
let search = mkSearch Nothing (Just geoFilter)
|
||||
searchExpectNoResults search
|
||||
|
||||
it "returns document for ids filter" $ do
|
||||
it "returns document for ids filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let filter = IdsFilter (MappingName "tweet") [DocId "1"]
|
||||
let search = mkSearch Nothing (Just filter)
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "returns document for Double range filter" $ do
|
||||
it "returns document for Double range filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let filter = RangeFilter (FieldName "age")
|
||||
(RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
|
||||
RangeExecutionIndex False
|
||||
let search = mkSearch Nothing (Just filter)
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "returns document for UTCTime date filter" $ do
|
||||
it "returns document for UTCTime date filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let filter = RangeFilter (FieldName "postDate")
|
||||
(RangeDateGtLt
|
||||
@ -454,18 +478,20 @@ main = hspec $ do
|
||||
RangeExecutionIndex False
|
||||
let search = mkSearch Nothing (Just filter)
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
|
||||
it "returns document for regexp filter" $ do
|
||||
it "returns document for regexp filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
|
||||
AllRegexpFlags (CacheName "test") False (CacheKey "key")
|
||||
let search = mkSearch Nothing (Just filter)
|
||||
myTweet <- searchTweet search
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
liftIO $
|
||||
myTweet `shouldBe` Right exampleTweet
|
||||
|
||||
it "doesn't return document for non-matching regexp filter" $ do
|
||||
it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let filter = RegexpFilter (FieldName "user")
|
||||
(Regexp "boy") AllRegexpFlags
|
||||
@ -474,40 +500,40 @@ main = hspec $ do
|
||||
searchExpectNoResults search
|
||||
|
||||
describe "Aggregation API" $ do
|
||||
it "returns term aggregation results" $ do
|
||||
it "returns term aggregation results" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let terms = TermsAgg $ mkTermsAggregation "user"
|
||||
let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
|
||||
searchExpectAggs search
|
||||
searchValidBucketAgg search "users" toTerms
|
||||
|
||||
it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ do
|
||||
it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
|
||||
let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
|
||||
searchExpectAggs search
|
||||
searchValidBucketAgg search "users" toTerms
|
||||
|
||||
it "can give execution hint paramters to term aggregations" $ when' (atmost es11) $ do
|
||||
it "can give execution hint paramters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
searchTermsAggHint [Map, Ordinals]
|
||||
|
||||
it "can give execution hint paramters to term aggregations" $ when' (is es12) $ do
|
||||
it "can give execution hint paramters to term aggregations" $ when' (is es12) $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
|
||||
|
||||
it "can give execution hint paramters to term aggregations" $ when' (atleast es12) $ do
|
||||
it "can give execution hint paramters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
|
||||
|
||||
it "returns date histogram aggregation results" $ do
|
||||
it "returns date histogram aggregation results" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
|
||||
let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
|
||||
searchExpectAggs search
|
||||
searchValidBucketAgg search "byDate" toDateHistogram
|
||||
|
||||
it "returns date histogram using fractional date" $ do
|
||||
it "returns date histogram using fractional date" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
|
||||
let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
|
||||
@ -521,7 +547,7 @@ main = hspec $ do
|
||||
|
||||
describe "Highlights API" $ do
|
||||
|
||||
it "returns highlight from query when there should be one" $ do
|
||||
it "returns highlight from query when there should be one" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
_ <- insertOther
|
||||
let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
|
||||
@ -529,9 +555,10 @@ main = hspec $ do
|
||||
|
||||
let search = mkHighlightSearch (Just query) testHighlight
|
||||
myHighlight <- searchTweetHighlight search
|
||||
myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
|
||||
liftIO $
|
||||
myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
|
||||
|
||||
it "doesn't return highlight from a query when it shouldn't" $ do
|
||||
it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
|
||||
_ <- insertData
|
||||
_ <- insertOther
|
||||
let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
|
||||
@ -539,7 +566,8 @@ main = hspec $ do
|
||||
|
||||
let search = mkHighlightSearch (Just query) testHighlight
|
||||
myHighlight <- searchTweetHighlight search
|
||||
myHighlight `shouldBe` Right Nothing
|
||||
liftIO $
|
||||
myHighlight `shouldBe` Right Nothing
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user