diff --git a/bloodhound.cabal b/bloodhound.cabal --- a/bloodhound.cabal +++ b/bloodhound.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: bloodhound -version: 0.19.0.0 +version: 0.19.1.0 synopsis: Elasticsearch client library for Haskell description: Elasticsearch made awesome for Haskell hackers category: Database, Search @@ -44,12 +44,13 @@ Bloodhound.Import Database.Bloodhound.Common.Script Database.Bloodhound.Internal.Count + Database.Bloodhound.Internal.PointInTime Paths_bloodhound hs-source-dirs: src ghc-options: -Wall build-depends: - aeson >=0.11.1 + aeson >=2.0 , base >=4.14 && <5 , blaze-builder , bytestring >=0.10.0 @@ -98,7 +99,7 @@ ghc-options: -Wall -fno-warn-orphans build-depends: QuickCheck - , aeson >=0.11.1 + , aeson >=2.0 , base , blaze-builder , bloodhound @@ -106,6 +107,7 @@ , containers >=0.5.0.0 , errors , exceptions + , generic-random , hashable , hspec >=1.8 , http-client >=0.4.30 @@ -115,7 +117,6 @@ , mtl >=1.0 , network-uri >=2.6 , pretty-simple - , quickcheck-arbitrary-template , quickcheck-properties , scientific >=0.3.0.0 , semigroups >=0.15 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,13 @@ +0.19.1.0 +======== +- @TristanCacqueray + - Fix aeson 2 min bound dependency +- @andrewthad + - Support `edge_ngram` tokenizer and token, `ngram` and `edge_ngram` token filters + - Support sum aggregation +- @mirokuratczyk + - Point in time (PIT) API support + 0.19.0.0 ======== - @aveltras @@ -7,6 +17,7 @@ - Add Index mappings limits - Taking maintainer role - Drop GHC 8.0 - 8.8 support + - Use generic-random instead of quickcheck-arbitrary-template 0.18.0.0 ======== diff --git a/src/Database/Bloodhound/Client.hs b/src/Database/Bloodhound/Client.hs --- a/src/Database/Bloodhound/Client.hs +++ b/src/Database/Bloodhound/Client.hs @@ -64,6 +64,9 @@ , getInitialScroll , getInitialSortedScroll , advanceScroll + , pitSearch + , openPointInTime + , closePointInTime , refreshIndex , mkSearch , mkAggregateSearch @@ -277,6 +280,8 @@ -- Shortcut functions for HTTP methods delete :: MonadBH m => Text -> m Reply delete = flip (dispatch NHTM.methodDelete) Nothing +delete' :: MonadBH m => Text -> Maybe L.ByteString -> m Reply +delete' = dispatch NHTM.methodDelete get :: MonadBH m => Text -> m Reply get = flip (dispatch NHTM.methodGet) Nothing head :: MonadBH m => Text -> m Reply @@ -1186,16 +1191,16 @@ , "scroll_id" .= sid ] -simpleAccumulator :: +scanAccumulator :: (FromJSON a, MonadBH m, MonadThrow m) => [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId) -simpleAccumulator oldHits (newHits, Nothing) = return (oldHits ++ newHits, Nothing) -simpleAccumulator oldHits ([], _) = return (oldHits, Nothing) -simpleAccumulator oldHits (newHits, msid) = do +scanAccumulator oldHits (newHits, Nothing) = return (oldHits ++ newHits, Nothing) +scanAccumulator oldHits ([], _) = return (oldHits, Nothing) +scanAccumulator oldHits (newHits, msid) = do (newHits', msid') <- scroll' msid - simpleAccumulator (oldHits ++ newHits) (newHits', msid') + scanAccumulator (oldHits ++ newHits) (newHits', msid') -- | 'scanSearch' uses the 'scroll' API of elastic, -- for a given 'IndexName'. Note that this will @@ -1214,9 +1219,57 @@ let (hits', josh) = case initialSearchResult of Right SearchResult {..} -> (hits searchHits, scrollId) Left _ -> ([], Nothing) - (totalHits, _) <- simpleAccumulator [] (hits', josh) + (totalHits, _) <- scanAccumulator [] (hits', josh) return totalHits +pitAccumulator + :: (FromJSON a, MonadBH m, MonadThrow m) => Search -> [Hit a] -> m [Hit a] +pitAccumulator search oldHits = do + resp <- searchAll search + parsed <- parseEsResponse resp + case parsed of + Left _ -> return [] + Right searchResult -> case hits (searchHits searchResult) of + [] -> return oldHits + newHits -> case (hitSort $ last newHits, pitId searchResult) of + (Nothing, Nothing) -> + error "no point in time (PIT) ID or last sort value" + (Just _ , Nothing ) -> error "no point in time (PIT) ID" + (Nothing , _ ) -> return (oldHits <> newHits) + (Just lastSort, Just pitId') -> do + let newSearch = search { pointInTime = Just (PointInTime pitId' "1m") + , searchAfterKey = Just lastSort + } + pitAccumulator newSearch (oldHits <> newHits) + +-- | 'pitSearch' uses the point in time (PIT) API of elastic, for a given +-- 'IndexName'. Requires Elasticsearch >=7.10. Note that this will consume the +-- entire search result set and will be doing O(n) list appends so this may +-- not be suitable for large result sets. In that case, the point in time API +-- should be used directly with `openPointInTime` and `closePointInTime`. +-- +-- Note that 'pitSearch' utilizes the 'search_after' parameter under the hood, +-- which requires a non-empty 'sortBody' field in the provided 'Search' value. +-- Otherwise, 'pitSearch' will fail to return all matching documents. +-- +-- For more information see +-- . +pitSearch + :: (FromJSON a, MonadBH m, MonadThrow m) => IndexName -> Search -> m [Hit a] +pitSearch indexName search = do + openResp <- openPointInTime indexName + case openResp of + Left _ -> return [] + Right OpenPointInTimeResponse {..} -> do + let searchPIT = search { pointInTime = Just (PointInTime oPitId "1m") } + hits <- pitAccumulator searchPIT [] + closeResp <- closePointInTime $ ClosePointInTime oPitId + case closeResp of + Left _ -> return [] + Right (ClosePointInTimeResponse False _) -> + error "failed to close point in time (PIT)" + Right (ClosePointInTimeResponse True _) -> return hits + -- | '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 -- syntax if you want to add things like aggregations or highlights while still using @@ -1226,7 +1279,23 @@ -- >>> mkSearch (Just query) Nothing -- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, searchAfterKey = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing} mkSearch :: Maybe Query -> Maybe Filter -> Search -mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing Nothing Nothing +mkSearch query filter = Search + { queryBody = query + , filterBody = filter + , sortBody = Nothing + , aggBody = Nothing + , highlight = Nothing + , trackSortScores = False + , from = From 0 + , size = Size 10 + , searchType = SearchTypeQueryThenFetch + , searchAfterKey = Nothing + , fields = Nothing + , scriptFields = Nothing + , source = Nothing + , suggestBody = Nothing + , pointInTime = Nothing + } -- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for -- the 'Query' and the 'Aggregation'. @@ -1236,7 +1305,23 @@ -- 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 (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing Nothing Nothing Nothing +mkAggregateSearch query mkSearchAggs = Search + { queryBody = query + , filterBody = Nothing + , sortBody = Nothing + , aggBody = Just mkSearchAggs + , highlight = Nothing + , trackSortScores = False + , from = From 0 + , size = Size 0 + , searchType = SearchTypeQueryThenFetch + , searchAfterKey = Nothing + , fields = Nothing + , scriptFields = Nothing + , source = Nothing + , suggestBody = Nothing + , pointInTime = Nothing + } -- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for -- the 'Query' and the 'Aggregation'. @@ -1245,7 +1330,23 @@ -- >>> 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 (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing Nothing Nothing +mkHighlightSearch query searchHighlights = Search + { queryBody = query + , filterBody = Nothing + , sortBody = Nothing + , aggBody = Nothing + , highlight = Just searchHighlights + , trackSortScores = False + , from = From 0 + , size = Size 10 + , searchType = SearchTypeDfsQueryThenFetch + , searchAfterKey = Nothing + , fields = Nothing + , scriptFields = Nothing + , source = Nothing + , suggestBody = Nothing + , pointInTime = Nothing + } -- | 'mkSearchTemplate' is a helper function for defaulting additional fields of a 'SearchTemplate' -- to Nothing. Use record update syntax if you want to add things. @@ -1306,3 +1407,29 @@ countByIndex (IndexName indexName) q = do url <- joinPath [indexName, "_count"] parseEsResponse =<< post url (Just (encode q)) + +-- | 'openPointInTime' opens a point in time for an index given an 'IndexName'. +-- Note that the point in time should be closed with 'closePointInTime' as soon +-- as it is no longer needed. +-- +-- For more information see +-- . +openPointInTime + :: (MonadBH m, MonadThrow m) + => IndexName + -> m (Either EsError OpenPointInTimeResponse) +openPointInTime (IndexName indexName) = do + url <- joinPath [indexName, "_pit?keep_alive=1m"] + parseEsResponse =<< post url Nothing + +-- | 'closePointInTime' closes a point in time given a 'ClosePointInTime'. +-- +-- For more information see +-- . +closePointInTime + :: (MonadBH m, MonadThrow m) + => ClosePointInTime + -> m (Either EsError ClosePointInTimeResponse) +closePointInTime q = do + url <- joinPath ["_pit"] + parseEsResponse =<< delete' url (Just (encode q)) diff --git a/src/Database/Bloodhound/Common/Script.hs b/src/Database/Bloodhound/Common/Script.hs --- a/src/Database/Bloodhound/Common/Script.hs +++ b/src/Database/Bloodhound/Common/Script.hs @@ -1,11 +1,14 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} module Database.Bloodhound.Common.Script where -import Bloodhound.Import -import Data.Aeson.KeyMap +import Bloodhound.Import +import Data.Aeson.KeyMap +import GHC.Generics + import Database.Bloodhound.Internal.Newtypes newtype ScriptFields = @@ -15,16 +18,16 @@ type ScriptFieldValue = Value data ScriptSource = ScriptId Text - | ScriptInline Text deriving (Eq, Show) + | ScriptInline Text deriving (Eq, Show, Generic) data Script = Script { scriptLanguage :: Maybe ScriptLanguage , scriptSource :: ScriptSource , scriptParams :: Maybe ScriptParams - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) newtype ScriptLanguage = - ScriptLanguage Text deriving (Eq, Show, FromJSON, ToJSON) + ScriptLanguage Text deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype ScriptParams = ScriptParams (KeyMap ScriptParamValue) @@ -38,7 +41,7 @@ | BoostModeSum | BoostModeAvg | BoostModeMax - | BoostModeMin deriving (Eq, Show) + | BoostModeMin deriving (Eq, Show, Generic) data ScoreMode = ScoreModeMultiply @@ -46,29 +49,29 @@ | ScoreModeAvg | ScoreModeFirst | ScoreModeMax - | ScoreModeMin deriving (Eq, Show) + | ScoreModeMin deriving (Eq, Show, Generic) data FunctionScoreFunction = FunctionScoreFunctionScript Script | FunctionScoreFunctionRandom Seed | FunctionScoreFunctionFieldValueFactor FieldValueFactor - deriving (Eq, Show) + deriving (Eq, Show, Generic) newtype Weight = - Weight Float deriving (Eq, Show, FromJSON, ToJSON) + Weight Float deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype Seed = - Seed Float deriving (Eq, Show, FromJSON, ToJSON) + Seed Float deriving (Eq, Show, Generic, FromJSON, ToJSON) data FieldValueFactor = FieldValueFactor { fieldValueFactorField :: FieldName , fieldValueFactor :: Maybe Factor , fieldValueFactorModifier :: Maybe FactorModifier , fieldValueFactorMissing :: Maybe FactorMissingFieldValue - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) newtype Factor = - Factor Float deriving (Eq, Show, FromJSON, ToJSON) + Factor Float deriving (Eq, Show, Generic, FromJSON, ToJSON) data FactorModifier = FactorModifierNone @@ -80,10 +83,10 @@ | FactorModifierLn2p | FactorModifierSquare | FactorModifierSqrt - | FactorModifierReciprocal deriving (Eq, Show) + | FactorModifierReciprocal deriving (Eq, Show, Generic) newtype FactorMissingFieldValue = - FactorMissingFieldValue Float deriving (Eq, Show, FromJSON, ToJSON) + FactorMissingFieldValue Float deriving (Eq, Show, Generic, FromJSON, ToJSON) instance ToJSON BoostMode where toJSON BoostModeMultiply = "multiply" diff --git a/src/Database/Bloodhound/Internal/Aggregation.hs b/src/Database/Bloodhound/Internal/Aggregation.hs --- a/src/Database/Bloodhound/Internal/Aggregation.hs +++ b/src/Database/Bloodhound/Internal/Aggregation.hs @@ -34,6 +34,7 @@ | MissingAgg MissingAggregation | TopHitsAgg TopHitsAggregation | StatsAgg StatisticsAggregation + | SumAgg SumAggregation deriving (Eq, Show) instance ToJSON Aggregation where @@ -97,6 +98,9 @@ stType | typ == Basic = "stats" | otherwise = "extended_stats" + toJSON (SumAgg (SumAggregation (FieldName n))) = + omitNulls ["sum" .= omitNulls [ "field" .= n ] ] + data TopHitsAggregation = TopHitsAggregation { taFrom :: Maybe From , taSize :: Maybe Size @@ -181,6 +185,9 @@ data StatsType = Basic | Extended + deriving (Eq, Show) + +newtype SumAggregation = SumAggregation { sumAggregationField :: FieldName } deriving (Eq, Show) mkTermsAggregation :: Text -> TermsAggregation diff --git a/src/Database/Bloodhound/Internal/Analysis.hs b/src/Database/Bloodhound/Internal/Analysis.hs --- a/src/Database/Bloodhound/Internal/Analysis.hs +++ b/src/Database/Bloodhound/Internal/Analysis.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} @@ -7,6 +8,7 @@ import qualified Data.Map.Strict as M import qualified Data.Text as T +import GHC.Generics import Database.Bloodhound.Internal.Newtypes import Database.Bloodhound.Internal.StringlyTyped @@ -16,7 +18,7 @@ , analysisTokenizer :: M.Map Text TokenizerDefinition , analysisTokenFilter :: M.Map Text TokenFilterDefinition , analysisCharFilter :: M.Map Text CharFilterDefinition - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON Analysis where toJSON (Analysis analyzer tokenizer tokenFilter charFilter) = object @@ -35,13 +37,13 @@ newtype Tokenizer = Tokenizer Text - deriving (Eq, Show, ToJSON, FromJSON) + deriving (Eq, Show, Generic, ToJSON, FromJSON) data AnalyzerDefinition = AnalyzerDefinition { analyzerDefinitionTokenizer :: Maybe Tokenizer , analyzerDefinitionFilter :: [TokenFilter] , analyzerDefinitionCharFilter :: [CharFilter] - } deriving (Eq,Show) + } deriving (Eq,Show, Generic) instance ToJSON AnalyzerDefinition where toJSON (AnalyzerDefinition tokenizer tokenFilter charFilter) = @@ -92,34 +94,46 @@ <$> m .: "pattern" <*> m .: "replacement" <*> m .:? "flags" _ -> fail ("unrecognized character filter type: " ++ T.unpack t) -newtype TokenizerDefinition = - TokenizerDefinitionNgram Ngram - deriving (Eq,Show) +data TokenizerDefinition + = TokenizerDefinitionNgram Ngram + | TokenizerDefinitionEdgeNgram Ngram + deriving (Eq,Show, Generic) instance ToJSON TokenizerDefinition where - toJSON x = case x of - TokenizerDefinitionNgram (Ngram minGram maxGram tokenChars) -> object - [ "type" .= ("ngram" :: Text) - , "min_gram" .= minGram - , "max_gram" .= maxGram - , "token_chars" .= tokenChars - ] + toJSON x = + case x of + TokenizerDefinitionNgram ngram -> + object (["type" .= ("ngram" :: Text)] <> ngramToObject ngram) + TokenizerDefinitionEdgeNgram ngram -> + object (["type" .= ("edge_ngram" :: Text)] <> ngramToObject ngram) + where + ngramToObject (Ngram minGram maxGram tokenChars) = + [ "min_gram" .= minGram + , "max_gram" .= maxGram + , "token_chars" .= tokenChars + ] instance FromJSON TokenizerDefinition where parseJSON = withObject "TokenizerDefinition" $ \m -> do typ <- m .: "type" :: Parser Text case typ of - "ngram" -> fmap TokenizerDefinitionNgram $ Ngram - <$> fmap unStringlyTypedInt (m .: "min_gram") - <*> fmap unStringlyTypedInt (m .: "max_gram") - <*> m .: "token_chars" - _ -> fail "invalid TokenizerDefinition" + "ngram" -> + TokenizerDefinitionNgram <$> parseNgram m + "edge_ngram" -> + TokenizerDefinitionEdgeNgram <$> parseNgram m + _ -> fail $ "invalid TokenizerDefinition type: " <> T.unpack typ + where + parseNgram m = + Ngram + <$> fmap unStringlyTypedInt (m .: "min_gram") + <*> fmap unStringlyTypedInt (m .: "max_gram") + <*> m .: "token_chars" data Ngram = Ngram { ngramMinGram :: Int , ngramMaxGram :: Int , ngramTokenChars :: [TokenChar] - } deriving (Eq,Show) + } deriving (Eq,Show, Generic) data TokenChar = TokenLetter @@ -127,7 +141,7 @@ | TokenWhitespace | TokenPunctuation | TokenSymbol - deriving (Eq,Show) + deriving (Eq,Show, Generic) instance ToJSON TokenChar where toJSON t = String $ case t of @@ -156,7 +170,10 @@ | TokenFilterDefinitionShingle Shingle | TokenFilterDefinitionStemmer Language | TokenFilterDefinitionStop (Either Language [StopWord]) - deriving (Eq, Show) + | TokenFilterDefinitionEdgeNgram NgramFilter (Maybe EdgeNgramFilterSide) + | TokenFilterDefinitionNgram NgramFilter + | TokenFilterTruncate Int + deriving (Eq, Show, Generic) instance ToJSON TokenFilterDefinition where toJSON x = case x of @@ -197,6 +214,20 @@ Left lang -> String $ "_" <> languageToText lang <> "_" Right stops -> toJSON stops ] + TokenFilterDefinitionEdgeNgram ngram side -> object + ([ "type" .= ("edge_ngram" :: Text) + , "side" .= side + ] + <> ngramFilterToPairs ngram + ) + TokenFilterDefinitionNgram ngram -> object + (["type" .= ("ngram" :: Text)] + <> ngramFilterToPairs ngram + ) + TokenFilterTruncate n -> object + [ "type" .= ("truncate" :: Text) + , "length" .= n + ] instance FromJSON TokenFilterDefinition where parseJSON = withObject "TokenFilterDefinition" $ \m -> do @@ -230,8 +261,45 @@ . T.dropEnd 1 $ lang _ -> Right <$> parseJSON stop return (TokenFilterDefinitionStop stop') + "edge_ngram" -> TokenFilterDefinitionEdgeNgram + <$> ngramFilterFromJSONObject m + <*> m .: "side" + "ngram" -> TokenFilterDefinitionNgram <$> ngramFilterFromJSONObject m + "truncate" -> TokenFilterTruncate <$> m .:? "length" .!= 10 _ -> fail ("unrecognized token filter type: " ++ T.unpack t) +data NgramFilter + = NgramFilter { ngramFilterMinGram :: Int + , ngramFilterMaxGram :: Int + } + deriving (Eq, Show, Generic) + +ngramFilterToPairs :: NgramFilter -> [Pair] +ngramFilterToPairs (NgramFilter minGram maxGram) = + ["min_gram" .= minGram, "max_gram" .= maxGram] + +ngramFilterFromJSONObject :: Object -> Parser NgramFilter +ngramFilterFromJSONObject o = + NgramFilter + <$> o .: "min_gram" .!= 1 + <*> o .: "max_gram" .!= 2 + +data EdgeNgramFilterSide + = EdgeNgramFilterSideFront + | EdgeNgramFilterSideBack + deriving (Eq, Show, Generic) + +instance ToJSON EdgeNgramFilterSide where + toJSON EdgeNgramFilterSideFront = String "front" + toJSON EdgeNgramFilterSideBack = String "back" + +instance FromJSON EdgeNgramFilterSide where + parseJSON = withText "EdgeNgramFilterSide" $ \t -> + case t of + "front" -> pure EdgeNgramFilterSideFront + "back" -> pure EdgeNgramFilterSideBack + _ -> fail $ "EdgeNgramFilterSide can only be 'front' or 'back', found: " <> T.unpack t + -- | The set of languages that can be passed to various analyzers, -- filters, etc. in Elasticsearch. Most data types in this module -- that have a 'Language' field are actually only actually to @@ -276,7 +344,7 @@ | Swedish | Thai | Turkish - deriving (Eq, Show) + deriving (Eq, Show, Generic) instance ToJSON Language where toJSON = String . languageToText @@ -376,4 +444,4 @@ , shingleOutputUnigramsIfNoShingles :: Bool , shingleTokenSeparator :: Text , shingleFillerToken :: Text - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) diff --git a/src/Database/Bloodhound/Internal/Client.hs b/src/Database/Bloodhound/Internal/Client.hs --- a/src/Database/Bloodhound/Internal/Client.hs +++ b/src/Database/Bloodhound/Internal/Client.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -22,6 +23,7 @@ import Network.HTTP.Client import Text.Read (Read (..)) import qualified Text.Read as TR +import GHC.Generics import Database.Bloodhound.Internal.Analysis import Database.Bloodhound.Internal.Newtypes @@ -102,7 +104,7 @@ , build_date :: UTCTime , build_snapshot :: Bool , lucene_version :: VersionNumber } - deriving (Eq, Show) + deriving (Eq, Show, Generic) -- | Traditional software versioning number newtype VersionNumber = VersionNumber @@ -142,7 +144,7 @@ { indexShards :: ShardCount , indexReplicas :: ReplicaCount , indexMappingsLimits :: IndexMappingsLimits } - deriving (Eq, Show) + deriving (Eq, Show, Generic) instance ToJSON IndexSettings where toJSON (IndexSettings s r l) = object ["settings" .= @@ -176,7 +178,7 @@ , indexMappingsLimitNestedFields :: Maybe Int , indexMappingsLimitNestedObjects :: Maybe Int , indexMappingsLimitFieldNameLength :: Maybe Int } - deriving (Eq, Show) + deriving (Eq, Show, Generic) instance ToJSON IndexMappingsLimits where toJSON (IndexMappingsLimits d f o n) = object $ @@ -280,7 +282,7 @@ -- ^ Analysis is not a dynamic setting and can only be performed on a closed index. | UnassignedNodeLeftDelayedTimeout NominalDiffTime -- ^ Sets a delay to the allocation of replica shards which become unassigned because a node has left, giving them chance to return. See - deriving (Eq, Show) + deriving (Eq, Show, Generic) attrFilterJSON :: NonEmpty NodeAttrFilter -> Value attrFilterJSON fs = object [ fromText n .= T.intercalate "," (toList vs) @@ -432,7 +434,7 @@ -- ^ Compress with DEFLATE. Elastic -- -- that this can reduce disk use by 15%-25%. - deriving (Eq,Show) + deriving (Eq,Show, Generic) instance ToJSON Compression where toJSON x = case x of @@ -458,7 +460,7 @@ -- Bytes 9000 newtype Bytes = Bytes Int - deriving (Eq, Show, Ord, ToJSON, FromJSON) + deriving (Eq, Show, Generic, Ord, ToJSON, FromJSON) gigabytes :: Int -> Bytes gigabytes n = megabytes (1000 * n) @@ -473,7 +475,7 @@ data FSType = FSSimple - | FSBuffered deriving (Eq, Show) + | FSBuffered deriving (Eq, Show, Generic) instance ToJSON FSType where toJSON FSSimple = "simple" @@ -490,7 +492,7 @@ | FullShards | FullMinus1Shards | ExplicitShards Int - deriving (Eq, Show) + deriving (Eq, Show, Generic) instance FromJSON InitialShardCount where parseJSON v = withText "InitialShardCount" parseText v @@ -518,7 +520,7 @@ data CompoundFormat = CompoundFileFormat Bool | MergeSegmentVsTotalIndex Double -- ^ percentage between 0 and 1 where 0 is false, 1 is true - deriving (Eq, Show) + deriving (Eq, Show, Generic) instance ToJSON CompoundFormat where toJSON (CompoundFileFormat x) = Bool x @@ -652,7 +654,7 @@ -- ^ Allows shard allocation only for primary shards for new indices. | AllocNone -- ^ No shard allocation is allowed - deriving (Eq, Show) + deriving (Eq, Show, Generic) instance ToJSON AllocationPolicy where toJSON AllocAll = String "all" @@ -784,7 +786,7 @@ newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) - deriving (Eq, Show) + deriving (Eq, Show, Generic) instance ToJSON SearchAliasRouting where toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs)) @@ -795,7 +797,7 @@ newtype IndexAliasRouting = IndexAliasRouting RoutingValue - deriving (Eq, Show, ToJSON, FromJSON) + deriving (Eq, Show, Generic, ToJSON, FromJSON) newtype RoutingValue = RoutingValue { routingValue :: Text } @@ -989,11 +991,11 @@ {-| 'TemplateName' is used to describe which template to query/create/delete -} -newtype TemplateName = TemplateName Text deriving (Eq, Show, ToJSON, FromJSON) +newtype TemplateName = TemplateName Text deriving (Eq, Show, Generic, ToJSON, FromJSON) {-| 'IndexPattern' represents a pattern which is matched against index names -} -newtype IndexPattern = IndexPattern Text deriving (Eq, Show, ToJSON, FromJSON) +newtype IndexPattern = IndexPattern Text deriving (Eq, Show, Generic, ToJSON, FromJSON) -- | Username type used for HTTP Basic authentication. See 'basicAuthHook'. newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq) @@ -1018,7 +1020,7 @@ -- | The unique name of a snapshot repository. newtype SnapshotRepoName = SnapshotRepoName { snapshotRepoName :: Text } - deriving (Eq, Ord, Show, ToJSON, FromJSON) + deriving (Eq, Ord, Show, Generic, ToJSON, FromJSON) -- | A generic representation of a snapshot repo. This is what gets @@ -1351,7 +1353,7 @@ -- | Typically a 7 character hex string. newtype BuildHash = BuildHash { buildHash :: Text } - deriving (Eq, Ord, Show, FromJSON, ToJSON) + deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON) newtype PluginName = PluginName { pluginName :: Text } deriving (Eq, Ord, Show, FromJSON) @@ -1630,7 +1632,7 @@ -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec , fsrMaxSnapshotBytesPerSec :: Maybe Bytes -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance SnapshotRepo FsSnapshotRepo where diff --git a/src/Database/Bloodhound/Internal/Newtypes.hs b/src/Database/Bloodhound/Internal/Newtypes.hs --- a/src/Database/Bloodhound/Internal/Newtypes.hs +++ b/src/Database/Bloodhound/Internal/Newtypes.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} @@ -6,9 +7,10 @@ import Bloodhound.Import import qualified Data.Map.Strict as M +import GHC.Generics newtype From = From Int deriving (Eq, Show, ToJSON) -newtype Size = Size Int deriving (Eq, Show, ToJSON, FromJSON) +newtype Size = Size Int deriving (Eq, Show, Generic, ToJSON, FromJSON) -- Used with scripts newtype HitFields = @@ -31,7 +33,7 @@ -} newtype DocId = DocId Text - deriving (Eq, Show, ToJSON, FromJSON) + deriving (Eq, Show, Generic, ToJSON, FromJSON) {-| '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. @@ -45,13 +47,13 @@ -} newtype RelationName = RelationName Text - deriving (Eq, Read, Show, ToJSON, FromJSON) + deriving (Eq, Read, Show, Generic, ToJSON, FromJSON) {-| 'QueryString' is used to wrap query text bodies, be they human written or not. -} newtype QueryString = QueryString Text - deriving (Eq, Show, ToJSON, FromJSON) + deriving (Eq, Show, Generic, ToJSON, FromJSON) -- {-| 'Script' is often used in place of 'FieldName' to specify more @@ -66,106 +68,106 @@ -} newtype CacheName = CacheName Text - deriving (Eq, Show, FromJSON, ToJSON) + deriving (Eq, Show, Generic, FromJSON, ToJSON) {-| 'CacheKey' is used in 'RegexpFilter' to key regex caching. -} newtype CacheKey = - CacheKey Text deriving (Eq, Show, FromJSON, ToJSON) + CacheKey Text deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype Existence = - Existence Bool deriving (Eq, Show, FromJSON, ToJSON) + Existence Bool deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype NullValue = - NullValue Bool deriving (Eq, Show, FromJSON, ToJSON) + NullValue Bool deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype CutoffFrequency = - CutoffFrequency Double deriving (Eq, Show, FromJSON, ToJSON) + CutoffFrequency Double deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype Analyzer = - Analyzer Text deriving (Eq, Show, FromJSON, ToJSON) + Analyzer Text deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype MaxExpansions = - MaxExpansions Int deriving (Eq, Show, FromJSON, ToJSON) + MaxExpansions Int deriving (Eq, Generic, Show, FromJSON, ToJSON) {-| '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, FromJSON, ToJSON) + Lenient Bool deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype Tiebreaker = - Tiebreaker Double deriving (Eq, Show, FromJSON, ToJSON) + Tiebreaker Double deriving (Eq, Show, Generic, FromJSON, ToJSON) {-| '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, FromJSON, ToJSON) + MinimumMatch Int deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype DisableCoord = - DisableCoord Bool deriving (Eq, Show, FromJSON, ToJSON) + DisableCoord Bool deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype IgnoreTermFrequency = - IgnoreTermFrequency Bool deriving (Eq, Show, FromJSON, ToJSON) + IgnoreTermFrequency Bool deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype MinimumTermFrequency = - MinimumTermFrequency Int deriving (Eq, Show, FromJSON, ToJSON) + MinimumTermFrequency Int deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype MaxQueryTerms = - MaxQueryTerms Int deriving (Eq, Show, FromJSON, ToJSON) + MaxQueryTerms Int deriving (Eq, Show, Generic, FromJSON, ToJSON) {-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -} newtype PrefixLength = - PrefixLength Int deriving (Eq, Show, FromJSON, ToJSON) + PrefixLength Int deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype PercentMatch = - PercentMatch Double deriving (Eq, Show, FromJSON, ToJSON) + PercentMatch Double deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype StopWord = - StopWord Text deriving (Eq, Show, FromJSON, ToJSON) + StopWord Text deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype QueryPath = - QueryPath Text deriving (Eq, Show, FromJSON, ToJSON) + QueryPath Text deriving (Eq, Show, Generic, FromJSON, ToJSON) {-| 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, FromJSON, ToJSON) + AllowLeadingWildcard Bool deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype LowercaseExpanded = - LowercaseExpanded Bool deriving (Eq, Show, FromJSON, ToJSON) + LowercaseExpanded Bool deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype EnablePositionIncrements = - EnablePositionIncrements Bool deriving (Eq, Show, FromJSON, ToJSON) + EnablePositionIncrements Bool deriving (Eq, Show, Generic, FromJSON, ToJSON) {-| 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, FromJSON, ToJSON) +newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Show, Generic, FromJSON, ToJSON) {-| 'GeneratePhraseQueries' defaults to false. -} newtype GeneratePhraseQueries = - GeneratePhraseQueries Bool deriving (Eq, Show, FromJSON, ToJSON) + GeneratePhraseQueries Bool deriving (Eq, Show, Generic, FromJSON, ToJSON) {-| 'Locale' is used for string conversions - defaults to ROOT. -} -newtype Locale = Locale Text deriving (Eq, Show, FromJSON, ToJSON) -newtype MaxWordLength = MaxWordLength Int deriving (Eq, Show, FromJSON, ToJSON) -newtype MinWordLength = MinWordLength Int deriving (Eq, Show, FromJSON, ToJSON) +newtype Locale = Locale Text deriving (Eq, Show, Generic, FromJSON, ToJSON) +newtype MaxWordLength = MaxWordLength Int deriving (Eq, Show, Generic, FromJSON, ToJSON) +newtype MinWordLength = MinWordLength Int deriving (Eq, Show, Generic, FromJSON, ToJSON) {-| 'PhraseSlop' sets the default slop for phrases, 0 means exact phrase matches. Default is 0. -} -newtype PhraseSlop = PhraseSlop Int deriving (Eq, Show, FromJSON, ToJSON) -newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Show, FromJSON, ToJSON) -newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, FromJSON, ToJSON) +newtype PhraseSlop = PhraseSlop Int deriving (Eq, Show, Generic, FromJSON, ToJSON) +newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Show, Generic, FromJSON, ToJSON) +newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, Generic, FromJSON, ToJSON) -- | Indicates whether the relevance score of a matching parent document is aggregated into its child documents. -newtype AggregateParentScore = AggregateParentScore Bool deriving (Eq, Show, FromJSON, ToJSON) +newtype AggregateParentScore = AggregateParentScore Bool deriving (Eq, Show, Generic, FromJSON, ToJSON) -- | Indicates whether to ignore an unmapped parent_type and not return any documents instead of an error. -newtype IgnoreUnmapped = IgnoreUnmapped Bool deriving (Eq, Show, FromJSON, ToJSON) +newtype IgnoreUnmapped = IgnoreUnmapped Bool deriving (Eq, Show, Generic, FromJSON, ToJSON) {-| Maximum number of child documents that match the query allowed for a returned parent document. If the parent document exceeds this limit, it is excluded from the search results. -} -newtype MinChildren = MinChildren Int deriving (Eq, Show, FromJSON, ToJSON) +newtype MinChildren = MinChildren Int deriving (Eq, Show, Generic, FromJSON, ToJSON) {-| Minimum number of child documents that match the query required to match the query for a returned parent document. If the parent document does not meet this limit, it is excluded from the search results. -} -newtype MaxChildren = MaxChildren Int deriving (Eq, Show, FromJSON, ToJSON) +newtype MaxChildren = MaxChildren Int deriving (Eq, Show, Generic, FromJSON, ToJSON) -- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ newtype POSIXMS = POSIXMS { posixMS :: UTCTime } @@ -178,21 +180,21 @@ newtype Boost = Boost Double - deriving (Eq, Show, ToJSON, FromJSON) + deriving (Eq, Show, Generic, ToJSON, FromJSON) newtype BoostTerms = BoostTerms Double - deriving (Eq, Show, ToJSON, FromJSON) + deriving (Eq, Show, Generic, ToJSON, FromJSON) {-| 'ReplicaCount' is part of 'IndexSettings' -} newtype ReplicaCount = ReplicaCount Int - deriving (Eq, Show, ToJSON) + deriving (Eq, Show, Generic, ToJSON) {-| 'ShardCount' is part of 'IndexSettings' -} newtype ShardCount = ShardCount Int - deriving (Eq, Show, ToJSON) + deriving (Eq, Show, Generic, ToJSON) -- This insanity is because ES *sometimes* returns Replica/Shard counts as strings instance FromJSON ReplicaCount where @@ -210,7 +212,7 @@ {-| 'IndexName' is used to describe which index to query/create/delete -} newtype IndexName = IndexName Text - deriving (Eq, Show, ToJSON, FromJSON) + deriving (Eq, Show, Generic, ToJSON, FromJSON) newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } @@ -242,8 +244,8 @@ newtype TokenFilter = TokenFilter Text - deriving (Eq, Show, FromJSON, ToJSON) + deriving (Eq, Show, Generic, FromJSON, ToJSON) newtype CharFilter = CharFilter Text - deriving (Eq, Show, FromJSON, ToJSON) + deriving (Eq, Show, Generic, FromJSON, ToJSON) diff --git a/src/Database/Bloodhound/Internal/PointInTime.hs b/src/Database/Bloodhound/Internal/PointInTime.hs new file mode 100644 --- /dev/null +++ b/src/Database/Bloodhound/Internal/PointInTime.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} + +module Database.Bloodhound.Internal.PointInTime where + +import Bloodhound.Import + +data PointInTime = PointInTime + { pPitId :: Text + , keepAlive :: Text + } deriving (Eq, Show) + +instance ToJSON PointInTime where + toJSON PointInTime{..} = + object [ "id" .= pPitId + , "keep_alive" .= keepAlive ] + +instance FromJSON PointInTime where + parseJSON (Object o) = PointInTime <$> o .: "id" <*> o .: "keep_alive" + parseJSON x = typeMismatch "PointInTime" x + +data OpenPointInTimeResponse = OpenPointInTimeResponse { + oPitId :: Text +} deriving (Eq, Show) + +instance ToJSON OpenPointInTimeResponse where + toJSON OpenPointInTimeResponse{..} = + object [ "id" .= oPitId] + +instance FromJSON OpenPointInTimeResponse where + parseJSON (Object o) = OpenPointInTimeResponse <$> o .: "id" + parseJSON x = typeMismatch "OpenPointInTimeResponse" x + +data ClosePointInTime = ClosePointInTime { + cPitId :: Text +} deriving (Eq, Show) + +instance ToJSON ClosePointInTime where + toJSON ClosePointInTime{..} = + object [ "id" .= cPitId] + +instance FromJSON ClosePointInTime where + parseJSON (Object o) = ClosePointInTime <$> o .: "id" + parseJSON x = typeMismatch "ClosePointInTime" x + +data ClosePointInTimeResponse = ClosePointInTimeResponse { + succeeded :: Bool, + numFreed :: Int +} deriving (Eq, Show) + +instance ToJSON ClosePointInTimeResponse where + toJSON ClosePointInTimeResponse{..} = + object [ "succeeded" .= succeeded + , "num_freed" .= numFreed] + +instance FromJSON ClosePointInTimeResponse where + parseJSON (Object o) = do + succeeded' <- o .: "succeeded" + numFreed' <- o .: "num_freed" + return $ ClosePointInTimeResponse succeeded' numFreed' + parseJSON x = typeMismatch "ClosePointInTimeResponse" x diff --git a/src/Database/Bloodhound/Internal/Query.hs b/src/Database/Bloodhound/Internal/Query.hs --- a/src/Database/Bloodhound/Internal/Query.hs +++ b/src/Database/Bloodhound/Internal/Query.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -12,6 +13,7 @@ import qualified Data.Aeson.KeyMap as X import qualified Data.HashMap.Strict as HM import qualified Data.Text as T +import GHC.Generics import Database.Bloodhound.Common.Script as X import Database.Bloodhound.Internal.Newtypes @@ -46,7 +48,7 @@ | QueryExistsQuery FieldName | QueryMatchNoneQuery | QueryWildcardQuery WildcardQuery - deriving (Eq, Show) + deriving (Eq, Show, Generic) instance ToJSON Query where toJSON (TermQuery (Term termQueryField termQueryValue) boost) = @@ -229,7 +231,7 @@ , regexpQuery :: Regexp , regexpQueryFlags :: RegexpFlags , regexpQueryBoost :: Maybe Boost - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON RegexpQuery where toJSON (RegexpQuery (FieldName rqQueryField) @@ -252,7 +254,7 @@ WildcardQuery { wildcardQueryField :: FieldName , wildcardQuery :: Key , wildcardQueryBoost :: Maybe Boost - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON WildcardQuery where toJSON (WildcardQuery (FieldName wcQueryField) @@ -271,7 +273,7 @@ data RangeQuery = RangeQuery { rangeQueryField :: FieldName , rangeQueryRange :: RangeValue - , rangeQueryBoost :: Boost } deriving (Eq, Show) + , rangeQueryBoost :: Boost } deriving (Eq, Show, Generic) instance ToJSON RangeQuery where toJSON (RangeQuery (FieldName fieldName) range boost) = @@ -298,7 +300,7 @@ , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag) , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded , simpleQueryStringLocale :: Maybe Locale - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON SimpleQueryStringQuery where @@ -336,7 +338,7 @@ | SimpleQueryWhitespace | SimpleQueryFuzzy | SimpleQueryNear - | SimpleQuerySlop deriving (Eq, Show) + | SimpleQuerySlop deriving (Eq, Show, Generic) instance ToJSON SimpleQueryFlag where toJSON SimpleQueryAll = "ALL" @@ -388,7 +390,7 @@ , queryStringMinimumShouldMatch :: Maybe MinimumMatch , queryStringLenient :: Maybe Lenient , queryStringLocale :: Maybe Locale - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON QueryStringQuery where @@ -451,7 +453,7 @@ Nothing Nothing data FieldOrFields = FofField FieldName - | FofFields (NonEmpty FieldName) deriving (Eq, Show) + | FofFields (NonEmpty FieldName) deriving (Eq, Show, Generic) instance ToJSON FieldOrFields where toJSON (FofField fieldName) = @@ -467,7 +469,7 @@ PrefixQuery { prefixQueryField :: FieldName , prefixQueryPrefixValue :: Text - , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show) + , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show, Generic) instance ToJSON PrefixQuery where toJSON (PrefixQuery (FieldName fieldName) queryValue boost) = @@ -487,7 +489,7 @@ { nestedQueryPath :: QueryPath , nestedQueryScoreType :: ScoreType , nestedQuery :: Query - , nestedQueryInnerHits :: Maybe InnerHits } deriving (Eq, Show) + , nestedQueryInnerHits :: Maybe InnerHits } deriving (Eq, Show, Generic) instance ToJSON NestedQuery where toJSON (NestedQuery nqPath nqScoreType nqQuery nqInnerHits) = @@ -521,7 +523,7 @@ , moreLikeThisFieldBoostTerms :: Maybe BoostTerms , moreLikeThisFieldBoost :: Maybe Boost , moreLikeThisFieldAnalyzer :: Maybe Analyzer - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON MoreLikeThisFieldQuery where @@ -578,7 +580,7 @@ , moreLikeThisBoostTerms :: Maybe BoostTerms , moreLikeThisBoost :: Maybe Boost , moreLikeThisAnalyzer :: Maybe Analyzer - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON MoreLikeThisQuery where @@ -625,7 +627,7 @@ { indicesQueryIndices :: [IndexName] , indicesQuery :: Query -- default "all" - , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show) + , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show, Generic) instance ToJSON IndicesQuery where @@ -647,7 +649,7 @@ , hasParentQuery :: Query , hasParentQueryScore :: Maybe AggregateParentScore , hasParentIgnoreUnmapped :: Maybe IgnoreUnmapped - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON HasParentQuery where toJSON (HasParentQuery queryType query scoreType ignoreUnmapped) = @@ -673,7 +675,7 @@ , hasChildIgnoreUnmappped :: Maybe IgnoreUnmapped , hasChildMinChildren :: Maybe MinChildren , hasChildMaxChildren :: Maybe MaxChildren - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON HasChildQuery where toJSON (HasChildQuery queryType query scoreType ignoreUnmapped minChildren maxChildren) = @@ -699,7 +701,7 @@ ScoreTypeMax | ScoreTypeSum | ScoreTypeAvg - | ScoreTypeNone deriving (Eq, Show) + | ScoreTypeNone deriving (Eq, Show, Generic) instance ToJSON ScoreType where toJSON ScoreTypeMax = "max" @@ -722,7 +724,7 @@ , fuzzyQueryMaxExpansions :: MaxExpansions , fuzzyQueryFuzziness :: Fuzziness , fuzzyQueryBoost :: Maybe Boost - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON FuzzyQuery where @@ -756,7 +758,7 @@ , fuzzyLikeFieldPrefixLength :: PrefixLength , fuzzyLikeFieldBoost :: Boost , fuzzyLikeFieldAnalyzer :: Maybe Analyzer - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON FuzzyLikeFieldQuery where @@ -794,7 +796,7 @@ , fuzzyLikePrefixLength :: PrefixLength , fuzzyLikeBoost :: Boost , fuzzyLikeAnalyzer :: Maybe Analyzer - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON FuzzyLikeThisQuery where @@ -827,7 +829,7 @@ -- default 0.0 , disMaxTiebreaker :: Tiebreaker , disMaxBoost :: Maybe Boost - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON DisMaxQuery where @@ -857,7 +859,7 @@ , matchQueryBoost :: Maybe Boost , matchQueryMinimumShouldMatch :: Maybe Text , matchQueryFuzziness :: Maybe Fuzziness - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON MatchQuery where @@ -905,7 +907,7 @@ data MatchQueryType = MatchPhrase - | MatchPhrasePrefix deriving (Eq, Show) + | MatchPhrasePrefix deriving (Eq, Show, Generic) instance ToJSON MatchQueryType where toJSON MatchPhrase = "phrase" @@ -928,7 +930,7 @@ , multiMatchQueryAnalyzer :: Maybe Analyzer , multiMatchQueryMaxExpansions :: Maybe MaxExpansions , multiMatchQueryLenient :: Maybe Lenient - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON MultiMatchQuery where toJSON (MultiMatchQuery fields (QueryString query) boolOp @@ -975,7 +977,7 @@ | MultiMatchMostFields | MultiMatchCrossFields | MultiMatchPhrase - | MultiMatchPhrasePrefix deriving (Eq, Show) + | MultiMatchPhrasePrefix deriving (Eq, Show, Generic) instance ToJSON MultiMatchQueryType where toJSON MultiMatchBestFields = "best_fields" @@ -1001,7 +1003,7 @@ , boolQueryMinimumShouldMatch :: Maybe MinimumMatch , boolQueryBoost :: Maybe Boost , boolQueryDisableCoord :: Maybe DisableCoord - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON BoolQuery where @@ -1033,7 +1035,7 @@ data BoostingQuery = BoostingQuery { positiveQuery :: Query , negativeQuery :: Query - , negativeBoost :: Boost } deriving (Eq, Show) + , negativeBoost :: Boost } deriving (Eq, Show, Generic) instance ToJSON BoostingQuery where toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) = @@ -1058,7 +1060,7 @@ , commonBoost :: Maybe Boost , commonAnalyzer :: Maybe Analyzer , commonDisableCoord :: Maybe DisableCoord - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON CommonTermsQuery where @@ -1091,7 +1093,7 @@ data CommonMinimumMatch = CommonMinimumMatchHighLow MinimumMatchHighLow | CommonMinimumMatch MinimumMatch - deriving (Eq, Show) + deriving (Eq, Show, Generic) instance ToJSON CommonMinimumMatch where @@ -1111,11 +1113,11 @@ data MinimumMatchHighLow = MinimumMatchHighLow { lowFreq :: MinimumMatch - , highFreq :: MinimumMatch } deriving (Eq, Show) + , highFreq :: MinimumMatch } deriving (Eq, Show, Generic) data ZeroTermsQuery = ZeroTermsNone - | ZeroTermsAll deriving (Eq, Show) + | ZeroTermsAll deriving (Eq, Show, Generic) instance ToJSON ZeroTermsQuery where toJSON ZeroTermsNone = String "none" @@ -1128,7 +1130,7 @@ parse q = fail ("Unexpected ZeroTermsQuery: " <> show q) data RangeExecution = RangeExecutionIndex - | RangeExecutionFielddata deriving (Eq, Show) + | RangeExecutionFielddata deriving (Eq, Show, Generic) -- index for smaller ranges, fielddata for longer ranges instance ToJSON RangeExecution where @@ -1142,11 +1144,11 @@ parse "fielddata" = pure RangeExecutionFielddata parse t = error ("Unrecognized RangeExecution " <> show t) -newtype Regexp = Regexp Text deriving (Eq, Show, FromJSON) +newtype Regexp = Regexp Text deriving (Eq, Show, Generic, FromJSON) data RegexpFlags = AllRegexpFlags | NoRegexpFlags - | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show) + | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show, Generic) instance ToJSON RegexpFlags where toJSON AllRegexpFlags = String "ALL" @@ -1171,7 +1173,7 @@ | Complement | Empty | Intersection - | Interval deriving (Eq, Show) + | Interval deriving (Eq, Show, Generic) instance FromJSON RegexpFlag where parseJSON = withText "RegexpFlag" parse @@ -1183,15 +1185,15 @@ parse "INTERVAL" = pure Interval parse f = fail ("Unknown RegexpFlag: " <> show f) -newtype LessThan = LessThan Double deriving (Eq, Show) -newtype LessThanEq = LessThanEq Double deriving (Eq, Show) -newtype GreaterThan = GreaterThan Double deriving (Eq, Show) -newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Show) +newtype LessThan = LessThan Double deriving (Eq, Show, Generic) +newtype LessThanEq = LessThanEq Double deriving (Eq, Show, Generic) +newtype GreaterThan = GreaterThan Double deriving (Eq, Show, Generic) +newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Show, Generic) -newtype LessThanD = LessThanD UTCTime deriving (Eq, Show) -newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Show) -newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Show) -newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Show) +newtype LessThanD = LessThanD UTCTime deriving (Eq, Show, Generic) +newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Show, Generic) +newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Show, Generic) +newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Show, Generic) data RangeValue = RangeDateLte LessThanEqD | RangeDateLt LessThanD @@ -1209,7 +1211,7 @@ | RangeDoubleGteLte GreaterThanEq LessThanEq | RangeDoubleGteLt GreaterThanEq LessThan | RangeDoubleGtLte GreaterThan LessThanEq - deriving (Eq, Show) + deriving (Eq, Show, Generic) parseRangeValue :: ( FromJSON t4 @@ -1303,7 +1305,7 @@ RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g] data Term = Term { termField :: Key - , termValue :: Text } deriving (Eq, Show) + , termValue :: Text } deriving (Eq, Show, Generic) instance ToJSON Term where toJSON (Term field value) = object ["term" .= object @@ -1318,7 +1320,7 @@ data BoolMatch = MustMatch Term Cache | MustNotMatch Term Cache - | ShouldMatch [Term] Cache deriving (Eq, Show) + | ShouldMatch [Term] Cache deriving (Eq, Show, Generic) instance ToJSON BoolMatch where @@ -1341,7 +1343,7 @@ -- "memory" or "indexed" data GeoFilterType = GeoFilterMemory - | GeoFilterIndexed deriving (Eq, Show) + | GeoFilterIndexed deriving (Eq, Show, Generic) instance ToJSON GeoFilterType where toJSON GeoFilterMemory = String "memory" @@ -1354,7 +1356,7 @@ parse t = fail ("Unrecognized GeoFilterType: " <> show t) data LatLon = LatLon { lat :: Double - , lon :: Double } deriving (Eq, Show) + , lon :: Double } deriving (Eq, Show, Generic) instance ToJSON LatLon where toJSON (LatLon lLat lLon) = @@ -1368,7 +1370,7 @@ data GeoBoundingBox = GeoBoundingBox { topLeft :: LatLon - , bottomRight :: LatLon } deriving (Eq, Show) + , bottomRight :: LatLon } deriving (Eq, Show, Generic) instance ToJSON GeoBoundingBox where toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) = @@ -1386,7 +1388,7 @@ , constraintBox :: GeoBoundingBox , bbConstraintcache :: Cache , geoType :: GeoFilterType - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON GeoBoundingBoxConstraint where toJSON (GeoBoundingBoxConstraint @@ -1406,7 +1408,7 @@ data GeoPoint = GeoPoint { geoField :: FieldName - , latLon :: LatLon} deriving (Eq, Show) + , latLon :: LatLon} deriving (Eq, Show, Generic) instance ToJSON GeoPoint where toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) = @@ -1420,7 +1422,7 @@ | Meters | Centimeters | Millimeters - | NauticalMiles deriving (Eq, Show) + | NauticalMiles deriving (Eq, Show, Generic) instance ToJSON DistanceUnit where toJSON Miles = String "mi" @@ -1448,7 +1450,7 @@ data DistanceType = Arc | SloppyArc -- doesn't exist <1.0 - | Plane deriving (Eq, Show) + | Plane deriving (Eq, Show, Generic) instance ToJSON DistanceType where toJSON Arc = String "arc" @@ -1463,7 +1465,7 @@ parse t = fail ("Unrecognized DistanceType: " <> show t) data OptimizeBbox = OptimizeGeoFilterType GeoFilterType - | NoOptimizeBbox deriving (Eq, Show) + | NoOptimizeBbox deriving (Eq, Show, Generic) instance ToJSON OptimizeBbox where @@ -1479,7 +1481,7 @@ data Distance = Distance { coefficient :: Double - , unit :: DistanceUnit } deriving (Eq, Show) + , unit :: DistanceUnit } deriving (Eq, Show, Generic) instance ToJSON Distance where @@ -1504,7 +1506,7 @@ data DistanceRange = DistanceRange { distanceFrom :: Distance - , distanceTo :: Distance } deriving (Eq, Show) + , distanceTo :: Distance } deriving (Eq, Show, Generic) type TemplateQueryValue = Text @@ -1526,7 +1528,7 @@ {-| '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) +data BooleanOperator = And | Or deriving (Eq, Show, Generic) instance ToJSON BooleanOperator where toJSON And = String "and" @@ -1554,7 +1556,7 @@ , functionScoreBoostMode :: Maybe BoostMode , functionScoreMinScore :: Score , functionScoreScoreMode :: Maybe ScoreMode - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON FunctionScoreQuery where toJSON (FunctionScoreQuery query boost fns maxBoost boostMode minScore scoreMode) = @@ -1584,13 +1586,13 @@ data FunctionScoreFunctions = FunctionScoreSingle FunctionScoreFunction - | FunctionScoreMultiple (NonEmpty ComponentFunctionScoreFunction) deriving (Eq, Show) + | FunctionScoreMultiple (NonEmpty ComponentFunctionScoreFunction) deriving (Eq, Show, Generic) data ComponentFunctionScoreFunction = ComponentFunctionScoreFunction { componentScoreFunctionFilter :: Maybe Filter , componentScoreFunction :: FunctionScoreFunction , componentScoreFunctionWeight :: Maybe Weight - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON ComponentFunctionScoreFunction where toJSON (ComponentFunctionScoreFunction filter' fn weight) = @@ -1621,7 +1623,7 @@ -- See: -- https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#fuzziness data Fuzziness = Fuzziness Double | FuzzinessAuto - deriving (Eq, Show) + deriving (Eq, Show, Generic) instance ToJSON Fuzziness where toJSON (Fuzziness n) = toJSON n @@ -1634,7 +1636,7 @@ data InnerHits = InnerHits { innerHitsFrom :: Maybe Integer , innerHitsSize :: Maybe Integer - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON InnerHits where toJSON (InnerHits ihFrom ihSize) = diff --git a/src/Database/Bloodhound/Internal/Suggest.hs b/src/Database/Bloodhound/Internal/Suggest.hs --- a/src/Database/Bloodhound/Internal/Suggest.hs +++ b/src/Database/Bloodhound/Internal/Suggest.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} @@ -7,6 +8,7 @@ import Bloodhound.Import import qualified Data.Aeson.KeyMap as X +import GHC.Generics import Database.Bloodhound.Internal.Newtypes import Database.Bloodhound.Internal.Query (Query, TemplateQueryKeyValuePairs) @@ -15,7 +17,7 @@ { suggestText :: Text , suggestName :: Text , suggestType :: SuggestType - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON Suggest where toJSON Suggest{..} = @@ -39,7 +41,7 @@ data SuggestType = SuggestTypePhraseSuggester PhraseSuggester - deriving (Eq, Show) + deriving (Eq, Show, Generic) instance ToJSON SuggestType where toJSON (SuggestTypePhraseSuggester x) = @@ -64,7 +66,7 @@ , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate , phraseSuggesterCandidateGenerators :: [DirectGenerators] - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON PhraseSuggester where toJSON PhraseSuggester{..} = @@ -109,7 +111,7 @@ PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text , phraseSuggesterHighlighterPostTag :: Text } - deriving (Eq, Show) + deriving (Eq, Show, Generic) instance ToJSON PhraseSuggesterHighlighter where toJSON PhraseSuggesterHighlighter{..} = @@ -127,7 +129,7 @@ { phraseSuggesterCollateTemplateQuery :: Query , phraseSuggesterCollateParams :: TemplateQueryKeyValuePairs , phraseSuggesterCollatePrune :: Bool - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON PhraseSuggesterCollate where toJSON PhraseSuggesterCollate{..} = @@ -198,7 +200,7 @@ data DirectGeneratorSuggestModeTypes = DirectGeneratorSuggestModeMissing | DirectGeneratorSuggestModePopular | DirectGeneratorSuggestModeAlways - deriving (Eq, Show) + deriving (Eq, Show, Generic) instance ToJSON DirectGeneratorSuggestModeTypes where toJSON DirectGeneratorSuggestModeMissing = "missing" @@ -229,7 +231,7 @@ , directGeneratorMaxTermFreq :: Maybe Double , directGeneratorPreFilter :: Maybe Text , directGeneratorPostFilter :: Maybe Text - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) instance ToJSON DirectGenerators where toJSON DirectGenerators{..} = diff --git a/src/Database/Bloodhound/Types.hs b/src/Database/Bloodhound/Types.hs --- a/src/Database/Bloodhound/Types.hs +++ b/src/Database/Bloodhound/Types.hs @@ -394,6 +394,11 @@ , CountQuery (..) , CountResponse (..) , CountShards (..) + , PointInTime(..) + , OpenPointInTimeResponse (..) + , ClosePointInTime (..) + , ClosePointInTimeResponse (..) + , SumAggregation(..) , Highlights(..) , FieldHighlight(..) @@ -422,6 +427,8 @@ , TokenFilterDefinition(..) , CharFilterDefinition(..) , Ngram(..) + , NgramFilter(..) + , EdgeNgramFilterSide(..) , TokenChar(..) , Shingle(..) , Language(..) @@ -438,6 +445,7 @@ import Database.Bloodhound.Internal.Query import Database.Bloodhound.Internal.Sort import Database.Bloodhound.Internal.Suggest +import Database.Bloodhound.Internal.PointInTime import qualified Data.HashMap.Strict as HM {-| 'unpackId' is a silly convenience function that gets used once. @@ -462,13 +470,14 @@ , scriptFields :: Maybe ScriptFields , source :: Maybe Source , suggestBody :: Maybe Suggest -- ^ Only one Suggestion request / response per Search is supported. + , pointInTime :: Maybe PointInTime } deriving (Eq, Show) instance ToJSON Search where toJSON (Search mquery sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sAfter sFields - sScriptFields sSource sSuggest) = + sScriptFields sSource sSuggest pPointInTime) = omitNulls [ "query" .= query' , "sort" .= sort , "aggregations" .= searchAggs @@ -480,7 +489,8 @@ , "fields" .= sFields , "script_fields" .= sScriptFields , "_source" .= sSource - , "suggest" .= sSuggest] + , "suggest" .= sSuggest + , "pit" .= pPointInTime] where query' = case sFilter of Nothing -> mquery @@ -545,6 +555,7 @@ -- ^ Only one Suggestion request / response per -- Search is supported. , suggest :: Maybe NamedSuggestionResponse + , pitId :: Maybe Text } deriving (Eq, Show) @@ -556,7 +567,8 @@ v .: "hits" <*> v .:? "aggregations" <*> v .:? "_scroll_id" <*> - v .:? "suggest" + v .:? "suggest" <*> + v .:? "pit_id" parseJSON _ = empty newtype ScrollId = diff --git a/tests/Test/Common.hs b/tests/Test/Common.hs --- a/tests/Test/Common.hs +++ b/tests/Test/Common.hs @@ -110,6 +110,16 @@ , location = Location 40.12 (-71.34) , extra = Just "blah blah" } +exampleTweetWithAge :: Int -> Tweet +exampleTweetWithAge age = Tweet { user = "bitemyapp" + , postDate = UTCTime + (ModifiedJulianDay 55000) + (secondsToDiffTime 10) + , message = "Use haskell!" + , age = age + , location = Location 40.12 (-71.34) + , extra = Nothing } + newAge :: Int newAge = 31337 @@ -150,6 +160,13 @@ insertData' :: IndexDocumentSettings -> BH IO Reply insertData' ids = do r <- indexDocument testIndex ids exampleTweet (DocId "1") + _ <- refreshIndex testIndex + return r + +insertTweetWithDocId :: Tweet -> Text -> BH IO Reply +insertTweetWithDocId tweet docId = do + let ids = defaultIndexDocumentSettings + r <- indexDocument testIndex ids tweet (DocId docId) _ <- refreshIndex testIndex return r diff --git a/tests/Test/Generators.hs b/tests/Test/Generators.hs --- a/tests/Test/Generators.hs +++ b/tests/Test/Generators.hs @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module Test.Generators where @@ -15,8 +14,8 @@ import qualified Data.Map as M import qualified Data.Text as T import qualified Data.SemVer as SemVer -import Test.QuickCheck.TH.Generators +import Generic.Random import Test.ApproxEq instance Arbitrary NominalDiffTime where @@ -240,231 +239,121 @@ arbitrary = TemplateQueryKeyValuePairs . X.fromList <$> arbitrary shrink (TemplateQueryKeyValuePairs x) = map (TemplateQueryKeyValuePairs . X.fromList) . shrink $ X.toList x -makeArbitrary ''IndexName -instance Arbitrary IndexName where arbitrary = arbitraryIndexName -makeArbitrary ''DocId -instance Arbitrary DocId where arbitrary = arbitraryDocId -makeArbitrary ''Version -instance Arbitrary Version where arbitrary = arbitraryVersion -makeArbitrary ''BuildHash -instance Arbitrary BuildHash where arbitrary = arbitraryBuildHash -makeArbitrary ''IndexAliasRouting -instance Arbitrary IndexAliasRouting where arbitrary = arbitraryIndexAliasRouting -makeArbitrary ''ShardCount -instance Arbitrary ShardCount where arbitrary = arbitraryShardCount -makeArbitrary ''ReplicaCount -instance Arbitrary ReplicaCount where arbitrary = arbitraryReplicaCount -makeArbitrary ''TemplateName -instance Arbitrary TemplateName where arbitrary = arbitraryTemplateName -makeArbitrary ''IndexPattern -instance Arbitrary IndexPattern where arbitrary = arbitraryIndexPattern -makeArbitrary ''QueryString -instance Arbitrary QueryString where arbitrary = arbitraryQueryString -makeArbitrary ''CacheName -instance Arbitrary CacheName where arbitrary = arbitraryCacheName -makeArbitrary ''CacheKey -instance Arbitrary CacheKey where arbitrary = arbitraryCacheKey -makeArbitrary ''Existence -instance Arbitrary Existence where arbitrary = arbitraryExistence -makeArbitrary ''CutoffFrequency -instance Arbitrary CutoffFrequency where arbitrary = arbitraryCutoffFrequency -makeArbitrary ''Analyzer -instance Arbitrary Analyzer where arbitrary = arbitraryAnalyzer -makeArbitrary ''MaxExpansions -instance Arbitrary MaxExpansions where arbitrary = arbitraryMaxExpansions -makeArbitrary ''Lenient -instance Arbitrary Lenient where arbitrary = arbitraryLenient -makeArbitrary ''Tiebreaker -instance Arbitrary Tiebreaker where arbitrary = arbitraryTiebreaker -makeArbitrary ''Boost -instance Arbitrary Boost where arbitrary = arbitraryBoost -makeArbitrary ''BoostTerms -instance Arbitrary BoostTerms where arbitrary = arbitraryBoostTerms -makeArbitrary ''MinimumMatch -instance Arbitrary MinimumMatch where arbitrary = arbitraryMinimumMatch -makeArbitrary ''DisableCoord -instance Arbitrary DisableCoord where arbitrary = arbitraryDisableCoord -makeArbitrary ''IgnoreTermFrequency -instance Arbitrary IgnoreTermFrequency where arbitrary = arbitraryIgnoreTermFrequency -makeArbitrary ''MinimumTermFrequency -instance Arbitrary MinimumTermFrequency where arbitrary = arbitraryMinimumTermFrequency -makeArbitrary ''MaxQueryTerms -instance Arbitrary MaxQueryTerms where arbitrary = arbitraryMaxQueryTerms -makeArbitrary ''Fuzziness -instance Arbitrary Fuzziness where arbitrary = arbitraryFuzziness -makeArbitrary ''PrefixLength -instance Arbitrary PrefixLength where arbitrary = arbitraryPrefixLength -makeArbitrary ''RelationName -instance Arbitrary RelationName where arbitrary = arbitraryRelationName -makeArbitrary ''PercentMatch -instance Arbitrary PercentMatch where arbitrary = arbitraryPercentMatch -makeArbitrary ''StopWord -instance Arbitrary StopWord where arbitrary = arbitraryStopWord -makeArbitrary ''QueryPath -instance Arbitrary QueryPath where arbitrary = arbitraryQueryPath -makeArbitrary ''AllowLeadingWildcard -instance Arbitrary AllowLeadingWildcard where arbitrary = arbitraryAllowLeadingWildcard -makeArbitrary ''LowercaseExpanded -instance Arbitrary LowercaseExpanded where arbitrary = arbitraryLowercaseExpanded -makeArbitrary ''EnablePositionIncrements -instance Arbitrary EnablePositionIncrements where arbitrary = arbitraryEnablePositionIncrements -makeArbitrary ''AnalyzeWildcard -instance Arbitrary AnalyzeWildcard where arbitrary = arbitraryAnalyzeWildcard -makeArbitrary ''GeneratePhraseQueries -instance Arbitrary GeneratePhraseQueries where arbitrary = arbitraryGeneratePhraseQueries -makeArbitrary ''Locale -instance Arbitrary Locale where arbitrary = arbitraryLocale -makeArbitrary ''MaxWordLength -instance Arbitrary MaxWordLength where arbitrary = arbitraryMaxWordLength -makeArbitrary ''MinWordLength -instance Arbitrary MinWordLength where arbitrary = arbitraryMinWordLength -makeArbitrary ''PhraseSlop -instance Arbitrary PhraseSlop where arbitrary = arbitraryPhraseSlop -makeArbitrary ''MinDocFrequency -instance Arbitrary MinDocFrequency where arbitrary = arbitraryMinDocFrequency -makeArbitrary ''MaxDocFrequency -instance Arbitrary MaxDocFrequency where arbitrary = arbitraryMaxDocFrequency -makeArbitrary ''Regexp -instance Arbitrary Regexp where arbitrary = arbitraryRegexp -makeArbitrary ''SimpleQueryStringQuery -instance Arbitrary SimpleQueryStringQuery where arbitrary = arbitrarySimpleQueryStringQuery -makeArbitrary ''FieldOrFields -instance Arbitrary FieldOrFields where arbitrary = arbitraryFieldOrFields -makeArbitrary ''SimpleQueryFlag -instance Arbitrary SimpleQueryFlag where arbitrary = arbitrarySimpleQueryFlag -makeArbitrary ''RegexpQuery -instance Arbitrary RegexpQuery where arbitrary = arbitraryRegexpQuery -makeArbitrary ''QueryStringQuery -instance Arbitrary QueryStringQuery where arbitrary = arbitraryQueryStringQuery -makeArbitrary ''RangeQuery -instance Arbitrary RangeQuery where arbitrary = arbitraryRangeQuery -makeArbitrary ''RangeValue -instance Arbitrary RangeValue where arbitrary = arbitraryRangeValue -makeArbitrary ''PrefixQuery -instance Arbitrary PrefixQuery where arbitrary = arbitraryPrefixQuery -makeArbitrary ''NestedQuery -instance Arbitrary NestedQuery where arbitrary = arbitraryNestedQuery -makeArbitrary ''MoreLikeThisFieldQuery -instance Arbitrary MoreLikeThisFieldQuery where arbitrary = arbitraryMoreLikeThisFieldQuery -makeArbitrary ''MoreLikeThisQuery -instance Arbitrary MoreLikeThisQuery where arbitrary = arbitraryMoreLikeThisQuery -makeArbitrary ''IndicesQuery -instance Arbitrary IndicesQuery where arbitrary = arbitraryIndicesQuery -makeArbitrary ''IgnoreUnmapped -instance Arbitrary IgnoreUnmapped where arbitrary = arbitraryIgnoreUnmapped -makeArbitrary ''MinChildren -instance Arbitrary MinChildren where arbitrary = arbitraryMinChildren -makeArbitrary ''MaxChildren -instance Arbitrary MaxChildren where arbitrary = arbitraryMaxChildren -makeArbitrary ''AggregateParentScore -instance Arbitrary AggregateParentScore where arbitrary = arbitraryAggregateParentScore -makeArbitrary ''HasParentQuery -instance Arbitrary HasParentQuery where arbitrary = arbitraryHasParentQuery -makeArbitrary ''HasChildQuery -instance Arbitrary HasChildQuery where arbitrary = arbitraryHasChildQuery -makeArbitrary ''FuzzyQuery -instance Arbitrary FuzzyQuery where arbitrary = arbitraryFuzzyQuery -makeArbitrary ''FuzzyLikeFieldQuery -instance Arbitrary FuzzyLikeFieldQuery where arbitrary = arbitraryFuzzyLikeFieldQuery -makeArbitrary ''FuzzyLikeThisQuery -instance Arbitrary FuzzyLikeThisQuery where arbitrary = arbitraryFuzzyLikeThisQuery -makeArbitrary ''DisMaxQuery -instance Arbitrary DisMaxQuery where arbitrary = arbitraryDisMaxQuery -makeArbitrary ''CommonTermsQuery -instance Arbitrary CommonTermsQuery where arbitrary = arbitraryCommonTermsQuery -makeArbitrary ''DistanceRange -instance Arbitrary DistanceRange where arbitrary = arbitraryDistanceRange -makeArbitrary ''MultiMatchQuery -instance Arbitrary MultiMatchQuery where arbitrary = arbitraryMultiMatchQuery -makeArbitrary ''LessThanD -instance Arbitrary LessThanD where arbitrary = arbitraryLessThanD -makeArbitrary ''LessThanEqD -instance Arbitrary LessThanEqD where arbitrary = arbitraryLessThanEqD -makeArbitrary ''GreaterThanD -instance Arbitrary GreaterThanD where arbitrary = arbitraryGreaterThanD -makeArbitrary ''GreaterThanEqD -instance Arbitrary GreaterThanEqD where arbitrary = arbitraryGreaterThanEqD -makeArbitrary ''LessThan -instance Arbitrary LessThan where arbitrary = arbitraryLessThan -makeArbitrary ''LessThanEq -instance Arbitrary LessThanEq where arbitrary = arbitraryLessThanEq -makeArbitrary ''GreaterThan -instance Arbitrary GreaterThan where arbitrary = arbitraryGreaterThan -makeArbitrary ''GreaterThanEq -instance Arbitrary GreaterThanEq where arbitrary = arbitraryGreaterThanEq -makeArbitrary ''GeoPoint -instance Arbitrary GeoPoint where arbitrary = arbitraryGeoPoint -makeArbitrary ''NullValue -instance Arbitrary NullValue where arbitrary = arbitraryNullValue -makeArbitrary ''MinimumMatchHighLow -instance Arbitrary MinimumMatchHighLow where arbitrary = arbitraryMinimumMatchHighLow -makeArbitrary ''CommonMinimumMatch -instance Arbitrary CommonMinimumMatch where arbitrary = arbitraryCommonMinimumMatch -makeArbitrary ''BoostingQuery -instance Arbitrary BoostingQuery where arbitrary = arbitraryBoostingQuery -makeArbitrary ''BoolQuery -instance Arbitrary BoolQuery where arbitrary = arbitraryBoolQuery -makeArbitrary ''MatchQuery -instance Arbitrary MatchQuery where arbitrary = arbitraryMatchQuery -makeArbitrary ''MultiMatchQueryType -instance Arbitrary MultiMatchQueryType where arbitrary = arbitraryMultiMatchQueryType -makeArbitrary ''BooleanOperator -instance Arbitrary BooleanOperator where arbitrary = arbitraryBooleanOperator -makeArbitrary ''ZeroTermsQuery -instance Arbitrary ZeroTermsQuery where arbitrary = arbitraryZeroTermsQuery -makeArbitrary ''MatchQueryType -instance Arbitrary MatchQueryType where arbitrary = arbitraryMatchQueryType -makeArbitrary ''SearchAliasRouting -instance Arbitrary SearchAliasRouting where arbitrary = arbitrarySearchAliasRouting -makeArbitrary ''ScoreType -instance Arbitrary ScoreType where arbitrary = arbitraryScoreType -makeArbitrary ''Distance -instance Arbitrary Distance where arbitrary = arbitraryDistance -makeArbitrary ''DistanceUnit -instance Arbitrary DistanceUnit where arbitrary = arbitraryDistanceUnit -makeArbitrary ''DistanceType -instance Arbitrary DistanceType where arbitrary = arbitraryDistanceType -makeArbitrary ''OptimizeBbox -instance Arbitrary OptimizeBbox where arbitrary = arbitraryOptimizeBbox -makeArbitrary ''GeoBoundingBoxConstraint -instance Arbitrary GeoBoundingBoxConstraint where arbitrary = arbitraryGeoBoundingBoxConstraint -makeArbitrary ''GeoFilterType -instance Arbitrary GeoFilterType where arbitrary = arbitraryGeoFilterType -makeArbitrary ''GeoBoundingBox -instance Arbitrary GeoBoundingBox where arbitrary = arbitraryGeoBoundingBox -makeArbitrary ''LatLon -instance Arbitrary LatLon where arbitrary = arbitraryLatLon -makeArbitrary ''RangeExecution -instance Arbitrary RangeExecution where arbitrary = arbitraryRangeExecution -makeArbitrary ''RegexpFlag -instance Arbitrary RegexpFlag where arbitrary = arbitraryRegexpFlag -makeArbitrary ''BoolMatch -instance Arbitrary BoolMatch where arbitrary = arbitraryBoolMatch -makeArbitrary ''Term -instance Arbitrary Term where arbitrary = arbitraryTerm -makeArbitrary ''IndexMappingsLimits -instance Arbitrary IndexMappingsLimits where arbitrary = arbitraryIndexMappingsLimits -makeArbitrary ''IndexSettings -instance Arbitrary IndexSettings where arbitrary = arbitraryIndexSettings -makeArbitrary ''TokenChar -instance Arbitrary TokenChar where arbitrary = arbitraryTokenChar -makeArbitrary ''Ngram -instance Arbitrary Ngram where arbitrary = arbitraryNgram -makeArbitrary ''TokenizerDefinition -instance Arbitrary TokenizerDefinition where arbitrary = arbitraryTokenizerDefinition -makeArbitrary ''TokenFilter -instance Arbitrary TokenFilter where arbitrary = arbitraryTokenFilter -makeArbitrary ''TokenFilterDefinition -instance Arbitrary TokenFilterDefinition where arbitrary = arbitraryTokenFilterDefinition -makeArbitrary ''Language -instance Arbitrary Language where arbitrary = arbitraryLanguage -makeArbitrary ''Shingle -instance Arbitrary Shingle where arbitrary = arbitraryShingle +instance Arbitrary IndexName where arbitrary = genericArbitraryU +instance Arbitrary DocId where arbitrary = genericArbitraryU +instance Arbitrary Version where arbitrary = genericArbitraryU +instance Arbitrary BuildHash where arbitrary = genericArbitraryU +instance Arbitrary IndexAliasRouting where arbitrary = genericArbitraryU +instance Arbitrary ShardCount where arbitrary = genericArbitraryU +instance Arbitrary ReplicaCount where arbitrary = genericArbitraryU +instance Arbitrary TemplateName where arbitrary = genericArbitraryU +instance Arbitrary IndexPattern where arbitrary = genericArbitraryU +instance Arbitrary QueryString where arbitrary = genericArbitraryU +instance Arbitrary CacheName where arbitrary = genericArbitraryU +instance Arbitrary CacheKey where arbitrary = genericArbitraryU +instance Arbitrary Existence where arbitrary = genericArbitraryU +instance Arbitrary CutoffFrequency where arbitrary = genericArbitraryU +instance Arbitrary Analyzer where arbitrary = genericArbitraryU +instance Arbitrary MaxExpansions where arbitrary = genericArbitraryU +instance Arbitrary Lenient where arbitrary = genericArbitraryU +instance Arbitrary Tiebreaker where arbitrary = genericArbitraryU +instance Arbitrary Boost where arbitrary = genericArbitraryU +instance Arbitrary BoostTerms where arbitrary = genericArbitraryU +instance Arbitrary MinimumMatch where arbitrary = genericArbitraryU +instance Arbitrary DisableCoord where arbitrary = genericArbitraryU +instance Arbitrary IgnoreTermFrequency where arbitrary = genericArbitraryU +instance Arbitrary MinimumTermFrequency where arbitrary = genericArbitraryU +instance Arbitrary MaxQueryTerms where arbitrary = genericArbitraryU +instance Arbitrary Fuzziness where arbitrary = genericArbitraryU +instance Arbitrary PrefixLength where arbitrary = genericArbitraryU +instance Arbitrary RelationName where arbitrary = genericArbitraryU +instance Arbitrary PercentMatch where arbitrary = genericArbitraryU +instance Arbitrary StopWord where arbitrary = genericArbitraryU +instance Arbitrary QueryPath where arbitrary = genericArbitraryU +instance Arbitrary AllowLeadingWildcard where arbitrary = genericArbitraryU +instance Arbitrary LowercaseExpanded where arbitrary = genericArbitraryU +instance Arbitrary EnablePositionIncrements where arbitrary = genericArbitraryU +instance Arbitrary AnalyzeWildcard where arbitrary = genericArbitraryU +instance Arbitrary GeneratePhraseQueries where arbitrary = genericArbitraryU +instance Arbitrary Locale where arbitrary = genericArbitraryU +instance Arbitrary MaxWordLength where arbitrary = genericArbitraryU +instance Arbitrary MinWordLength where arbitrary = genericArbitraryU +instance Arbitrary PhraseSlop where arbitrary = genericArbitraryU +instance Arbitrary MinDocFrequency where arbitrary = genericArbitraryU +instance Arbitrary MaxDocFrequency where arbitrary = genericArbitraryU +instance Arbitrary Regexp where arbitrary = genericArbitraryU +instance Arbitrary SimpleQueryStringQuery where arbitrary = genericArbitraryU +instance Arbitrary FieldOrFields where arbitrary = genericArbitraryU +instance Arbitrary SimpleQueryFlag where arbitrary = genericArbitraryU +instance Arbitrary RegexpQuery where arbitrary = genericArbitraryU +instance Arbitrary QueryStringQuery where arbitrary = genericArbitraryU +instance Arbitrary RangeQuery where arbitrary = genericArbitraryU +instance Arbitrary RangeValue where arbitrary = genericArbitraryU +instance Arbitrary PrefixQuery where arbitrary = genericArbitraryU +instance Arbitrary NestedQuery where arbitrary = genericArbitraryU +instance Arbitrary MoreLikeThisFieldQuery where arbitrary = genericArbitraryU +instance Arbitrary MoreLikeThisQuery where arbitrary = genericArbitraryU +instance Arbitrary IndicesQuery where arbitrary = genericArbitraryU +instance Arbitrary IgnoreUnmapped where arbitrary = genericArbitraryU +instance Arbitrary MinChildren where arbitrary = genericArbitraryU +instance Arbitrary MaxChildren where arbitrary = genericArbitraryU +instance Arbitrary AggregateParentScore where arbitrary = genericArbitraryU +instance Arbitrary HasParentQuery where arbitrary = genericArbitraryU +instance Arbitrary HasChildQuery where arbitrary = genericArbitraryU +instance Arbitrary FuzzyQuery where arbitrary = genericArbitraryU +instance Arbitrary FuzzyLikeFieldQuery where arbitrary = genericArbitraryU +instance Arbitrary FuzzyLikeThisQuery where arbitrary = genericArbitraryU +instance Arbitrary DisMaxQuery where arbitrary = genericArbitraryU +instance Arbitrary CommonTermsQuery where arbitrary = genericArbitraryU +instance Arbitrary DistanceRange where arbitrary = genericArbitraryU +instance Arbitrary MultiMatchQuery where arbitrary = genericArbitraryU +instance Arbitrary LessThanD where arbitrary = genericArbitraryU +instance Arbitrary LessThanEqD where arbitrary = genericArbitraryU +instance Arbitrary GreaterThanD where arbitrary = genericArbitraryU +instance Arbitrary GreaterThanEqD where arbitrary = genericArbitraryU +instance Arbitrary LessThan where arbitrary = genericArbitraryU +instance Arbitrary LessThanEq where arbitrary = genericArbitraryU +instance Arbitrary GreaterThan where arbitrary = genericArbitraryU +instance Arbitrary GreaterThanEq where arbitrary = genericArbitraryU +instance Arbitrary GeoPoint where arbitrary = genericArbitraryU +instance Arbitrary NullValue where arbitrary = genericArbitraryU +instance Arbitrary MinimumMatchHighLow where arbitrary = genericArbitraryU +instance Arbitrary CommonMinimumMatch where arbitrary = genericArbitraryU +instance Arbitrary BoostingQuery where arbitrary = genericArbitraryU +instance Arbitrary BoolQuery where arbitrary = genericArbitraryU +instance Arbitrary MatchQuery where arbitrary = genericArbitraryU +instance Arbitrary MultiMatchQueryType where arbitrary = genericArbitraryU +instance Arbitrary BooleanOperator where arbitrary = genericArbitraryU +instance Arbitrary ZeroTermsQuery where arbitrary = genericArbitraryU +instance Arbitrary MatchQueryType where arbitrary = genericArbitraryU +instance Arbitrary SearchAliasRouting where arbitrary = genericArbitraryU +instance Arbitrary ScoreType where arbitrary = genericArbitraryU +instance Arbitrary Distance where arbitrary = genericArbitraryU +instance Arbitrary DistanceUnit where arbitrary = genericArbitraryU +instance Arbitrary DistanceType where arbitrary = genericArbitraryU +instance Arbitrary OptimizeBbox where arbitrary = genericArbitraryU +instance Arbitrary GeoBoundingBoxConstraint where arbitrary = genericArbitraryU +instance Arbitrary GeoFilterType where arbitrary = genericArbitraryU +instance Arbitrary GeoBoundingBox where arbitrary = genericArbitraryU +instance Arbitrary LatLon where arbitrary = genericArbitraryU +instance Arbitrary RangeExecution where arbitrary = genericArbitraryU +instance Arbitrary RegexpFlag where arbitrary = genericArbitraryU +instance Arbitrary BoolMatch where arbitrary = genericArbitraryU +instance Arbitrary Term where arbitrary = genericArbitraryU +instance Arbitrary IndexMappingsLimits where arbitrary = genericArbitraryU +instance Arbitrary IndexSettings where arbitrary = genericArbitraryU +instance Arbitrary TokenChar where arbitrary = genericArbitraryU +instance Arbitrary Ngram where arbitrary = genericArbitraryU +instance Arbitrary TokenizerDefinition where arbitrary = genericArbitraryU +instance Arbitrary TokenFilter where arbitrary = genericArbitraryU +instance Arbitrary NgramFilter where arbitrary = genericArbitraryU +instance Arbitrary EdgeNgramFilterSide where arbitrary = genericArbitraryU +instance Arbitrary TokenFilterDefinition where arbitrary = genericArbitraryU +instance Arbitrary Language where arbitrary = genericArbitraryU +instance Arbitrary Shingle where arbitrary = genericArbitraryU -makeArbitrary ''CharFilter -instance Arbitrary CharFilter where arbitrary = arbitraryCharFilter -makeArbitrary ''AnalyzerDefinition -instance Arbitrary AnalyzerDefinition where arbitrary = arbitraryAnalyzerDefinition +instance Arbitrary CharFilter where arbitrary = genericArbitraryU +instance Arbitrary AnalyzerDefinition where arbitrary = genericArbitraryU -- TODO: This should have a proper generator that doesn't -- create garbage that has to be filtered out. @@ -479,78 +368,44 @@ M.map T.strip . M.mapKeys (T.replace "=>" "" . T.strip) -makeArbitrary ''Analysis -instance Arbitrary Analysis where arbitrary = arbitraryAnalysis -makeArbitrary ''Tokenizer -instance Arbitrary Tokenizer where arbitrary = arbitraryTokenizer -makeArbitrary ''Compression -instance Arbitrary Compression where arbitrary = arbitraryCompression -makeArbitrary ''Bytes -instance Arbitrary Bytes where arbitrary = arbitraryBytes -makeArbitrary ''AllocationPolicy -instance Arbitrary AllocationPolicy where arbitrary = arbitraryAllocationPolicy -makeArbitrary ''InitialShardCount -instance Arbitrary InitialShardCount where arbitrary = arbitraryInitialShardCount -makeArbitrary ''FSType -instance Arbitrary FSType where arbitrary = arbitraryFSType -makeArbitrary ''CompoundFormat -instance Arbitrary CompoundFormat where arbitrary = arbitraryCompoundFormat -makeArbitrary ''FsSnapshotRepo -instance Arbitrary FsSnapshotRepo where arbitrary = arbitraryFsSnapshotRepo -makeArbitrary ''SnapshotRepoName -instance Arbitrary SnapshotRepoName where arbitrary = arbitrarySnapshotRepoName -makeArbitrary ''DirectGeneratorSuggestModeTypes -instance Arbitrary DirectGeneratorSuggestModeTypes where arbitrary = arbitraryDirectGeneratorSuggestModeTypes -makeArbitrary ''DirectGenerators -instance Arbitrary DirectGenerators where arbitrary = arbitraryDirectGenerators -makeArbitrary ''PhraseSuggesterCollate -instance Arbitrary PhraseSuggesterCollate where arbitrary = arbitraryPhraseSuggesterCollate -makeArbitrary ''PhraseSuggesterHighlighter -instance Arbitrary PhraseSuggesterHighlighter where arbitrary = arbitraryPhraseSuggesterHighlighter -makeArbitrary ''Size -instance Arbitrary Size where arbitrary = arbitrarySize -makeArbitrary ''PhraseSuggester -instance Arbitrary PhraseSuggester where arbitrary = arbitraryPhraseSuggester -makeArbitrary ''SuggestType -instance Arbitrary SuggestType where arbitrary = arbitrarySuggestType -makeArbitrary ''Suggest -instance Arbitrary Suggest where arbitrary = arbitrarySuggest +instance Arbitrary Analysis where arbitrary = genericArbitraryU +instance Arbitrary Tokenizer where arbitrary = genericArbitraryU +instance Arbitrary Compression where arbitrary = genericArbitraryU +instance Arbitrary Bytes where arbitrary = genericArbitraryU +instance Arbitrary AllocationPolicy where arbitrary = genericArbitraryU +instance Arbitrary InitialShardCount where arbitrary = genericArbitraryU +instance Arbitrary FSType where arbitrary = genericArbitraryU +instance Arbitrary CompoundFormat where arbitrary = genericArbitraryU +instance Arbitrary FsSnapshotRepo where arbitrary = genericArbitraryU +instance Arbitrary SnapshotRepoName where arbitrary = genericArbitraryU +instance Arbitrary DirectGeneratorSuggestModeTypes where arbitrary = genericArbitraryU +instance Arbitrary DirectGenerators where arbitrary = genericArbitraryU +instance Arbitrary PhraseSuggesterCollate where arbitrary = genericArbitraryU +instance Arbitrary PhraseSuggesterHighlighter where arbitrary = genericArbitraryU +instance Arbitrary Size where arbitrary = genericArbitraryU +instance Arbitrary PhraseSuggester where arbitrary = genericArbitraryU +instance Arbitrary SuggestType where arbitrary = genericArbitraryU +instance Arbitrary Suggest where arbitrary = genericArbitraryU -makeArbitrary ''FunctionScoreQuery -instance Arbitrary FunctionScoreQuery where arbitrary = arbitraryFunctionScoreQuery +instance Arbitrary FunctionScoreQuery where arbitrary = genericArbitraryU -makeArbitrary ''FunctionScoreFunction -instance Arbitrary FunctionScoreFunction where arbitrary = arbitraryFunctionScoreFunction -makeArbitrary ''FunctionScoreFunctions -instance Arbitrary FunctionScoreFunctions where arbitrary = arbitraryFunctionScoreFunctions -makeArbitrary ''ComponentFunctionScoreFunction -instance Arbitrary ComponentFunctionScoreFunction where arbitrary = arbitraryComponentFunctionScoreFunction -makeArbitrary ''Script -instance Arbitrary Script where arbitrary = arbitraryScript -makeArbitrary ''ScriptLanguage -instance Arbitrary ScriptLanguage where arbitrary = arbitraryScriptLanguage -makeArbitrary ''ScriptSource -instance Arbitrary ScriptSource where arbitrary = arbitraryScriptSource -makeArbitrary ''ScoreMode -instance Arbitrary ScoreMode where arbitrary = arbitraryScoreMode -makeArbitrary ''BoostMode -instance Arbitrary BoostMode where arbitrary = arbitraryBoostMode -makeArbitrary ''Seed -instance Arbitrary Seed where arbitrary = arbitrarySeed -makeArbitrary ''FieldValueFactor -instance Arbitrary FieldValueFactor where arbitrary = arbitraryFieldValueFactor -makeArbitrary ''Weight -instance Arbitrary Weight where arbitrary = arbitraryWeight -makeArbitrary ''Factor -instance Arbitrary Factor where arbitrary = arbitraryFactor -makeArbitrary ''FactorMissingFieldValue -instance Arbitrary FactorMissingFieldValue where arbitrary = arbitraryFactorMissingFieldValue -makeArbitrary ''FactorModifier -instance Arbitrary FactorModifier where arbitrary = arbitraryFactorModifier +instance Arbitrary FunctionScoreFunction where arbitrary = genericArbitraryU +instance Arbitrary FunctionScoreFunctions where arbitrary = genericArbitraryU +instance Arbitrary ComponentFunctionScoreFunction where arbitrary = genericArbitraryU +instance Arbitrary Script where arbitrary = genericArbitraryU +instance Arbitrary ScriptLanguage where arbitrary = genericArbitraryU +instance Arbitrary ScriptSource where arbitrary = genericArbitraryU +instance Arbitrary ScoreMode where arbitrary = genericArbitraryU +instance Arbitrary BoostMode where arbitrary = genericArbitraryU +instance Arbitrary Seed where arbitrary = genericArbitraryU +instance Arbitrary FieldValueFactor where arbitrary = genericArbitraryU +instance Arbitrary Weight where arbitrary = genericArbitraryU +instance Arbitrary Factor where arbitrary = genericArbitraryU +instance Arbitrary FactorMissingFieldValue where arbitrary = genericArbitraryU +instance Arbitrary FactorModifier where arbitrary = genericArbitraryU -makeArbitrary ''UpdatableIndexSetting instance Arbitrary UpdatableIndexSetting where - arbitrary = resize 10 arbitraryUpdatableIndexSetting + arbitrary = resize 10 genericArbitraryU newtype UpdatableIndexSetting' = UpdatableIndexSetting' UpdatableIndexSetting @@ -574,5 +429,4 @@ nodeAttrFilterName a == nodeAttrFilterName b shrink (UpdatableIndexSetting' x) = map UpdatableIndexSetting' (shrink x) -makeArbitrary ''InnerHits -instance Arbitrary InnerHits where arbitrary = arbitraryInnerHits +instance Arbitrary InnerHits where arbitrary = genericArbitraryU diff --git a/tests/Test/Sorting.hs b/tests/Test/Sorting.hs --- a/tests/Test/Sorting.hs +++ b/tests/Test/Sorting.hs @@ -12,10 +12,23 @@ _ <- insertData _ <- insertOther let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending - let search = Search Nothing - Nothing (Just [sortSpec]) Nothing Nothing - False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing - Nothing Nothing + let search = Search + { queryBody = Nothing + , filterBody = Nothing + , sortBody = Just [sortSpec] + , aggBody = Nothing + , highlight = Nothing + , trackSortScores = False + , from = From 0 + , size = Size 10 + , searchType = SearchTypeDfsQueryThenFetch + , searchAfterKey = Nothing + , fields = Nothing + , scriptFields = Nothing + , source = Nothing + , suggestBody = Nothing + , pointInTime = Nothing + } result <- searchTweets search let myTweet = grabFirst result liftIO $ diff --git a/tests/tests.hs b/tests/tests.hs --- a/tests/tests.hs +++ b/tests/tests.hs @@ -19,6 +19,7 @@ import Prelude import qualified Data.Aeson as Aeson +import qualified Data.Text as Text import qualified Test.Aggregation as Aggregation import qualified Test.BulkAPI as Bulk import qualified Test.Documents as Documents @@ -116,6 +117,42 @@ liftIO $ scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet] + describe "Point in time (PIT) API" $ do + it "returns a single document using the point in time (PIT) API" $ withTestEnv $ do + _ <- insertData + _ <- insertOther + let search = + (mkSearch + (Just $ MatchAllQuery Nothing) Nothing) + { size = Size 1 } + regular_search <- searchTweet search + pit_search' <- pitSearch testIndex search :: BH IO [Hit Tweet] + let pit_search = map hitSource pit_search' + liftIO $ + regular_search `shouldBe` Right exampleTweet -- Check that the size restriction is being honored + liftIO $ + pit_search `shouldMatchList` [Just exampleTweet] + it "returns many documents using the point in time (PIT) API" $ withTestEnv $ do + resetIndex + let ids = [1..1000] + let docs = map exampleTweetWithAge ids + let docIds = map (Text.pack . show) ids + mapM_ (uncurry insertTweetWithDocId) (docs `zip` docIds) + let sort = mkSort (FieldName "postDate") Ascending + let search = + (mkSearch + (Just $ MatchAllQuery Nothing) Nothing) + {sortBody= Just [DefaultSortSpec sort]} + scan_search' <- scanSearch testIndex search :: BH IO [Hit Tweet] + let scan_search = map hitSource scan_search' + pit_search' <- pitSearch testIndex search :: BH IO [Hit Tweet] + let pit_search = map hitSource pit_search' + let expectedHits = map Just docs + liftIO $ + scan_search `shouldMatchList` expectedHits + liftIO $ + pit_search `shouldMatchList` expectedHits + describe "Search After API" $ it "returns document for search after query" $ withTestEnv $ do _ <- insertData @@ -123,10 +160,23 @@ let sortSpec = DefaultSortSpec $ mkSort (FieldName "user") Ascending searchAfterKey = [Aeson.toJSON ("bitemyapp" :: String)] - search = Search Nothing - Nothing (Just [sortSpec]) Nothing Nothing - False (From 0) (Size 10) SearchTypeQueryThenFetch (Just searchAfterKey) - Nothing Nothing Nothing Nothing + search = Search + { queryBody = Nothing + , filterBody = Nothing + , sortBody = Just [sortSpec] + , aggBody = Nothing + , highlight = Nothing + , trackSortScores = False + , from = From 0 + , size = Size 10 + , searchType = SearchTypeDfsQueryThenFetch + , searchAfterKey = Just searchAfterKey + , fields = Nothing + , scriptFields = Nothing + , source = Nothing + , suggestBody = Nothing + , pointInTime = Nothing + } result <- searchTweets search let myTweet = grabFirst result liftIO $