diff --git a/bloodhound.cabal b/bloodhound.cabal --- a/bloodhound.cabal +++ b/bloodhound.cabal @@ -1,7 +1,7 @@ cabal-version: 3.4 name: bloodhound -version: 0.24.0.0 +version: 0.25.0.0 synopsis: Elasticsearch client library for Haskell description: Elasticsearch made awesome for Haskell hackers category: Database, Search @@ -97,7 +97,7 @@ , hashable >=1 && <2 , http-client >=0.4.30 && <1 , http-types >=0.8 && <1 - , microlens >=0.4 + , microlens >=0.4 && <1 , mtl >=1.0 && <3 , network-uri >=2.6 && <3 , optics-core >=0.4 && <0.5 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,17 @@ +0.25.0.0 +======== +- @blackheaven + - add `BHRequest.bhRequestQueryStrings` + - fix: missing `getDocument` Client + - feat: add `Search.docvalueFields` + - feat: add `MedianAbsoluteDeviationAggregation` and `AvgAbsoluteDeviationAggregation` + - feat: extract `Missing` newtype + - feat: add lenses for `MedianAbsoluteDeviationAggregation` and `AvgAggregation` + - fix: rename old `Missing` and `SortMissingValue` + - feat: enhance `CardinalityAggregation` with `PrecisionThreshold` and `OnMissingValue` newtypes + - feat: enhance `DateHistogramAggregation` with new fields (`calendar_interval`, `fixed_interval`, `time_zone`, `offset`, `keyed`, `missing`, `min_doc_count`, `extended_bounds`) + - feat: add `CompositeAggregation` support + 0.24.0.0 ======== - @blackheaven diff --git a/src/Database/Bloodhound/Client/Cluster.hs b/src/Database/Bloodhound/Client/Cluster.hs --- a/src/Database/Bloodhound/Client/Cluster.hs +++ b/src/Database/Bloodhound/Client/Cluster.hs @@ -125,16 +125,21 @@ initReq <- liftIO $ parseUrl' url let reqHook = bhRequestHook env let reqBody = HTTP.RequestBodyLBS $ fromMaybe emptyBody $ bhRequestBody request + let setQueryStrings = + case bhRequestQueryStrings request of + [] -> id + xs -> HTTP.setQueryString xs req <- liftIO $ reqHook $ HTTP.setRequestIgnoreStatus $ - initReq - { HTTP.method = bhRequestMethod request, - HTTP.requestHeaders = - ("Content-Type", "application/json") : HTTP.requestHeaders initReq, - HTTP.requestBody = reqBody - } + setQueryStrings $ + initReq + { HTTP.method = bhRequestMethod request, + HTTP.requestHeaders = + ("Content-Type", "application/json") : HTTP.requestHeaders initReq, + HTTP.requestBody = reqBody + } let mgr = bhManager env BHResponse <$> liftIO (HTTP.httpLbs req mgr) diff --git a/src/Database/Bloodhound/Common/Client.hs b/src/Database/Bloodhound/Common/Client.hs --- a/src/Database/Bloodhound/Common/Client.hs +++ b/src/Database/Bloodhound/Common/Client.hs @@ -55,7 +55,7 @@ indexDocument, updateDocument, updateByQuery, - Requests.getDocument, + getDocument, documentExists, deleteDocument, deleteByQuery, @@ -528,6 +528,14 @@ V.Vector BulkOperation -> m BulkResponse bulk ops = performBHRequest $ Requests.bulk @StatusDependant ops + +-- | 'getDocument' is a straight-forward way to fetch a single document from +-- Elasticsearch using a 'Server', 'IndexName', and a 'DocId'. +-- The 'DocId' is the primary key for your Elasticsearch document. +-- +-- >>> yourDoc <- runBH' $ getDocument testIndex (DocId "1") +getDocument :: (MonadBH m, FromJSON a) => IndexName -> DocId -> m (EsResult a) +getDocument indexName docId = performBHRequest $ Requests.getDocument indexName docId -- | 'documentExists' enables you to check if a document exists. documentExists :: (MonadBH m) => IndexName -> DocId -> m Bool diff --git a/src/Database/Bloodhound/Common/Requests.hs b/src/Database/Bloodhound/Common/Requests.hs --- a/src/Database/Bloodhound/Common/Requests.hs +++ b/src/Database/Bloodhound/Common/Requests.hs @@ -1056,6 +1056,7 @@ searchAfterKey = Nothing, fields = Nothing, scriptFields = Nothing, + docvalueFields = Nothing, source = Nothing, suggestBody = Nothing, pointInTime = Nothing @@ -1083,6 +1084,7 @@ searchAfterKey = Nothing, fields = Nothing, scriptFields = Nothing, + docvalueFields = Nothing, source = Nothing, suggestBody = Nothing, pointInTime = Nothing @@ -1109,6 +1111,7 @@ searchAfterKey = Nothing, fields = Nothing, scriptFields = Nothing, + docvalueFields = Nothing, source = Nothing, suggestBody = Nothing, pointInTime = Nothing diff --git a/src/Database/Bloodhound/Internal/Client/BHRequest.hs b/src/Database/Bloodhound/Internal/Client/BHRequest.hs --- a/src/Database/Bloodhound/Internal/Client/BHRequest.hs +++ b/src/Database/Bloodhound/Internal/Client/BHRequest.hs @@ -65,6 +65,7 @@ import Control.Monad import Control.Monad.Catch import Data.Aeson +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import Data.Ix import Data.Monoid @@ -122,6 +123,7 @@ { bhRequestMethod :: NHTM.Method, bhRequestEndpoint :: Endpoint, bhRequestBody :: Maybe BL.ByteString, + bhRequestQueryStrings :: [(BS.ByteString, Maybe BS.ByteString)], bhRequestParser :: BHResponse parsingContext responseBody -> Either EsProtocolException (ParsedEsResponse responseBody) } @@ -145,6 +147,7 @@ { bhRequestMethod = method', bhRequestEndpoint = endpoint, bhRequestBody = Just body, + bhRequestQueryStrings = [], bhRequestParser = parseBHResponse } @@ -155,6 +158,7 @@ { bhRequestMethod = method', bhRequestEndpoint = endpoint, bhRequestBody = Nothing, + bhRequestQueryStrings = [], bhRequestParser = parseBHResponse } diff --git a/src/Database/Bloodhound/Internal/Versions/Common/Types/Aggregation.hs b/src/Database/Bloodhound/Internal/Versions/Common/Types/Aggregation.hs --- a/src/Database/Bloodhound/Internal/Versions/Common/Types/Aggregation.hs +++ b/src/Database/Bloodhound/Internal/Versions/Common/Types/Aggregation.hs @@ -33,6 +33,9 @@ | TopHitsAgg TopHitsAggregation | StatsAgg StatisticsAggregation | SumAgg SumAggregation + | AvgAgg AvgAggregation + | MedianAbsoluteDeviationAgg MedianAbsoluteDeviationAggregation + | CompositeAgg CompositeAggregation deriving stock (Eq, Show) aggregationTermsAggPrism :: Prism' Aggregation TermsAggregation @@ -115,6 +118,30 @@ SumAgg x -> Right x _ -> Left s +aggregationAvgAggPrism :: Prism' Aggregation AvgAggregation +aggregationAvgAggPrism = prism AvgAgg extract + where + extract s = + case s of + AvgAgg x -> Right x + _ -> Left s + +aggregationMedianAbsoluteDeviationAggPrism :: Prism' Aggregation MedianAbsoluteDeviationAggregation +aggregationMedianAbsoluteDeviationAggPrism = prism MedianAbsoluteDeviationAgg extract + where + extract s = + case s of + MedianAbsoluteDeviationAgg x -> Right x + _ -> Left s + +aggregationCompositeAggPrism :: Prism' Aggregation CompositeAggregation +aggregationCompositeAggPrism = prism CompositeAgg extract + where + extract s = + case s of + CompositeAgg x -> Right x + _ -> Left s + instance ToJSON Aggregation where toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) = omitNulls @@ -134,12 +161,13 @@ ] where toJSON' x = case x of Left y -> "field" .= y; Right y -> "script" .= y - toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) = + toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold missing)) = object [ "cardinality" .= omitNulls [ "field" .= field, - "precisionThreshold" .= precisionThreshold + "precision_threshold" .= precisionThreshold, + "missing" .= missing ] ] toJSON @@ -153,6 +181,14 @@ preOffset postOffset dateHistoAggs + calendarInterval + fixedInterval + timeZone + offset + keyed + missing + minDocCount + extendedBounds ) ) = omitNulls @@ -164,7 +200,15 @@ "pre_zone" .= preZone, "post_zone" .= postZone, "pre_offset" .= preOffset, - "post_offset" .= postOffset + "post_offset" .= postOffset, + "calendar_interval" .= calendarInterval, + "fixed_interval" .= fixedInterval, + "time_zone" .= timeZone, + "offset" .= offset, + "keyed" .= keyed, + "missing" .= missing, + "min_doc_count" .= minDocCount, + "extended_bounds" .= extendedBounds ], "aggs" .= dateHistoAggs ] @@ -203,6 +247,12 @@ | otherwise = "extended_stats" toJSON (SumAgg (SumAggregation (FieldName n))) = omitNulls ["sum" .= omitNulls ["field" .= n]] + toJSON (AvgAgg (AvgAggregation (FieldName n) m)) = + omitNulls ["avg" .= omitNulls ["field" .= n], "missing" .= m] + toJSON (MedianAbsoluteDeviationAgg (MedianAbsoluteDeviationAggregation (FieldName n) m)) = + omitNulls ["median_absolute_deviation" .= omitNulls ["field" .= n], "missing" .= m] + toJSON (CompositeAgg agg) = + object ["composite" .= agg] data TopHitsAggregation = TopHitsAggregation { taFrom :: Maybe From, @@ -274,16 +324,20 @@ data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName, - precisionThreshold :: Maybe Int + cardinalityPrecisionThreshold :: Maybe PrecisionThreshold, + cardinalityMissing :: Maybe OnMissingValue } deriving stock (Eq, Show) cardinalityAggregationFieldLens :: Lens' CardinalityAggregation FieldName cardinalityAggregationFieldLens = lens cardinalityField (\x y -> x {cardinalityField = y}) -cardinalityAggregationPrecisionThresholdLens :: Lens' CardinalityAggregation (Maybe Int) -cardinalityAggregationPrecisionThresholdLens = lens precisionThreshold (\x y -> x {precisionThreshold = y}) +cardinalityAggregationPrecisionThresholdLens :: Lens' CardinalityAggregation (Maybe PrecisionThreshold) +cardinalityAggregationPrecisionThresholdLens = lens cardinalityPrecisionThreshold (\x y -> x {cardinalityPrecisionThreshold = y}) +cardinalityAggregationMissingLens :: Lens' CardinalityAggregation (Maybe OnMissingValue) +cardinalityAggregationMissingLens = lens cardinalityMissing (\x y -> x {cardinalityMissing = y}) + data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName, dateInterval :: Interval, @@ -293,7 +347,15 @@ datePostZone :: Maybe Text, datePreOffset :: Maybe Text, datePostOffset :: Maybe Text, - dateAggs :: Maybe Aggregations + dateAggs :: Maybe Aggregations, + dateCalendarInterval :: Maybe Interval, + dateFixedInterval :: Maybe FixedInterval, + dateTimeZone :: Maybe TimeZoneOffset, + dateOffset :: Maybe TimeOffset, + dateKeyed :: Maybe Keyed, + dateMissing :: Maybe OnMissingValue, + dateMinDocCount :: Maybe Int, + dateExtendedBounds :: Maybe ExtendedBounds } deriving stock (Eq, Show) @@ -321,6 +383,30 @@ dateHistogramAggregationAggsLens :: Lens' DateHistogramAggregation (Maybe Aggregations) dateHistogramAggregationAggsLens = lens dateAggs (\x y -> x {dateAggs = y}) +dateHistogramAggregationCalendarIntervalLens :: Lens' DateHistogramAggregation (Maybe Interval) +dateHistogramAggregationCalendarIntervalLens = lens dateCalendarInterval (\x y -> x {dateCalendarInterval = y}) + +dateHistogramAggregationFixedIntervalLens :: Lens' DateHistogramAggregation (Maybe FixedInterval) +dateHistogramAggregationFixedIntervalLens = lens dateFixedInterval (\x y -> x {dateFixedInterval = y}) + +dateHistogramAggregationTimeZoneLens :: Lens' DateHistogramAggregation (Maybe TimeZoneOffset) +dateHistogramAggregationTimeZoneLens = lens dateTimeZone (\x y -> x {dateTimeZone = y}) + +dateHistogramAggregationOffsetLens :: Lens' DateHistogramAggregation (Maybe TimeOffset) +dateHistogramAggregationOffsetLens = lens dateOffset (\x y -> x {dateOffset = y}) + +dateHistogramAggregationKeyedLens :: Lens' DateHistogramAggregation (Maybe Keyed) +dateHistogramAggregationKeyedLens = lens dateKeyed (\x y -> x {dateKeyed = y}) + +dateHistogramAggregationMissingLens :: Lens' DateHistogramAggregation (Maybe OnMissingValue) +dateHistogramAggregationMissingLens = lens dateMissing (\x y -> x {dateMissing = y}) + +dateHistogramAggregationMinDocCountLens :: Lens' DateHistogramAggregation (Maybe Int) +dateHistogramAggregationMinDocCountLens = lens dateMinDocCount (\x y -> x {dateMinDocCount = y}) + +dateHistogramAggregationExtendedBoundsLens :: Lens' DateHistogramAggregation (Maybe ExtendedBounds) +dateHistogramAggregationExtendedBoundsLens = lens dateExtendedBounds (\x y -> x {dateExtendedBounds = y}) + data DateRangeAggregation = DateRangeAggregation { draField :: FieldName, draFormat :: Maybe Text, @@ -419,6 +505,30 @@ newtype SumAggregation = SumAggregation {sumAggregationField :: FieldName} deriving stock (Eq, Show) +data AvgAggregation = AvgAggregation + { avgAggregationField :: FieldName, + avgAggregationMissing :: Maybe Missing + } + deriving stock (Eq, Show) + +avgAggregationFieldLens :: Lens' AvgAggregation FieldName +avgAggregationFieldLens = lens avgAggregationField (\x y -> x {avgAggregationField = y}) + +avgAggregationMissingLens :: Lens' AvgAggregation (Maybe Missing) +avgAggregationMissingLens = lens avgAggregationMissing (\x y -> x {avgAggregationMissing = y}) + +data MedianAbsoluteDeviationAggregation = MedianAbsoluteDeviationAggregation + { medianAbsoluteDeviationAggregationField :: FieldName, + medianAbsoluteDeviationAggregationMissing :: Maybe Missing + } + deriving stock (Eq, Show) + +medianAbsoluteDeviationAggregationFieldLens :: Lens' MedianAbsoluteDeviationAggregation FieldName +medianAbsoluteDeviationAggregationFieldLens = lens medianAbsoluteDeviationAggregationField (\x y -> x {medianAbsoluteDeviationAggregationField = y}) + +medianAbsoluteDeviationAggregationMissingLens :: Lens' MedianAbsoluteDeviationAggregation (Maybe Missing) +medianAbsoluteDeviationAggregationMissingLens = lens medianAbsoluteDeviationAggregationMissing (\x y -> x {medianAbsoluteDeviationAggregationMissing = y}) + mkTermsAggregation :: Text -> TermsAggregation mkTermsAggregation t = TermsAggregation @@ -437,16 +547,87 @@ mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation -mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing +mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing mkCardinalityAggregation :: FieldName -> CardinalityAggregation -mkCardinalityAggregation t = CardinalityAggregation t Nothing +mkCardinalityAggregation t = CardinalityAggregation t Nothing Nothing mkStatsAggregation :: FieldName -> StatisticsAggregation mkStatsAggregation = StatisticsAggregation Basic mkExtendedStatsAggregation :: FieldName -> StatisticsAggregation mkExtendedStatsAggregation = StatisticsAggregation Extended + +data CompositeAggregationSourceAggregation + = CompositeTermsAgg TermsAggregation + | CompositeDateHistogramAgg DateHistogramAggregation + deriving stock (Eq, Show) + +compositeAggregationSourceAggregationCompositeTermsAggPrism :: Prism' CompositeAggregationSourceAggregation TermsAggregation +compositeAggregationSourceAggregationCompositeTermsAggPrism = prism CompositeTermsAgg extract + where + extract s = + case s of + CompositeTermsAgg x -> Right x + _ -> Left s + +compositeAggregationSourceAggregationCompositeDateHistogramAggPrism :: Prism' CompositeAggregationSourceAggregation DateHistogramAggregation +compositeAggregationSourceAggregationCompositeDateHistogramAggPrism = prism CompositeDateHistogramAgg extract + where + extract s = + case s of + CompositeDateHistogramAgg x -> Right x + _ -> Left s + +instance ToJSON CompositeAggregationSourceAggregation where + toJSON x = + toJSON $ + case x of + CompositeTermsAgg agg -> TermsAgg agg + CompositeDateHistogramAgg agg -> DateHistogramAgg agg + +data CompositeAggregationSource = CompositeAggregationSource + { compositeAggregationSourceKey :: Key, + compositeAggregationSourceAggregation :: CompositeAggregationSourceAggregation + } + deriving stock (Eq, Show) + +compositeAggregationSourceKeyLens :: Lens' CompositeAggregationSource Key +compositeAggregationSourceKeyLens = lens compositeAggregationSourceKey (\x y -> x {compositeAggregationSourceKey = y}) + +compositeAggregationSourceAggregationLens :: Lens' CompositeAggregationSource CompositeAggregationSourceAggregation +compositeAggregationSourceAggregationLens = lens compositeAggregationSourceAggregation (\x y -> x {compositeAggregationSourceAggregation = y}) + +instance ToJSON CompositeAggregationSource where + toJSON (CompositeAggregationSource k agg) = + object [k .= agg] + +data CompositeAggregation = CompositeAggregation + { compositeAggregationSize :: Maybe Int, + compositeAggregationSources :: [CompositeAggregationSource], + compositeAggregationAfter :: Maybe Value + } + deriving stock (Eq, Show) + +compositeAggregationSizeLens :: Lens' CompositeAggregation (Maybe Int) +compositeAggregationSizeLens = lens compositeAggregationSize (\x y -> x {compositeAggregationSize = y}) + +compositeAggregationSourcesLens :: Lens' CompositeAggregation [CompositeAggregationSource] +compositeAggregationSourcesLens = lens compositeAggregationSources (\x y -> x {compositeAggregationSources = y}) + +compositeAggregationAfterLens :: Lens' CompositeAggregation (Maybe Value) +compositeAggregationAfterLens = lens compositeAggregationAfter (\x y -> x {compositeAggregationAfter = y}) + +instance ToJSON CompositeAggregation where + toJSON (CompositeAggregation size sources after) = + omitNulls + [ "size" .= size, + "sources" .= sources, + "after" .= after + ] + +mkCompositeAggregation :: [CompositeAggregationSource] -> CompositeAggregation +mkCompositeAggregation sources = CompositeAggregation Nothing sources Nothing type AggregationResults = M.Map Key Value diff --git a/src/Database/Bloodhound/Internal/Versions/Common/Types/Newtypes.hs b/src/Database/Bloodhound/Internal/Versions/Common/Types/Newtypes.hs --- a/src/Database/Bloodhound/Internal/Versions/Common/Types/Newtypes.hs +++ b/src/Database/Bloodhound/Internal/Versions/Common/Types/Newtypes.hs @@ -60,6 +60,10 @@ unMS, TokenFilter (..), CharFilter (..), + Missing (..), + PrecisionThreshold (..), + OnMissingValue (..), + Keyed (..), ) where @@ -407,4 +411,20 @@ newtype CharFilter = CharFilter Text + deriving newtype (Eq, Show, FromJSON, ToJSON) + +newtype Missing + = Missing Int + deriving newtype (Eq, Show, FromJSON, ToJSON) + +newtype PrecisionThreshold + = PrecisionThreshold Int + deriving newtype (Eq, Show, FromJSON, ToJSON) + +newtype OnMissingValue + = OnMissingValue Text + deriving newtype (Eq, Show, FromJSON, ToJSON) + +newtype Keyed + = Keyed Bool deriving newtype (Eq, Show, FromJSON, ToJSON) diff --git a/src/Database/Bloodhound/Internal/Versions/Common/Types/Search.hs b/src/Database/Bloodhound/Internal/Versions/Common/Types/Search.hs --- a/src/Database/Bloodhound/Internal/Versions/Common/Types/Search.hs +++ b/src/Database/Bloodhound/Internal/Versions/Common/Types/Search.hs @@ -19,6 +19,7 @@ SearchTemplateId (..), SearchTemplateSource (..), SearchType (..), + DocvalueField (..), Source (..), TimeUnits (..), TrackSortScores, @@ -72,6 +73,7 @@ searchAfterKey :: Maybe SearchAfterKey, fields :: Maybe [FieldName], scriptFields :: Maybe ScriptFields, + docvalueFields :: Maybe [DocvalueField], source :: Maybe Source, -- | Only one Suggestion request / response per Search is supported. suggestBody :: Maybe Suggest, @@ -94,6 +96,7 @@ sAfter sFields sScriptFields + sDocvalueFields sSource sSuggest pPointInTime @@ -109,6 +112,7 @@ "search_after" .= sAfter, "fields" .= sFields, "script_fields" .= sScriptFields, + "docvalue_fields" .= sDocvalueFields, "_source" .= sSource, "suggest" .= sSuggest, "pit" .= pPointInTime @@ -361,3 +365,17 @@ getTemplateScriptFoundLens :: Lens' GetTemplateScript Bool getTemplateScriptFoundLens = lens getTemplateScriptFound (\x y -> x {getTemplateScriptFound = y}) + +data DocvalueField + = DocvalueFieldName FieldName + | DocvalueFieldNameAndFormat FieldName Text + deriving stock (Eq, Show) + +instance ToJSON DocvalueField where + toJSON (DocvalueFieldName fn) = toJSON fn + toJSON (DocvalueFieldNameAndFormat fn ft) = object ["field" .= fn, "format" .= ft] + +instance FromJSON DocvalueField where + parseJSON (String fn) = pure $ DocvalueFieldName $ FieldName fn + parseJSON (Object o) = DocvalueFieldNameAndFormat <$> o .: "field" <*> o .: "format" + parseJSON _ = empty diff --git a/src/Database/Bloodhound/Internal/Versions/Common/Types/Sort.hs b/src/Database/Bloodhound/Internal/Versions/Common/Types/Sort.hs --- a/src/Database/Bloodhound/Internal/Versions/Common/Types/Sort.hs +++ b/src/Database/Bloodhound/Internal/Versions/Common/Types/Sort.hs @@ -83,7 +83,7 @@ -- default False ignoreUnmapped :: Maybe Text, sortMode :: Maybe SortMode, - missingSort :: Maybe Missing, + missingSort :: Maybe SortMissingValue, nestedFilter :: Maybe Filter } deriving stock (Eq, Show) @@ -100,7 +100,7 @@ defaultSortSortModeLens :: Lens' DefaultSort (Maybe SortMode) defaultSortSortModeLens = lens sortMode (\x y -> x {sortMode = y}) -defaultSortMissingSortLens :: Lens' DefaultSort (Maybe Missing) +defaultSortMissingSortLens :: Lens' DefaultSort (Maybe SortMissingValue) defaultSortMissingSortLens = lens missingSort (\x y -> x {missingSort = y}) defaultSortNestedFilterLens :: Lens' DefaultSort (Maybe Filter) @@ -123,13 +123,13 @@ -- sorted last, first, or using a custom value as a substitute. -- -- -data Missing +data SortMissingValue = LastMissing | FirstMissing | CustomMissing Text deriving stock (Eq, Show) -instance ToJSON Missing where +instance ToJSON SortMissingValue where toJSON LastMissing = String "_last" toJSON FirstMissing = String "_first" toJSON (CustomMissing txt) = String txt diff --git a/src/Database/Bloodhound/Internal/Versions/Common/Types/Units.hs b/src/Database/Bloodhound/Internal/Versions/Common/Types/Units.hs --- a/src/Database/Bloodhound/Internal/Versions/Common/Types/Units.hs +++ b/src/Database/Bloodhound/Internal/Versions/Common/Types/Units.hs @@ -4,14 +4,28 @@ ( Bytes (..), Interval (..), TimeInterval (..), + FixedInterval (..), + TimeZoneOffset (..), + TimeOffset (..), + ExtendedBounds (..), gigabytes, kilobytes, megabytes, parseStringInterval, + fixedIntervalDurationLens, + fixedIntervalUnitLens, + timeZoneOffsetHoursLens, + timeZoneOffsetMinutesLens, + extendedBoundsMaxLens, + extendedBoundsMinLens, ) where +import Data.Int +import qualified Data.Text as T +import Data.Word import Database.Bloodhound.Internal.Utils.Imports +import Text.Printf (printf) import Text.Read (Read (..)) import qualified Text.Read as TR @@ -98,3 +112,68 @@ unitNDT Hours = 60 * 60 unitNDT Days = 24 * 60 * 60 unitNDT Weeks = 7 * 24 * 60 * 60 + +data FixedInterval = FixedInterval + { fixedIntervalDuration :: Word32, + fixedIntervalUnit :: TimeInterval + } + deriving stock (Eq, Show) + +fixedIntervalDurationLens :: Lens' FixedInterval Word32 +fixedIntervalDurationLens = lens fixedIntervalDuration (\x y -> x {fixedIntervalDuration = y}) + +fixedIntervalUnitLens :: Lens' FixedInterval TimeInterval +fixedIntervalUnitLens = lens fixedIntervalUnit (\x y -> x {fixedIntervalUnit = y}) + +instance ToJSON FixedInterval where + toJSON (FixedInterval duration unit) = String (showText duration <> T.pack (show unit)) + +data TimeZoneOffset = TimeZoneOffset + { timeZoneOffsetHours :: Int8, + timeZoneOffsetMinutes :: Word8 + } + deriving stock (Eq, Show) + +timeZoneOffsetHoursLens :: Lens' TimeZoneOffset Int8 +timeZoneOffsetHoursLens = lens timeZoneOffsetHours (\x y -> x {timeZoneOffsetHours = y}) + +timeZoneOffsetMinutesLens :: Lens' TimeZoneOffset Word8 +timeZoneOffsetMinutesLens = lens timeZoneOffsetMinutes (\x y -> x {timeZoneOffsetMinutes = y}) + +instance ToJSON TimeZoneOffset where + toJSON (TimeZoneOffset hours minutes) = + String $ + (if hours >= 0 then "+" else "") + <> T.pack (printf "%02d" hours) + <> ":" + <> T.pack (printf "%02d" minutes) + +newtype TimeOffset = TimeOffset Int8 + deriving stock (Eq, Show) + deriving newtype (FromJSON) + +instance ToJSON TimeOffset where + toJSON (TimeOffset offset) = + String $ + (if offset >= 0 then "+" else "") + <> showText offset + <> "h" + +data ExtendedBounds = ExtendedBounds + { extendedBoundsMin :: Value, + extendedBoundsMax :: Value + } + deriving stock (Eq, Show) + +extendedBoundsMinLens :: Lens' ExtendedBounds Value +extendedBoundsMinLens = lens extendedBoundsMin (\x y -> x {extendedBoundsMin = y}) + +extendedBoundsMaxLens :: Lens' ExtendedBounds Value +extendedBoundsMaxLens = lens extendedBoundsMax (\x y -> x {extendedBoundsMax = y}) + +instance ToJSON ExtendedBounds where + toJSON (ExtendedBounds minVal maxVal) = + object + [ "min" .= minVal, + "max" .= maxVal + ] diff --git a/tests/Test/SearchAfterSpec.hs b/tests/Test/SearchAfterSpec.hs --- a/tests/Test/SearchAfterSpec.hs +++ b/tests/Test/SearchAfterSpec.hs @@ -30,6 +30,7 @@ searchAfterKey = Just searchAfterKey', fields = Nothing, scriptFields = Nothing, + docvalueFields = Nothing, source = Nothing, suggestBody = Nothing, pointInTime = Nothing diff --git a/tests/Test/SortingSpec.hs b/tests/Test/SortingSpec.hs --- a/tests/Test/SortingSpec.hs +++ b/tests/Test/SortingSpec.hs @@ -28,6 +28,7 @@ fields = Nothing, scriptFields = Nothing, source = Nothing, + docvalueFields = Nothing, suggestBody = Nothing, pointInTime = Nothing }