mirror of
https://github.com/typeable/bloodhound.git
synced 2024-08-16 11:50:34 +03:00
WIP v1 savepoint
I'm trying out the technique of loading a corresponding V5 module into GHCi, :browse-ing the exports, explicitly setting those for the V1 and then pulling definitions out of the old V1 types module. Working well so far.
This commit is contained in:
Michael Xavier
parent
5b6c05f6ea
commit
99788cc992
@ -7,65 +7,44 @@ module Bloodhound.Import
|
||||
, parseReadText
|
||||
, readMay
|
||||
, showText
|
||||
, deleteSeveral
|
||||
) where
|
||||
|
||||
import Control.Applicative as X (Alternative(..), optional)
|
||||
import Control.Exception as X (Exception)
|
||||
import Control.Monad as X ( MonadPlus(..)
|
||||
, (<=<)
|
||||
, forM
|
||||
)
|
||||
import Control.Monad.Fix as X (MonadFix)
|
||||
import Control.Monad.IO.Class as X (MonadIO(..))
|
||||
import Control.Monad.Catch as X ( MonadCatch
|
||||
, MonadMask
|
||||
, MonadThrow
|
||||
)
|
||||
import Control.Monad.Except as X (MonadError)
|
||||
import Control.Monad.Reader as X ( MonadReader (..)
|
||||
, MonadTrans (..)
|
||||
, ReaderT (..)
|
||||
)
|
||||
import Control.Monad.State as X (MonadState)
|
||||
import Control.Monad.Writer as X (MonadWriter)
|
||||
import Data.Aeson as X
|
||||
import Data.Aeson.Types as X ( Pair
|
||||
, Parser
|
||||
, emptyObject
|
||||
, parseEither
|
||||
, parseMaybe
|
||||
, typeMismatch
|
||||
)
|
||||
import Data.Bifunctor as X (first)
|
||||
import Data.Char as X (isNumber)
|
||||
import Data.Hashable as X (Hashable)
|
||||
import Data.List as X ( foldl'
|
||||
, intercalate
|
||||
, nub
|
||||
)
|
||||
import Data.List.NonEmpty as X ( NonEmpty (..)
|
||||
, toList
|
||||
)
|
||||
import Data.Maybe as X ( catMaybes
|
||||
, fromMaybe
|
||||
, isNothing
|
||||
, maybeToList
|
||||
)
|
||||
import Data.Scientific as X (Scientific)
|
||||
import Data.Semigroup as X (Semigroup(..))
|
||||
import Data.Text as X (Text)
|
||||
import Data.Time.Calendar as X ( Day(..)
|
||||
, showGregorian
|
||||
)
|
||||
import Data.Time.Clock as X ( NominalDiffTime
|
||||
, UTCTime
|
||||
)
|
||||
import Data.Time.Clock.POSIX as X
|
||||
import Control.Applicative as X (Alternative (..), optional)
|
||||
import Control.Exception as X (Exception)
|
||||
import Control.Monad as X (MonadPlus (..), forM, (<=<))
|
||||
import Control.Monad.Catch as X (MonadCatch, MonadMask,
|
||||
MonadThrow)
|
||||
import Control.Monad.Except as X (MonadError)
|
||||
import Control.Monad.Fix as X (MonadFix)
|
||||
import Control.Monad.IO.Class as X (MonadIO (..))
|
||||
import Control.Monad.Reader as X (MonadReader (..),
|
||||
MonadTrans (..), ReaderT (..))
|
||||
import Control.Monad.State as X (MonadState)
|
||||
import Control.Monad.Writer as X (MonadWriter)
|
||||
import Data.Aeson as X
|
||||
import Data.Aeson.Types as X (Pair, Parser, emptyObject,
|
||||
parseEither, parseMaybe,
|
||||
typeMismatch)
|
||||
import Data.Bifunctor as X (first)
|
||||
import Data.Char as X (isNumber)
|
||||
import Data.Hashable as X (Hashable)
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.List as X (foldl', intercalate, nub)
|
||||
import Data.List.NonEmpty as X (NonEmpty (..), toList)
|
||||
import Data.Maybe as X (catMaybes, fromMaybe,
|
||||
isNothing, maybeToList)
|
||||
import Data.Scientific as X (Scientific)
|
||||
import Data.Semigroup as X (Semigroup (..))
|
||||
import Data.Text as X (Text)
|
||||
import Data.Time.Calendar as X (Day (..), showGregorian)
|
||||
import Data.Time.Clock as X (NominalDiffTime, UTCTime)
|
||||
import Data.Time.Clock.POSIX as X
|
||||
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Traversable as DT
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Traversable as DT
|
||||
import qualified Data.Vector as V
|
||||
import qualified Network.HTTP.Types.Method as NHTM
|
||||
|
||||
type LByteString = BL.ByteString
|
||||
@ -92,3 +71,6 @@ omitNulls = object . filter notNull where
|
||||
parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
|
||||
parseNEJSON [] = fail "Expected non-empty list"
|
||||
parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
|
||||
|
||||
deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
|
||||
deleteSeveral ks hm = foldr HM.delete hm ks
|
||||
|
||||
@ -1,9 +1,17 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Database.V1.Bloodhound.Internal.Aggregation where
|
||||
|
||||
import Bloodhound.Import
|
||||
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Text
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text as T
|
||||
|
||||
import Database.V1.Bloodhound.Internal.Newtypes
|
||||
import Database.V1.Bloodhound.Internal.Query
|
||||
import Database.V1.Bloodhound.Internal.Sort
|
||||
|
||||
|
||||
type Aggregations = M.Map Text Aggregation
|
||||
@ -22,7 +30,7 @@ data Aggregation = TermsAgg TermsAggregation
|
||||
| DateRangeAgg DateRangeAggregation
|
||||
| MissingAgg MissingAggregation
|
||||
| TopHitsAgg TopHitsAggregation
|
||||
deriving (Eq, Read, Show, Generic, Typeable)
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
instance ToJSON Aggregation where
|
||||
@ -84,7 +92,7 @@ data TopHitsAggregation = TopHitsAggregation
|
||||
|
||||
data MissingAggregation = MissingAggregation
|
||||
{ maField :: Text
|
||||
} deriving (Eq, Read, Show, Generic, Typeable)
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data TermsAggregation = TermsAggregation { term :: Either Text Text
|
||||
, termInclude :: Maybe TermInclusion
|
||||
@ -96,11 +104,11 @@ data TermsAggregation = TermsAggregation { term :: Either Text Text
|
||||
, termCollectMode :: Maybe CollectionMode
|
||||
, termExecutionHint :: Maybe ExecutionHint
|
||||
, termAggs :: Maybe Aggregations
|
||||
} deriving (Eq, Read, Show, Generic, Typeable)
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,
|
||||
precisionThreshold :: Maybe Int
|
||||
} deriving (Eq, Read, Show, Generic, Typeable)
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
|
||||
, dateInterval :: Interval
|
||||
@ -111,25 +119,25 @@ data DateHistogramAggregation = DateHistogramAggregation { dateField :: Fie
|
||||
, datePreOffset :: Maybe Text
|
||||
, datePostOffset :: Maybe Text
|
||||
, dateAggs :: Maybe Aggregations
|
||||
} deriving (Eq, Read, Show, Generic, Typeable)
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
|
||||
, draFormat :: Maybe Text
|
||||
, draRanges :: NonEmpty DateRangeAggRange
|
||||
} deriving (Eq, Read, Show, Generic, Typeable)
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data DateRangeAggRange = DateRangeFrom DateMathExpr
|
||||
| DateRangeTo DateMathExpr
|
||||
| DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Read, Show, Generic, Typeable)
|
||||
| DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Show)
|
||||
|
||||
-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
|
||||
data ValueCountAggregation = FieldValueCount FieldName
|
||||
| ScriptValueCount Script deriving (Eq, Read, Show, Generic, Typeable)
|
||||
| ScriptValueCount Script deriving (Eq, Show)
|
||||
|
||||
-- | Single-bucket filter aggregations. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-filter-aggregation.html#search-aggregations-bucket-filter-aggregation> for more information.
|
||||
data FilterAggregation = FilterAggregation { faFilter :: Filter
|
||||
, faAggs :: Maybe Aggregations} deriving (Eq, Read, Show, Generic, Typeable)
|
||||
, faAggs :: Maybe Aggregations} deriving (Eq, Show)
|
||||
|
||||
mkTermsAggregation :: Text -> TermsAggregation
|
||||
mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
@ -143,3 +151,76 @@ mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothi
|
||||
mkCardinalityAggregation :: FieldName -> CardinalityAggregation
|
||||
mkCardinalityAggregation t = CardinalityAggregation t Nothing
|
||||
|
||||
data TermInclusion = TermInclusion Text
|
||||
| TermPattern Text Text deriving (Eq, Show)
|
||||
|
||||
instance ToJSON TermInclusion where
|
||||
toJSON (TermInclusion x) = toJSON x
|
||||
toJSON (TermPattern pattern flags) =
|
||||
omitNulls [ "pattern" .= pattern
|
||||
, "flags" .= flags]
|
||||
|
||||
data TermOrder = TermOrder
|
||||
{ termSortField :: Text
|
||||
, termSortOrder :: SortOrder } deriving (Eq, Show)
|
||||
|
||||
instance ToJSON TermOrder where
|
||||
toJSON (TermOrder termSortField termSortOrder) =
|
||||
object [termSortField .= termSortOrder]
|
||||
|
||||
|
||||
data ExecutionHint = Ordinals
|
||||
| GlobalOrdinals
|
||||
| GlobalOrdinalsHash
|
||||
| GlobalOrdinalsLowCardinality
|
||||
| Map deriving (Eq, Show)
|
||||
|
||||
instance ToJSON ExecutionHint where
|
||||
toJSON Ordinals = "ordinals"
|
||||
toJSON GlobalOrdinals = "global_ordinals"
|
||||
toJSON GlobalOrdinalsHash = "global_ordinals_hash"
|
||||
toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
|
||||
toJSON Map = "map"
|
||||
|
||||
|
||||
-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
|
||||
data DateMathExpr =
|
||||
DateMathExpr DateMathAnchor [DateMathModifier]
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance ToJSON DateMathExpr where
|
||||
toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
|
||||
where fmtA DMNow = "now"
|
||||
fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
|
||||
fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
|
||||
fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
|
||||
fmtMod (RoundDownTo u) = "/" <> fmtU u
|
||||
fmtU DMYear = "y"
|
||||
fmtU DMMonth = "M"
|
||||
fmtU DMWeek = "w"
|
||||
fmtU DMDay = "d"
|
||||
fmtU DMHour = "h"
|
||||
fmtU DMMinute = "m"
|
||||
fmtU DMSecond = "s"
|
||||
|
||||
-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
|
||||
data DateMathAnchor =
|
||||
DMNow
|
||||
| DMDate Day
|
||||
deriving (Eq, Show)
|
||||
|
||||
data DateMathModifier =
|
||||
AddTime Int DateMathUnit
|
||||
| SubtractTime Int DateMathUnit
|
||||
| RoundDownTo DateMathUnit
|
||||
deriving (Eq, Show)
|
||||
|
||||
data DateMathUnit =
|
||||
DMYear
|
||||
| DMMonth
|
||||
| DMWeek
|
||||
| DMDay
|
||||
| DMHour
|
||||
| DMMinute
|
||||
| DMSecond
|
||||
deriving (Eq, Show)
|
||||
|
||||
@ -1,13 +1,21 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Database.V1.Bloodhound.Internal.Client where
|
||||
|
||||
import Bloodhound.Import
|
||||
|
||||
import Control.Applicative as A
|
||||
import Control.Monad.Reader
|
||||
import Data.Aeson
|
||||
import Data.Text (Text)
|
||||
import Data.Typeable (Typeable)
|
||||
import GHC.Generics (Generic)
|
||||
import Control.Applicative as A
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Version as Vers
|
||||
import Network.HTTP.Client
|
||||
import Text.Read (Read (..))
|
||||
import qualified Text.Read as TR
|
||||
|
||||
import Database.V1.Bloodhound.Internal.Newtypes
|
||||
|
||||
|
||||
{-| Common environment for Elasticsearch calls. Connections will be
|
||||
@ -24,7 +32,7 @@ instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) wher
|
||||
|
||||
{-| 'Server' is used with the client functions to point at the ES instance
|
||||
-}
|
||||
newtype Server = Server Text deriving (Eq, Show, Generic, Typeable, FromJSON)
|
||||
newtype Server = Server Text deriving (Eq, Show, FromJSON)
|
||||
|
||||
{-| All API calls to Elasticsearch operate within
|
||||
MonadBH
|
||||
@ -89,11 +97,11 @@ data Version = Version { number :: VersionNumber
|
||||
, build_hash :: BuildHash
|
||||
, build_timestamp :: UTCTime
|
||||
, build_snapshot :: Bool
|
||||
, lucene_version :: VersionNumber } deriving (Eq, Read, Show, Generic, Typeable)
|
||||
, lucene_version :: VersionNumber } deriving (Eq, Show)
|
||||
|
||||
-- | Traditional software versioning number
|
||||
newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version
|
||||
} deriving (Eq, Read, Show, Generic, Typeable, Ord)
|
||||
} deriving (Eq, Show, Ord)
|
||||
|
||||
{-| 'Status' is a data type for describing the JSON body returned by
|
||||
Elasticsearch when you query its status. This was deprecated in 1.2.0.
|
||||
@ -105,7 +113,7 @@ data Status = Status { ok :: Maybe Bool
|
||||
, status :: Int
|
||||
, name :: Text
|
||||
, version :: Version
|
||||
, tagline :: Text } deriving (Eq, Read, Show, Generic)
|
||||
, tagline :: Text } deriving (Eq, Show)
|
||||
|
||||
{-| 'IndexSettings' is used to configure the shards and replicas when you create
|
||||
an Elasticsearch Index.
|
||||
@ -115,7 +123,7 @@ data Status = Status { ok :: Maybe Bool
|
||||
|
||||
data IndexSettings =
|
||||
IndexSettings { indexShards :: ShardCount
|
||||
, indexReplicas :: ReplicaCount } deriving (Eq, Read, Show, Generic, Typeable)
|
||||
, indexReplicas :: ReplicaCount } deriving (Eq, Show)
|
||||
|
||||
{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
|
||||
defaultIndexSettings :: IndexSettings
|
||||
@ -133,7 +141,7 @@ data IndexOptimizationSettings =
|
||||
-- ^ Should the optimize process only expunge segments with deletes in them? If the purpose of the optimization is to free disk space, this should be set to True.
|
||||
, flushAfterOptimize :: Bool
|
||||
-- ^ Should a flush be performed after the optimize.
|
||||
} deriving (Eq, Show, Generic, Typeable)
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
{-| 'defaultIndexOptimizationSettings' implements the default settings that
|
||||
@ -195,7 +203,7 @@ data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
|
||||
| IndexCompoundFormat CompoundFormat
|
||||
| IndexCompoundOnFlush Bool
|
||||
| WarmerEnabled Bool
|
||||
deriving (Eq, Show, Generic, Typeable)
|
||||
deriving (Eq, Show)
|
||||
|
||||
data AllocationPolicy = AllocAll
|
||||
-- ^ Allows shard allocation for all shards.
|
||||
@ -205,12 +213,12 @@ data AllocationPolicy = AllocAll
|
||||
-- ^ Allows shard allocation only for primary shards for new indices.
|
||||
| AllocNone
|
||||
-- ^ No shard allocation is allowed
|
||||
deriving (Eq, Read, Show, Generic, Typeable)
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ReplicaBounds = ReplicasBounded Int Int
|
||||
| ReplicasLowerBounded Int
|
||||
| ReplicasUnbounded
|
||||
deriving (Eq, Read, Show, Generic, Typeable)
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | A measure of bytes used for various configurations. You may want
|
||||
-- to use smart constructors like 'gigabytes' for larger values.
|
||||
@ -223,7 +231,7 @@ data ReplicaBounds = ReplicasBounded Int Int
|
||||
--
|
||||
-- >>> kilobytes 9
|
||||
-- Bytes 9000
|
||||
newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)
|
||||
newtype Bytes = Bytes Int deriving (Eq, Show, Ord, ToJSON, FromJSON)
|
||||
|
||||
gigabytes :: Int -> Bytes
|
||||
gigabytes n = megabytes (1000 * n)
|
||||
@ -235,3 +243,112 @@ megabytes n = kilobytes (1000 * n)
|
||||
|
||||
kilobytes :: Int -> Bytes
|
||||
kilobytes n = Bytes (1000 * n)
|
||||
|
||||
|
||||
data Interval = Year
|
||||
| Quarter
|
||||
| Month
|
||||
| Week
|
||||
| Day
|
||||
| Hour
|
||||
| Minute
|
||||
| Second deriving (Eq, Show)
|
||||
|
||||
instance ToJSON Interval where
|
||||
toJSON Year = "year"
|
||||
toJSON Quarter = "quarter"
|
||||
toJSON Month = "month"
|
||||
toJSON Week = "week"
|
||||
toJSON Day = "day"
|
||||
toJSON Hour = "hour"
|
||||
toJSON Minute = "minute"
|
||||
toJSON Second = "second"
|
||||
|
||||
parseStringInterval :: (Monad m) => String -> m NominalDiffTime
|
||||
parseStringInterval s = case span isNumber s of
|
||||
("", _) -> fail "Invalid interval"
|
||||
(nS, unitS) -> case (readMay nS, readMay unitS) of
|
||||
(Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
|
||||
(Nothing, _) -> fail "Invalid interval number"
|
||||
(_, Nothing) -> fail "Invalid interval unit"
|
||||
where
|
||||
unitNDT Seconds = 1
|
||||
unitNDT Minutes = 60
|
||||
unitNDT Hours = 60 * 60
|
||||
unitNDT Days = 24 * 60 * 60
|
||||
unitNDT Weeks = 7 * 24 * 60 * 60
|
||||
|
||||
data TimeInterval = Weeks
|
||||
| Days
|
||||
| Hours
|
||||
| Minutes
|
||||
| Seconds deriving Eq
|
||||
|
||||
instance Show TimeInterval where
|
||||
show Weeks = "w"
|
||||
show Days = "d"
|
||||
show Hours = "h"
|
||||
show Minutes = "m"
|
||||
show Seconds = "s"
|
||||
|
||||
instance Read TimeInterval where
|
||||
readPrec = f =<< TR.get
|
||||
where
|
||||
f 'w' = return Weeks
|
||||
f 'd' = return Days
|
||||
f 'h' = return Hours
|
||||
f 'm' = return Minutes
|
||||
f 's' = return Seconds
|
||||
f _ = fail "TimeInterval expected one of w, d, h, m, s"
|
||||
|
||||
-- | Typically a 7 character hex string.
|
||||
newtype BuildHash = BuildHash { buildHash :: Text }
|
||||
deriving (Eq, Ord, Show, FromJSON, ToJSON)
|
||||
|
||||
data NodeAttrFilter = NodeAttrFilter
|
||||
{ nodeAttrFilterName :: NodeAttrName
|
||||
, nodeAttrFilterValues :: NonEmpty Text }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
newtype NodeAttrName = NodeAttrName Text deriving (Eq, Ord, Show)
|
||||
|
||||
data InitialShardCount = QuorumShards
|
||||
| QuorumMinus1Shards
|
||||
| FullShards
|
||||
| FullMinus1Shards
|
||||
| ExplicitShards Int
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance FromJSON InitialShardCount where
|
||||
parseJSON v = withText "InitialShardCount" parseText v
|
||||
<|> ExplicitShards <$> parseJSON v
|
||||
where parseText "quorum" = pure QuorumShards
|
||||
parseText "quorum-1" = pure QuorumMinus1Shards
|
||||
parseText "full" = pure FullShards
|
||||
parseText "full-1" = pure FullMinus1Shards
|
||||
parseText _ = mzero
|
||||
|
||||
instance ToJSON InitialShardCount where
|
||||
toJSON QuorumShards = String "quorum"
|
||||
toJSON QuorumMinus1Shards = String "quorum-1"
|
||||
toJSON FullShards = String "full"
|
||||
toJSON FullMinus1Shards = String "full-1"
|
||||
toJSON (ExplicitShards x) = toJSON x
|
||||
|
||||
data FSType = FSSimple
|
||||
| FSBuffered deriving (Eq, Show)
|
||||
|
||||
instance ToJSON FSType where
|
||||
toJSON FSSimple = "simple"
|
||||
toJSON FSBuffered = "buffered"
|
||||
|
||||
instance FromJSON FSType where
|
||||
parseJSON = withText "FSType" parse
|
||||
where parse "simple" = pure FSSimple
|
||||
parse "buffered" = pure FSBuffered
|
||||
parse t = fail ("Invalid FSType: " <> show t)
|
||||
|
||||
data CompoundFormat = CompoundFileFormat Bool
|
||||
| MergeSegmentVsTotalIndex Double
|
||||
-- ^ percentage between 0 and 1 where 0 is false, 1 is true
|
||||
deriving (Eq, Show)
|
||||
|
||||
161
src/Database/V1/Bloodhound/Internal/Newtypes.hs
Normal file
161
src/Database/V1/Bloodhound/Internal/Newtypes.hs
Normal file
@ -0,0 +1,161 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Database.V1.Bloodhound.Internal.Newtypes where
|
||||
|
||||
|
||||
import Bloodhound.Import
|
||||
|
||||
|
||||
newtype From = From Int deriving (Eq, Show, ToJSON)
|
||||
newtype Size = Size Int deriving (Eq, Show, 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.
|
||||
-}
|
||||
newtype FieldName =
|
||||
FieldName Text
|
||||
deriving (Eq, Read, Show, ToJSON, FromJSON)
|
||||
|
||||
newtype Boost =
|
||||
Boost Double
|
||||
deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
newtype BoostTerms =
|
||||
BoostTerms Double
|
||||
deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
{-| 'ReplicaCount' is part of 'IndexSettings' -}
|
||||
newtype ReplicaCount =
|
||||
ReplicaCount Int
|
||||
deriving (Eq, Show, ToJSON)
|
||||
|
||||
{-| 'ShardCount' is part of 'IndexSettings' -}
|
||||
newtype ShardCount =
|
||||
ShardCount Int
|
||||
deriving (Eq, Show, ToJSON)
|
||||
|
||||
|
||||
{-| 'TemplateName' is used to describe which template to query/create/delete
|
||||
-}
|
||||
newtype TemplateName = TemplateName Text deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
{-| 'TemplatePattern' represents a pattern which is matched against index names
|
||||
-}
|
||||
newtype TemplatePattern = TemplatePattern Text deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
{-| 'MappingName' is part of mappings which are how ES describes and schematizes
|
||||
the data in the indices.
|
||||
-}
|
||||
newtype MappingName = MappingName Text deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
|
||||
Can be set by the user or created by ES itself. Often used in client
|
||||
functions for poking at specific documents.
|
||||
-}
|
||||
newtype DocId = DocId Text deriving (Eq, Show, 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)
|
||||
|
||||
{-| 'Script' is often used in place of 'FieldName' to specify more
|
||||
complex ways of extracting a value from a document.
|
||||
-}
|
||||
newtype Script = Script { scriptText :: Text } deriving (Eq, Show)
|
||||
|
||||
{-| 'CacheName' is used in 'RegexpFilter' for describing the
|
||||
'CacheKey' keyed caching behavior.
|
||||
-}
|
||||
newtype CacheName = CacheName Text deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
|
||||
-}
|
||||
newtype CacheKey =
|
||||
CacheKey Text deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype Existence =
|
||||
Existence Bool deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype NullValue =
|
||||
NullValue Bool deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype CutoffFrequency =
|
||||
CutoffFrequency Double deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype Analyzer =
|
||||
Analyzer Text deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype MaxExpansions =
|
||||
MaxExpansions Int deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
{-| '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, ToJSON, FromJSON)
|
||||
newtype Tiebreaker =
|
||||
Tiebreaker Double deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
{-| '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, ToJSON, FromJSON)
|
||||
newtype DisableCoord =
|
||||
DisableCoord Bool deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype IgnoreTermFrequency =
|
||||
IgnoreTermFrequency Bool deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype MinimumTermFrequency =
|
||||
MinimumTermFrequency Int deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype MaxQueryTerms =
|
||||
MaxQueryTerms Int deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype Fuzziness =
|
||||
Fuzziness Double deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
|
||||
newtype PrefixLength =
|
||||
PrefixLength Int deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype TypeName =
|
||||
TypeName Text deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype PercentMatch =
|
||||
PercentMatch Double deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype StopWord =
|
||||
StopWord Text deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype QueryPath =
|
||||
QueryPath Text deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
{-| 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, ToJSON, FromJSON)
|
||||
newtype LowercaseExpanded =
|
||||
LowercaseExpanded Bool deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype EnablePositionIncrements =
|
||||
EnablePositionIncrements Bool deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
{-| 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, ToJSON, FromJSON)
|
||||
|
||||
{-| 'GeneratePhraseQueries' defaults to false.
|
||||
-}
|
||||
newtype GeneratePhraseQueries =
|
||||
GeneratePhraseQueries Bool deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
{-| 'Locale' is used for string conversions - defaults to ROOT.
|
||||
-}
|
||||
newtype Locale = Locale Text deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype MaxWordLength = MaxWordLength Int deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype MinWordLength = MinWordLength Int deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
|
||||
phrase matches. Default is 0.
|
||||
-}
|
||||
newtype PhraseSlop = PhraseSlop Int deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Show, ToJSON, FromJSON)
|
||||
newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, ToJSON, FromJSON)
|
||||
|
||||
-- | 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 }
|
||||
1683
src/Database/V1/Bloodhound/Internal/Query.hs
Normal file
1683
src/Database/V1/Bloodhound/Internal/Query.hs
Normal file
File diff suppressed because it is too large
Load Diff
79
src/Database/V1/Bloodhound/Internal/Sort.hs
Normal file
79
src/Database/V1/Bloodhound/Internal/Sort.hs
Normal file
@ -0,0 +1,79 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Database.V1.Bloodhound.Internal.Sort where
|
||||
|
||||
|
||||
import Bloodhound.Import
|
||||
|
||||
import Database.V1.Bloodhound.Internal.Newtypes
|
||||
import Database.V1.Bloodhound.Internal.Query
|
||||
|
||||
|
||||
{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
|
||||
dependent with later sorts acting as tie-breakers for earlier sorts.
|
||||
-}
|
||||
type Sort = [SortSpec]
|
||||
|
||||
|
||||
{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
|
||||
'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
|
||||
'DistanceUnit' to express "nearness" to a single geographical point as a
|
||||
sort specification.
|
||||
|
||||
<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
|
||||
-}
|
||||
data SortSpec = DefaultSortSpec DefaultSort
|
||||
| GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Show)
|
||||
|
||||
{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
|
||||
'mkSort' convenience function for when you want to specify only the most
|
||||
common parameters.
|
||||
|
||||
<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
|
||||
-}
|
||||
data DefaultSort =
|
||||
DefaultSort { sortFieldName :: FieldName
|
||||
, sortOrder :: SortOrder
|
||||
-- default False
|
||||
, ignoreUnmapped :: Bool
|
||||
, sortMode :: Maybe SortMode
|
||||
, missingSort :: Maybe Missing
|
||||
, nestedFilter :: Maybe Filter } deriving (Eq, Show)
|
||||
|
||||
{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
|
||||
encoded into "asc" or "desc" when turned into JSON.
|
||||
|
||||
<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
|
||||
-}
|
||||
data SortOrder = Ascending
|
||||
| Descending deriving (Eq, Show)
|
||||
|
||||
|
||||
{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
|
||||
|
||||
http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
|
||||
-}
|
||||
data SortMode = SortMin
|
||||
| SortMax
|
||||
| SortSum
|
||||
| SortAvg deriving (Eq, Show)
|
||||
|
||||
instance ToJSON SortMode where
|
||||
toJSON SortMin = String "min"
|
||||
toJSON SortMax = String "max"
|
||||
toJSON SortSum = String "sum"
|
||||
toJSON SortAvg = String "avg"
|
||||
|
||||
{-| 'Missing' prescribes how to handle missing fields. A missing field can be
|
||||
sorted last, first, or using a custom value as a substitute.
|
||||
|
||||
<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
|
||||
-}
|
||||
data Missing = LastMissing
|
||||
| FirstMissing
|
||||
| CustomMissing Text deriving (Eq, Show)
|
||||
|
||||
instance ToJSON Missing where
|
||||
toJSON LastMissing = String "_last"
|
||||
toJSON FirstMissing = String "_first"
|
||||
toJSON (CustomMissing txt) = String txt
|
||||
@ -1 +1,26 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Database.V1.Bloodhound.Internal.StringlyTyped where
|
||||
|
||||
import Bloodhound.Import
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
newtype StringlyTypedDouble = StringlyTypedDouble { unStringlyTypedDouble :: Double }
|
||||
|
||||
|
||||
instance FromJSON StringlyTypedDouble where
|
||||
parseJSON = fmap StringlyTypedDouble . parseJSON . unStringlyTypeJSON
|
||||
|
||||
|
||||
-- | For some reason in several settings APIs, all leaf values get returned
|
||||
-- as strings. This function attepmts to recover from this for all
|
||||
-- non-recursive JSON types. If nothing can be done, the value is left alone.
|
||||
unStringlyTypeJSON :: Value -> Value
|
||||
unStringlyTypeJSON (String "true") = Bool True
|
||||
unStringlyTypeJSON (String "false") = Bool False
|
||||
unStringlyTypeJSON (String "null") = Null
|
||||
unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of
|
||||
Just n -> Number n
|
||||
Nothing -> v
|
||||
unStringlyTypeJSON v = v
|
||||
|
||||
252
src/Database/V1/Bloodhound/Internal/Suggest.hs
Normal file
252
src/Database/V1/Bloodhound/Internal/Suggest.hs
Normal file
@ -0,0 +1,252 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Database.V1.Bloodhound.Internal.Suggest where
|
||||
|
||||
|
||||
import Bloodhound.Import
|
||||
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
|
||||
import Database.V5.Bloodhound.Internal.Newtypes
|
||||
import Database.V5.Bloodhound.Internal.Query
|
||||
|
||||
data Suggest = Suggest { suggestText :: Text
|
||||
, suggestName :: Text
|
||||
, suggestType :: SuggestType
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON Suggest where
|
||||
toJSON Suggest{..} = object [ "text" .= suggestText
|
||||
, suggestName .= suggestType
|
||||
]
|
||||
|
||||
instance FromJSON Suggest where
|
||||
parseJSON (Object o) = do
|
||||
suggestText' <- o .: "text"
|
||||
let dropTextList = HM.toList $ HM.filterWithKey (\x _ -> x /= "text") o
|
||||
suggestName' <- case dropTextList of
|
||||
[(x, _)] -> return x
|
||||
_ -> fail "error parsing Suggest field name"
|
||||
suggestType' <- o .: suggestName'
|
||||
return $ Suggest suggestText' suggestName' suggestType'
|
||||
parseJSON x = typeMismatch "Suggest" x
|
||||
|
||||
data SuggestType = SuggestTypePhraseSuggester PhraseSuggester
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON SuggestType where
|
||||
toJSON (SuggestTypePhraseSuggester x) = object ["phrase" .= x]
|
||||
|
||||
instance FromJSON SuggestType where
|
||||
parseJSON = withObject "SuggestType" parse
|
||||
where parse o = phraseSuggester `taggedWith` "phrase"
|
||||
where taggedWith parser k = parser =<< o .: k
|
||||
phraseSuggester = pure . SuggestTypePhraseSuggester
|
||||
|
||||
data PhraseSuggester =
|
||||
PhraseSuggester { phraseSuggesterField :: FieldName
|
||||
, phraseSuggesterGramSize :: Maybe Int
|
||||
, phraseSuggesterRealWordErrorLikelihood :: Maybe Int
|
||||
, phraseSuggesterConfidence :: Maybe Int
|
||||
, phraseSuggesterMaxErrors :: Maybe Int
|
||||
, phraseSuggesterSeparator :: Maybe Text
|
||||
, phraseSuggesterSize :: Maybe Size
|
||||
, phraseSuggesterAnalyzer :: Maybe Analyzer
|
||||
, phraseSuggesterShardSize :: Maybe Int
|
||||
, phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter
|
||||
, phraseSuggesterCollate :: Maybe PhraseSuggesterCollate
|
||||
, phraseSuggesterCandidateGenerators :: [DirectGenerators]
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON PhraseSuggester where
|
||||
toJSON PhraseSuggester{..} = omitNulls [ "field" .= phraseSuggesterField
|
||||
, "gram_size" .= phraseSuggesterGramSize
|
||||
, "real_word_error_likelihood" .= phraseSuggesterRealWordErrorLikelihood
|
||||
, "confidence" .= phraseSuggesterConfidence
|
||||
, "max_errors" .= phraseSuggesterMaxErrors
|
||||
, "separator" .= phraseSuggesterSeparator
|
||||
, "size" .= phraseSuggesterSize
|
||||
, "analyzer" .= phraseSuggesterAnalyzer
|
||||
, "shard_size" .= phraseSuggesterShardSize
|
||||
, "highlight" .= phraseSuggesterHighlight
|
||||
, "collate" .= phraseSuggesterCollate
|
||||
, "direct_generator" .= phraseSuggesterCandidateGenerators
|
||||
]
|
||||
|
||||
instance FromJSON PhraseSuggester where
|
||||
parseJSON = withObject "PhraseSuggester" parse
|
||||
where parse o = PhraseSuggester
|
||||
<$> o .: "field"
|
||||
<*> o .:? "gram_size"
|
||||
<*> o .:? "real_word_error_likelihood"
|
||||
<*> o .:? "confidence"
|
||||
<*> o .:? "max_errors"
|
||||
<*> o .:? "separator"
|
||||
<*> o .:? "size"
|
||||
<*> o .:? "analyzer"
|
||||
<*> o .:? "shard_size"
|
||||
<*> o .:? "highlight"
|
||||
<*> o .:? "collate"
|
||||
<*> o .:? "direct_generator" .!= []
|
||||
|
||||
mkPhraseSuggester :: FieldName -> PhraseSuggester
|
||||
mkPhraseSuggester fName =
|
||||
PhraseSuggester fName Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
Nothing Nothing Nothing Nothing []
|
||||
|
||||
data PhraseSuggesterHighlighter =
|
||||
PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text
|
||||
, phraseSuggesterHighlighterPostTag :: Text
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON PhraseSuggesterHighlighter where
|
||||
toJSON PhraseSuggesterHighlighter{..} =
|
||||
object [ "pre_tag" .= phraseSuggesterHighlighterPreTag
|
||||
, "post_tag" .= phraseSuggesterHighlighterPostTag
|
||||
]
|
||||
|
||||
instance FromJSON PhraseSuggesterHighlighter where
|
||||
parseJSON = withObject "PhraseSuggesterHighlighter" parse
|
||||
where parse o = PhraseSuggesterHighlighter
|
||||
<$> o .: "pre_tag"
|
||||
<*> o .: "post_tag"
|
||||
|
||||
data PhraseSuggesterCollate =
|
||||
PhraseSuggesterCollate { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline
|
||||
, phraseSuggesterCollatePrune :: Bool
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON PhraseSuggesterCollate where
|
||||
toJSON PhraseSuggesterCollate{..} = object [ "query" .= object
|
||||
[ "inline" .= (inline phraseSuggesterCollateTemplateQuery)
|
||||
]
|
||||
, "params" .= (params phraseSuggesterCollateTemplateQuery)
|
||||
, "prune" .= phraseSuggesterCollatePrune
|
||||
]
|
||||
|
||||
instance FromJSON PhraseSuggesterCollate where
|
||||
parseJSON (Object o) = do
|
||||
query' <- o .: "query"
|
||||
inline' <- query' .: "inline"
|
||||
params' <- o .: "params"
|
||||
prune' <- o .:? "prune" .!= False
|
||||
return $ PhraseSuggesterCollate (TemplateQueryInline inline' params') prune'
|
||||
parseJSON x = typeMismatch "PhraseSuggesterCollate" x
|
||||
|
||||
data DirectGenerators = DirectGenerators
|
||||
{ directGeneratorsField :: FieldName
|
||||
, directGeneratorsSize :: Maybe Int
|
||||
, directGeneratorSuggestMode :: DirectGeneratorSuggestModeTypes
|
||||
, directGeneratorMaxEdits :: Maybe Double
|
||||
, directGeneratorPrefixLength :: Maybe Int
|
||||
, directGeneratorMinWordLength :: Maybe Int
|
||||
, directGeneratorMaxInspections :: Maybe Int
|
||||
, directGeneratorMinDocFreq :: Maybe Double
|
||||
, directGeneratorMaxTermFreq :: Maybe Double
|
||||
, directGeneratorPreFilter :: Maybe Text
|
||||
, directGeneratorPostFilter :: Maybe Text
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
|
||||
instance ToJSON DirectGenerators where
|
||||
toJSON DirectGenerators{..} = omitNulls [ "field" .= directGeneratorsField
|
||||
, "size" .= directGeneratorsSize
|
||||
, "suggest_mode" .= directGeneratorSuggestMode
|
||||
, "max_edits" .= directGeneratorMaxEdits
|
||||
, "prefix_length" .= directGeneratorPrefixLength
|
||||
, "min_word_length" .= directGeneratorMinWordLength
|
||||
, "max_inspections" .= directGeneratorMaxInspections
|
||||
, "min_doc_freq" .= directGeneratorMinDocFreq
|
||||
, "max_term_freq" .= directGeneratorMaxTermFreq
|
||||
, "pre_filter" .= directGeneratorPreFilter
|
||||
, "post_filter" .= directGeneratorPostFilter
|
||||
]
|
||||
|
||||
instance FromJSON DirectGenerators where
|
||||
parseJSON = withObject "DirectGenerators" parse
|
||||
where parse o = DirectGenerators
|
||||
<$> o .: "field"
|
||||
<*> o .:? "size"
|
||||
<*> o .: "suggest_mode"
|
||||
<*> o .:? "max_edits"
|
||||
<*> o .:? "prefix_length"
|
||||
<*> o .:? "min_word_length"
|
||||
<*> o .:? "max_inspections"
|
||||
<*> o .:? "min_doc_freq"
|
||||
<*> o .:? "max_term_freq"
|
||||
<*> o .:? "pre_filter"
|
||||
<*> o .:? "post_filter"
|
||||
|
||||
mkDirectGenerators :: FieldName -> DirectGenerators
|
||||
mkDirectGenerators fn = DirectGenerators fn Nothing DirectGeneratorSuggestModeMissing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
|
||||
data DirectGeneratorSuggestModeTypes = DirectGeneratorSuggestModeMissing
|
||||
| DirectGeneratorSuggestModePopular
|
||||
| DirectGeneratorSuggestModeAlways
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON DirectGeneratorSuggestModeTypes where
|
||||
toJSON DirectGeneratorSuggestModeMissing = "missing"
|
||||
toJSON DirectGeneratorSuggestModePopular = "popular"
|
||||
toJSON DirectGeneratorSuggestModeAlways = "always"
|
||||
|
||||
instance FromJSON DirectGeneratorSuggestModeTypes where
|
||||
parseJSON = withText "DirectGeneratorSuggestModeTypes" parse
|
||||
where parse "missing" = pure DirectGeneratorSuggestModeMissing
|
||||
parse "popular" = pure DirectGeneratorSuggestModePopular
|
||||
parse "always" = pure DirectGeneratorSuggestModeAlways
|
||||
parse f = fail ("Unexpected DirectGeneratorSuggestModeTypes: " <> show f)
|
||||
|
||||
data SuggestOptions =
|
||||
SuggestOptions { suggestOptionsText :: Text
|
||||
, suggestOptionsScore :: Double
|
||||
, suggestOptionsFreq :: Maybe Int
|
||||
, suggestOptionsHighlighted :: Maybe Text
|
||||
}
|
||||
deriving (Eq, Read, Show)
|
||||
|
||||
instance FromJSON SuggestOptions where
|
||||
parseJSON = withObject "SuggestOptions" parse
|
||||
where parse o = SuggestOptions
|
||||
<$> o .: "text"
|
||||
<*> o .: "score"
|
||||
<*> o .:? "freq"
|
||||
<*> o .:? "highlighted"
|
||||
|
||||
data SuggestResponse =
|
||||
SuggestResponse { suggestResponseText :: Text
|
||||
, suggestResponseOffset :: Int
|
||||
, suggestResponseLength :: Int
|
||||
, suggestResponseOptions :: [SuggestOptions]
|
||||
}
|
||||
deriving (Eq, Read, Show)
|
||||
|
||||
instance FromJSON SuggestResponse where
|
||||
parseJSON = withObject "SuggestResponse" parse
|
||||
where parse o = SuggestResponse
|
||||
<$> o .: "text"
|
||||
<*> o .: "offset"
|
||||
<*> o .: "length"
|
||||
<*> o .: "options"
|
||||
|
||||
data NamedSuggestionResponse =
|
||||
NamedSuggestionResponse { nsrName :: Text
|
||||
, nsrResponses :: [SuggestResponse]
|
||||
}
|
||||
deriving (Eq, Read, Show)
|
||||
|
||||
instance FromJSON NamedSuggestionResponse where
|
||||
parseJSON (Object o) = do
|
||||
suggestionName' <- case HM.toList o of
|
||||
[(x, _)] -> return x
|
||||
_ -> fail "error parsing NamedSuggestionResponse name"
|
||||
suggestionResponses' <- o .: suggestionName'
|
||||
return $ NamedSuggestionResponse suggestionName' suggestionResponses'
|
||||
|
||||
parseJSON x = typeMismatch "NamedSuggestionResponse" x
|
||||
@ -422,8 +422,6 @@ import qualified Text.Read as TR
|
||||
|
||||
import Database.V1.Bloodhound.Internal.Client
|
||||
import Database.V1.Bloodhound.Types.Class
|
||||
import Database.V1.Bloodhound.Types.Internal
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1595,6 +1595,3 @@ fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
|
||||
fieldTagged f o = case HM.toList o of
|
||||
[(k, Object o')] -> f (FieldName k) o'
|
||||
_ -> fail "Expected object with 1 field-named key"
|
||||
|
||||
deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
|
||||
deleteSeveral ks hm = foldr HM.delete hm ks
|
||||
|
||||
Loading…
Reference in New Issue
Block a user