{-# LANGUAGE OverloadedStrings #-}

module Database.Bloodhound.Internal.Versions.Common.Types.Highlight where

import qualified Data.Map.Strict as M
import Database.Bloodhound.Internal.Utils.Imports
import Database.Bloodhound.Internal.Versions.Common.Types.Newtypes
import Database.Bloodhound.Internal.Versions.Common.Types.Query

type HitHighlight = M.Map Text [Text]

data Highlights = Highlights
  { Highlights -> Maybe HighlightSettings
globalsettings :: Maybe HighlightSettings,
    Highlights -> [FieldHighlight]
highlightFields :: [FieldHighlight]
  }
  deriving stock (Highlights -> Highlights -> Bool
(Highlights -> Highlights -> Bool)
-> (Highlights -> Highlights -> Bool) -> Eq Highlights
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Highlights -> Highlights -> Bool
== :: Highlights -> Highlights -> Bool
$c/= :: Highlights -> Highlights -> Bool
/= :: Highlights -> Highlights -> Bool
Eq, Int -> Highlights -> ShowS
[Highlights] -> ShowS
Highlights -> String
(Int -> Highlights -> ShowS)
-> (Highlights -> String)
-> ([Highlights] -> ShowS)
-> Show Highlights
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Highlights -> ShowS
showsPrec :: Int -> Highlights -> ShowS
$cshow :: Highlights -> String
show :: Highlights -> String
$cshowList :: [Highlights] -> ShowS
showList :: [Highlights] -> ShowS
Show)

highlightsGlobalsettingsLens :: Lens' Highlights (Maybe HighlightSettings)
highlightsGlobalsettingsLens :: Lens' Highlights (Maybe HighlightSettings)
highlightsGlobalsettingsLens = (Highlights -> Maybe HighlightSettings)
-> (Highlights -> Maybe HighlightSettings -> Highlights)
-> Lens' Highlights (Maybe HighlightSettings)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Highlights -> Maybe HighlightSettings
globalsettings (\Highlights
x Maybe HighlightSettings
y -> Highlights
x {globalsettings = y})

highlightsHighlightFieldsLens :: Lens' Highlights [FieldHighlight]
highlightsHighlightFieldsLens :: Lens' Highlights [FieldHighlight]
highlightsHighlightFieldsLens = (Highlights -> [FieldHighlight])
-> (Highlights -> [FieldHighlight] -> Highlights)
-> Lens' Highlights [FieldHighlight]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Highlights -> [FieldHighlight]
highlightFields (\Highlights
x [FieldHighlight]
y -> Highlights
x {highlightFields = y})

instance ToJSON Highlights where
  toJSON :: Highlights -> Value
toJSON (Highlights Maybe HighlightSettings
global [FieldHighlight]
fields) =
    [Pair] -> Value
omitNulls
      ( (Key
"fields" Key -> [FieldHighlight] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [FieldHighlight]
fields)
          Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Maybe HighlightSettings -> [Pair]
highlightSettingsPairs Maybe HighlightSettings
global
      )

data FieldHighlight = FieldHighlight
  { FieldHighlight -> FieldName
fieldHighlightName :: FieldName,
    FieldHighlight -> Maybe HighlightSettings
fieldHighlightSettings :: Maybe HighlightSettings
  }
  deriving stock (FieldHighlight -> FieldHighlight -> Bool
(FieldHighlight -> FieldHighlight -> Bool)
-> (FieldHighlight -> FieldHighlight -> Bool) -> Eq FieldHighlight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldHighlight -> FieldHighlight -> Bool
== :: FieldHighlight -> FieldHighlight -> Bool
$c/= :: FieldHighlight -> FieldHighlight -> Bool
/= :: FieldHighlight -> FieldHighlight -> Bool
Eq, Int -> FieldHighlight -> ShowS
[FieldHighlight] -> ShowS
FieldHighlight -> String
(Int -> FieldHighlight -> ShowS)
-> (FieldHighlight -> String)
-> ([FieldHighlight] -> ShowS)
-> Show FieldHighlight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldHighlight -> ShowS
showsPrec :: Int -> FieldHighlight -> ShowS
$cshow :: FieldHighlight -> String
show :: FieldHighlight -> String
$cshowList :: [FieldHighlight] -> ShowS
showList :: [FieldHighlight] -> ShowS
Show)

fieldHighlightNameLens :: Lens' FieldHighlight FieldName
fieldHighlightNameLens :: Lens' FieldHighlight FieldName
fieldHighlightNameLens = (FieldHighlight -> FieldName)
-> (FieldHighlight -> FieldName -> FieldHighlight)
-> Lens' FieldHighlight FieldName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FieldHighlight -> FieldName
fieldHighlightName (\FieldHighlight
x FieldName
y -> FieldHighlight
x {fieldHighlightName = y})

fieldHighlightSettingsLens :: Lens' FieldHighlight (Maybe HighlightSettings)
fieldHighlightSettingsLens :: Lens' FieldHighlight (Maybe HighlightSettings)
fieldHighlightSettingsLens = (FieldHighlight -> Maybe HighlightSettings)
-> (FieldHighlight -> Maybe HighlightSettings -> FieldHighlight)
-> Lens' FieldHighlight (Maybe HighlightSettings)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FieldHighlight -> Maybe HighlightSettings
fieldHighlightSettings (\FieldHighlight
x Maybe HighlightSettings
y -> FieldHighlight
x {fieldHighlightSettings = y})

instance ToJSON FieldHighlight where
  toJSON :: FieldHighlight -> Value
toJSON (FieldHighlight (FieldName Text
fName) (Just HighlightSettings
fSettings)) =
    [Pair] -> Value
object [Text -> Key
fromText Text
fName Key -> HighlightSettings -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HighlightSettings
fSettings]
  toJSON (FieldHighlight (FieldName Text
fName) Maybe HighlightSettings
Nothing) =
    [Pair] -> Value
object [Text -> Key
fromText Text
fName Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
emptyObject]

data HighlightSettings
  = Plain PlainHighlight
  | Postings PostingsHighlight
  | FastVector FastVectorHighlight
  deriving stock (HighlightSettings -> HighlightSettings -> Bool
(HighlightSettings -> HighlightSettings -> Bool)
-> (HighlightSettings -> HighlightSettings -> Bool)
-> Eq HighlightSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HighlightSettings -> HighlightSettings -> Bool
== :: HighlightSettings -> HighlightSettings -> Bool
$c/= :: HighlightSettings -> HighlightSettings -> Bool
/= :: HighlightSettings -> HighlightSettings -> Bool
Eq, Int -> HighlightSettings -> ShowS
[HighlightSettings] -> ShowS
HighlightSettings -> String
(Int -> HighlightSettings -> ShowS)
-> (HighlightSettings -> String)
-> ([HighlightSettings] -> ShowS)
-> Show HighlightSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HighlightSettings -> ShowS
showsPrec :: Int -> HighlightSettings -> ShowS
$cshow :: HighlightSettings -> String
show :: HighlightSettings -> String
$cshowList :: [HighlightSettings] -> ShowS
showList :: [HighlightSettings] -> ShowS
Show)

highlightSettingsPlainPrism :: Prism' HighlightSettings PlainHighlight
highlightSettingsPlainPrism :: Prism' HighlightSettings PlainHighlight
highlightSettingsPlainPrism = (PlainHighlight -> HighlightSettings)
-> (HighlightSettings -> Either HighlightSettings PlainHighlight)
-> Prism' HighlightSettings PlainHighlight
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism PlainHighlight -> HighlightSettings
Plain HighlightSettings -> Either HighlightSettings PlainHighlight
extract
  where
    extract :: HighlightSettings -> Either HighlightSettings PlainHighlight
extract HighlightSettings
hs =
      case HighlightSettings
hs of
        Plain PlainHighlight
x -> PlainHighlight -> Either HighlightSettings PlainHighlight
forall a b. b -> Either a b
Right PlainHighlight
x
        HighlightSettings
_ -> HighlightSettings -> Either HighlightSettings PlainHighlight
forall a b. a -> Either a b
Left HighlightSettings
hs

highlightSettingsPostingsPrism :: Prism' HighlightSettings PostingsHighlight
highlightSettingsPostingsPrism :: Prism' HighlightSettings PostingsHighlight
highlightSettingsPostingsPrism = (PostingsHighlight -> HighlightSettings)
-> (HighlightSettings
    -> Either HighlightSettings PostingsHighlight)
-> Prism' HighlightSettings PostingsHighlight
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism PostingsHighlight -> HighlightSettings
Postings HighlightSettings -> Either HighlightSettings PostingsHighlight
extract
  where
    extract :: HighlightSettings -> Either HighlightSettings PostingsHighlight
extract HighlightSettings
hs =
      case HighlightSettings
hs of
        Postings PostingsHighlight
x -> PostingsHighlight -> Either HighlightSettings PostingsHighlight
forall a b. b -> Either a b
Right PostingsHighlight
x
        HighlightSettings
_ -> HighlightSettings -> Either HighlightSettings PostingsHighlight
forall a b. a -> Either a b
Left HighlightSettings
hs

highlightSettingsFastVectorPrism :: Prism' HighlightSettings FastVectorHighlight
highlightSettingsFastVectorPrism :: Prism' HighlightSettings FastVectorHighlight
highlightSettingsFastVectorPrism = (FastVectorHighlight -> HighlightSettings)
-> (HighlightSettings
    -> Either HighlightSettings FastVectorHighlight)
-> Prism' HighlightSettings FastVectorHighlight
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism FastVectorHighlight -> HighlightSettings
FastVector HighlightSettings -> Either HighlightSettings FastVectorHighlight
extract
  where
    extract :: HighlightSettings -> Either HighlightSettings FastVectorHighlight
extract HighlightSettings
hs =
      case HighlightSettings
hs of
        FastVector FastVectorHighlight
x -> FastVectorHighlight -> Either HighlightSettings FastVectorHighlight
forall a b. b -> Either a b
Right FastVectorHighlight
x
        HighlightSettings
_ -> HighlightSettings -> Either HighlightSettings FastVectorHighlight
forall a b. a -> Either a b
Left HighlightSettings
hs

instance ToJSON HighlightSettings where
  toJSON :: HighlightSettings -> Value
toJSON HighlightSettings
hs = [Pair] -> Value
omitNulls (Maybe HighlightSettings -> [Pair]
highlightSettingsPairs (HighlightSettings -> Maybe HighlightSettings
forall a. a -> Maybe a
Just HighlightSettings
hs))

data PlainHighlight = PlainHighlight
  { PlainHighlight -> Maybe CommonHighlight
plainCommon :: Maybe CommonHighlight,
    PlainHighlight -> Maybe NonPostings
plainNonPost :: Maybe NonPostings
  }
  deriving stock (PlainHighlight -> PlainHighlight -> Bool
(PlainHighlight -> PlainHighlight -> Bool)
-> (PlainHighlight -> PlainHighlight -> Bool) -> Eq PlainHighlight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlainHighlight -> PlainHighlight -> Bool
== :: PlainHighlight -> PlainHighlight -> Bool
$c/= :: PlainHighlight -> PlainHighlight -> Bool
/= :: PlainHighlight -> PlainHighlight -> Bool
Eq, Int -> PlainHighlight -> ShowS
[PlainHighlight] -> ShowS
PlainHighlight -> String
(Int -> PlainHighlight -> ShowS)
-> (PlainHighlight -> String)
-> ([PlainHighlight] -> ShowS)
-> Show PlainHighlight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlainHighlight -> ShowS
showsPrec :: Int -> PlainHighlight -> ShowS
$cshow :: PlainHighlight -> String
show :: PlainHighlight -> String
$cshowList :: [PlainHighlight] -> ShowS
showList :: [PlainHighlight] -> ShowS
Show)

plainHighlightCommonLens :: Lens' PlainHighlight (Maybe CommonHighlight)
plainHighlightCommonLens :: Lens' PlainHighlight (Maybe CommonHighlight)
plainHighlightCommonLens = (PlainHighlight -> Maybe CommonHighlight)
-> (PlainHighlight -> Maybe CommonHighlight -> PlainHighlight)
-> Lens' PlainHighlight (Maybe CommonHighlight)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PlainHighlight -> Maybe CommonHighlight
plainCommon (\PlainHighlight
x Maybe CommonHighlight
y -> PlainHighlight
x {plainCommon = y})

plainHighlightNonPostLens :: Lens' PlainHighlight (Maybe NonPostings)
plainHighlightNonPostLens :: Lens' PlainHighlight (Maybe NonPostings)
plainHighlightNonPostLens = (PlainHighlight -> Maybe NonPostings)
-> (PlainHighlight -> Maybe NonPostings -> PlainHighlight)
-> Lens' PlainHighlight (Maybe NonPostings)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PlainHighlight -> Maybe NonPostings
plainNonPost (\PlainHighlight
x Maybe NonPostings
y -> PlainHighlight
x {plainNonPost = y})

-- This requires that index_options are set to 'offset' in the mapping.
newtype PostingsHighlight = PostingsHighlight {PostingsHighlight -> Maybe CommonHighlight
getPostingsHighlight :: Maybe CommonHighlight}
  deriving stock (PostingsHighlight -> PostingsHighlight -> Bool
(PostingsHighlight -> PostingsHighlight -> Bool)
-> (PostingsHighlight -> PostingsHighlight -> Bool)
-> Eq PostingsHighlight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PostingsHighlight -> PostingsHighlight -> Bool
== :: PostingsHighlight -> PostingsHighlight -> Bool
$c/= :: PostingsHighlight -> PostingsHighlight -> Bool
/= :: PostingsHighlight -> PostingsHighlight -> Bool
Eq, Int -> PostingsHighlight -> ShowS
[PostingsHighlight] -> ShowS
PostingsHighlight -> String
(Int -> PostingsHighlight -> ShowS)
-> (PostingsHighlight -> String)
-> ([PostingsHighlight] -> ShowS)
-> Show PostingsHighlight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostingsHighlight -> ShowS
showsPrec :: Int -> PostingsHighlight -> ShowS
$cshow :: PostingsHighlight -> String
show :: PostingsHighlight -> String
$cshowList :: [PostingsHighlight] -> ShowS
showList :: [PostingsHighlight] -> ShowS
Show)

postingsHighlightLens :: Lens' PostingsHighlight (Maybe CommonHighlight)
postingsHighlightLens :: Lens' PostingsHighlight (Maybe CommonHighlight)
postingsHighlightLens = (PostingsHighlight -> Maybe CommonHighlight)
-> (PostingsHighlight
    -> Maybe CommonHighlight -> PostingsHighlight)
-> Lens' PostingsHighlight (Maybe CommonHighlight)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PostingsHighlight -> Maybe CommonHighlight
getPostingsHighlight (\PostingsHighlight
x Maybe CommonHighlight
y -> PostingsHighlight
x {getPostingsHighlight = y})

-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
data FastVectorHighlight = FastVectorHighlight
  { FastVectorHighlight -> Maybe CommonHighlight
fvCommon :: Maybe CommonHighlight,
    FastVectorHighlight -> Maybe NonPostings
fvNonPostSettings :: Maybe NonPostings,
    FastVectorHighlight -> Maybe Text
boundaryChars :: Maybe Text,
    FastVectorHighlight -> Maybe Int
boundaryMaxScan :: Maybe Int,
    FastVectorHighlight -> Maybe Int
fragmentOffset :: Maybe Int,
    FastVectorHighlight -> [Text]
matchedFields :: [Text],
    FastVectorHighlight -> Maybe Int
phraseLimit :: Maybe Int
  }
  deriving stock (FastVectorHighlight -> FastVectorHighlight -> Bool
(FastVectorHighlight -> FastVectorHighlight -> Bool)
-> (FastVectorHighlight -> FastVectorHighlight -> Bool)
-> Eq FastVectorHighlight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FastVectorHighlight -> FastVectorHighlight -> Bool
== :: FastVectorHighlight -> FastVectorHighlight -> Bool
$c/= :: FastVectorHighlight -> FastVectorHighlight -> Bool
/= :: FastVectorHighlight -> FastVectorHighlight -> Bool
Eq, Int -> FastVectorHighlight -> ShowS
[FastVectorHighlight] -> ShowS
FastVectorHighlight -> String
(Int -> FastVectorHighlight -> ShowS)
-> (FastVectorHighlight -> String)
-> ([FastVectorHighlight] -> ShowS)
-> Show FastVectorHighlight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FastVectorHighlight -> ShowS
showsPrec :: Int -> FastVectorHighlight -> ShowS
$cshow :: FastVectorHighlight -> String
show :: FastVectorHighlight -> String
$cshowList :: [FastVectorHighlight] -> ShowS
showList :: [FastVectorHighlight] -> ShowS
Show)

fastVectorHighlightFvCommonLens :: Lens' FastVectorHighlight (Maybe CommonHighlight)
fastVectorHighlightFvCommonLens :: Lens' FastVectorHighlight (Maybe CommonHighlight)
fastVectorHighlightFvCommonLens = (FastVectorHighlight -> Maybe CommonHighlight)
-> (FastVectorHighlight
    -> Maybe CommonHighlight -> FastVectorHighlight)
-> Lens' FastVectorHighlight (Maybe CommonHighlight)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FastVectorHighlight -> Maybe CommonHighlight
fvCommon (\FastVectorHighlight
x Maybe CommonHighlight
y -> FastVectorHighlight
x {fvCommon = y})

fastVectorHighlightFvNonPostSettingsLens :: Lens' FastVectorHighlight (Maybe NonPostings)
fastVectorHighlightFvNonPostSettingsLens :: Lens' FastVectorHighlight (Maybe NonPostings)
fastVectorHighlightFvNonPostSettingsLens = (FastVectorHighlight -> Maybe NonPostings)
-> (FastVectorHighlight
    -> Maybe NonPostings -> FastVectorHighlight)
-> Lens' FastVectorHighlight (Maybe NonPostings)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FastVectorHighlight -> Maybe NonPostings
fvNonPostSettings (\FastVectorHighlight
x Maybe NonPostings
y -> FastVectorHighlight
x {fvNonPostSettings = y})

fastVectorHighlightBoundaryCharsLens :: Lens' FastVectorHighlight (Maybe Text)
fastVectorHighlightBoundaryCharsLens :: Lens' FastVectorHighlight (Maybe Text)
fastVectorHighlightBoundaryCharsLens = (FastVectorHighlight -> Maybe Text)
-> (FastVectorHighlight -> Maybe Text -> FastVectorHighlight)
-> Lens' FastVectorHighlight (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FastVectorHighlight -> Maybe Text
boundaryChars (\FastVectorHighlight
x Maybe Text
y -> FastVectorHighlight
x {boundaryChars = y})

fastVectorHighlightBoundaryMaxScanLens :: Lens' FastVectorHighlight (Maybe Int)
fastVectorHighlightBoundaryMaxScanLens :: Lens' FastVectorHighlight (Maybe Int)
fastVectorHighlightBoundaryMaxScanLens = (FastVectorHighlight -> Maybe Int)
-> (FastVectorHighlight -> Maybe Int -> FastVectorHighlight)
-> Lens' FastVectorHighlight (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FastVectorHighlight -> Maybe Int
boundaryMaxScan (\FastVectorHighlight
x Maybe Int
y -> FastVectorHighlight
x {boundaryMaxScan = y})

fastVectorHighlightFragmentOffsetLens :: Lens' FastVectorHighlight (Maybe Int)
fastVectorHighlightFragmentOffsetLens :: Lens' FastVectorHighlight (Maybe Int)
fastVectorHighlightFragmentOffsetLens = (FastVectorHighlight -> Maybe Int)
-> (FastVectorHighlight -> Maybe Int -> FastVectorHighlight)
-> Lens' FastVectorHighlight (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FastVectorHighlight -> Maybe Int
fragmentOffset (\FastVectorHighlight
x Maybe Int
y -> FastVectorHighlight
x {fragmentOffset = y})

fastVectorHighlightMatchedFieldsLens :: Lens' FastVectorHighlight [Text]
fastVectorHighlightMatchedFieldsLens :: Lens' FastVectorHighlight [Text]
fastVectorHighlightMatchedFieldsLens = (FastVectorHighlight -> [Text])
-> (FastVectorHighlight -> [Text] -> FastVectorHighlight)
-> Lens' FastVectorHighlight [Text]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FastVectorHighlight -> [Text]
matchedFields (\FastVectorHighlight
x [Text]
y -> FastVectorHighlight
x {matchedFields = y})

fastVectorHighlightPhraseLimitLens :: Lens' FastVectorHighlight (Maybe Int)
fastVectorHighlightPhraseLimitLens :: Lens' FastVectorHighlight (Maybe Int)
fastVectorHighlightPhraseLimitLens = (FastVectorHighlight -> Maybe Int)
-> (FastVectorHighlight -> Maybe Int -> FastVectorHighlight)
-> Lens' FastVectorHighlight (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FastVectorHighlight -> Maybe Int
phraseLimit (\FastVectorHighlight
x Maybe Int
y -> FastVectorHighlight
x {phraseLimit = y})

data CommonHighlight = CommonHighlight
  { CommonHighlight -> Maybe Text
order :: Maybe Text,
    CommonHighlight -> Maybe Bool
forceSource :: Maybe Bool,
    CommonHighlight -> Maybe HighlightTag
tag :: Maybe HighlightTag,
    CommonHighlight -> Maybe HighlightEncoder
encoder :: Maybe HighlightEncoder,
    CommonHighlight -> Maybe Int
noMatchSize :: Maybe Int,
    CommonHighlight -> Maybe Query
highlightQuery :: Maybe Query,
    CommonHighlight -> Maybe Bool
requireFieldMatch :: Maybe Bool
  }
  deriving stock (CommonHighlight -> CommonHighlight -> Bool
(CommonHighlight -> CommonHighlight -> Bool)
-> (CommonHighlight -> CommonHighlight -> Bool)
-> Eq CommonHighlight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommonHighlight -> CommonHighlight -> Bool
== :: CommonHighlight -> CommonHighlight -> Bool
$c/= :: CommonHighlight -> CommonHighlight -> Bool
/= :: CommonHighlight -> CommonHighlight -> Bool
Eq, Int -> CommonHighlight -> ShowS
[CommonHighlight] -> ShowS
CommonHighlight -> String
(Int -> CommonHighlight -> ShowS)
-> (CommonHighlight -> String)
-> ([CommonHighlight] -> ShowS)
-> Show CommonHighlight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommonHighlight -> ShowS
showsPrec :: Int -> CommonHighlight -> ShowS
$cshow :: CommonHighlight -> String
show :: CommonHighlight -> String
$cshowList :: [CommonHighlight] -> ShowS
showList :: [CommonHighlight] -> ShowS
Show)

commonHighlightOrderLens :: Lens' CommonHighlight (Maybe Text)
commonHighlightOrderLens :: Lens' CommonHighlight (Maybe Text)
commonHighlightOrderLens = (CommonHighlight -> Maybe Text)
-> (CommonHighlight -> Maybe Text -> CommonHighlight)
-> Lens' CommonHighlight (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonHighlight -> Maybe Text
order (\CommonHighlight
x Maybe Text
y -> CommonHighlight
x {order = y})

commonHighlightForceSourceLens :: Lens' CommonHighlight (Maybe Bool)
commonHighlightForceSourceLens :: Lens' CommonHighlight (Maybe Bool)
commonHighlightForceSourceLens = (CommonHighlight -> Maybe Bool)
-> (CommonHighlight -> Maybe Bool -> CommonHighlight)
-> Lens' CommonHighlight (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonHighlight -> Maybe Bool
forceSource (\CommonHighlight
x Maybe Bool
y -> CommonHighlight
x {forceSource = y})

commonHighlightTagLens :: Lens' CommonHighlight (Maybe HighlightTag)
commonHighlightTagLens :: Lens' CommonHighlight (Maybe HighlightTag)
commonHighlightTagLens = (CommonHighlight -> Maybe HighlightTag)
-> (CommonHighlight -> Maybe HighlightTag -> CommonHighlight)
-> Lens' CommonHighlight (Maybe HighlightTag)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonHighlight -> Maybe HighlightTag
tag (\CommonHighlight
x Maybe HighlightTag
y -> CommonHighlight
x {tag = y})

commonHighlightEncoderLens :: Lens' CommonHighlight (Maybe HighlightEncoder)
commonHighlightEncoderLens :: Lens' CommonHighlight (Maybe HighlightEncoder)
commonHighlightEncoderLens = (CommonHighlight -> Maybe HighlightEncoder)
-> (CommonHighlight -> Maybe HighlightEncoder -> CommonHighlight)
-> Lens' CommonHighlight (Maybe HighlightEncoder)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonHighlight -> Maybe HighlightEncoder
encoder (\CommonHighlight
x Maybe HighlightEncoder
y -> CommonHighlight
x {encoder = y})

commonHighlightNoMatchSizeLens :: Lens' CommonHighlight (Maybe Int)
commonHighlightNoMatchSizeLens :: Lens' CommonHighlight (Maybe Int)
commonHighlightNoMatchSizeLens = (CommonHighlight -> Maybe Int)
-> (CommonHighlight -> Maybe Int -> CommonHighlight)
-> Lens' CommonHighlight (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonHighlight -> Maybe Int
noMatchSize (\CommonHighlight
x Maybe Int
y -> CommonHighlight
x {noMatchSize = y})

commonHighlightHighlightQueryLens :: Lens' CommonHighlight (Maybe Query)
commonHighlightHighlightQueryLens :: Lens' CommonHighlight (Maybe Query)
commonHighlightHighlightQueryLens = (CommonHighlight -> Maybe Query)
-> (CommonHighlight -> Maybe Query -> CommonHighlight)
-> Lens' CommonHighlight (Maybe Query)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonHighlight -> Maybe Query
highlightQuery (\CommonHighlight
x Maybe Query
y -> CommonHighlight
x {highlightQuery = y})

commonHighlightRequireFieldMatchLens :: Lens' CommonHighlight (Maybe Bool)
commonHighlightRequireFieldMatchLens :: Lens' CommonHighlight (Maybe Bool)
commonHighlightRequireFieldMatchLens = (CommonHighlight -> Maybe Bool)
-> (CommonHighlight -> Maybe Bool -> CommonHighlight)
-> Lens' CommonHighlight (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonHighlight -> Maybe Bool
requireFieldMatch (\CommonHighlight
x Maybe Bool
y -> CommonHighlight
x {requireFieldMatch = y})

-- Settings that are only applicable to FastVector and Plain highlighters.
data NonPostings = NonPostings
  { NonPostings -> Maybe Int
fragmentSize :: Maybe Int,
    NonPostings -> Maybe Int
numberOfFragments :: Maybe Int
  }
  deriving stock (NonPostings -> NonPostings -> Bool
(NonPostings -> NonPostings -> Bool)
-> (NonPostings -> NonPostings -> Bool) -> Eq NonPostings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonPostings -> NonPostings -> Bool
== :: NonPostings -> NonPostings -> Bool
$c/= :: NonPostings -> NonPostings -> Bool
/= :: NonPostings -> NonPostings -> Bool
Eq, Int -> NonPostings -> ShowS
[NonPostings] -> ShowS
NonPostings -> String
(Int -> NonPostings -> ShowS)
-> (NonPostings -> String)
-> ([NonPostings] -> ShowS)
-> Show NonPostings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonPostings -> ShowS
showsPrec :: Int -> NonPostings -> ShowS
$cshow :: NonPostings -> String
show :: NonPostings -> String
$cshowList :: [NonPostings] -> ShowS
showList :: [NonPostings] -> ShowS
Show)

nonPostingsFragmentSizeLens :: Lens' NonPostings (Maybe Int)
nonPostingsFragmentSizeLens :: Lens' NonPostings (Maybe Int)
nonPostingsFragmentSizeLens = (NonPostings -> Maybe Int)
-> (NonPostings -> Maybe Int -> NonPostings)
-> Lens' NonPostings (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens NonPostings -> Maybe Int
fragmentSize (\NonPostings
x Maybe Int
y -> NonPostings
x {fragmentSize = y})

nonPostingsNumberOfFragmentsLens :: Lens' NonPostings (Maybe Int)
nonPostingsNumberOfFragmentsLens :: Lens' NonPostings (Maybe Int)
nonPostingsNumberOfFragmentsLens = (NonPostings -> Maybe Int)
-> (NonPostings -> Maybe Int -> NonPostings)
-> Lens' NonPostings (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens NonPostings -> Maybe Int
numberOfFragments (\NonPostings
x Maybe Int
y -> NonPostings
x {numberOfFragments = y})

data HighlightEncoder
  = DefaultEncoder
  | HTMLEncoder
  deriving stock (HighlightEncoder -> HighlightEncoder -> Bool
(HighlightEncoder -> HighlightEncoder -> Bool)
-> (HighlightEncoder -> HighlightEncoder -> Bool)
-> Eq HighlightEncoder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HighlightEncoder -> HighlightEncoder -> Bool
== :: HighlightEncoder -> HighlightEncoder -> Bool
$c/= :: HighlightEncoder -> HighlightEncoder -> Bool
/= :: HighlightEncoder -> HighlightEncoder -> Bool
Eq, Int -> HighlightEncoder -> ShowS
[HighlightEncoder] -> ShowS
HighlightEncoder -> String
(Int -> HighlightEncoder -> ShowS)
-> (HighlightEncoder -> String)
-> ([HighlightEncoder] -> ShowS)
-> Show HighlightEncoder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HighlightEncoder -> ShowS
showsPrec :: Int -> HighlightEncoder -> ShowS
$cshow :: HighlightEncoder -> String
show :: HighlightEncoder -> String
$cshowList :: [HighlightEncoder] -> ShowS
showList :: [HighlightEncoder] -> ShowS
Show)

instance ToJSON HighlightEncoder where
  toJSON :: HighlightEncoder -> Value
toJSON HighlightEncoder
DefaultEncoder = Text -> Value
String Text
"default"
  toJSON HighlightEncoder
HTMLEncoder = Text -> Value
String Text
"html"

-- NOTE: Should the tags use some kind of HTML type, rather than Text?
data HighlightTag
  = TagSchema Text
  | -- Only uses more than the first value in the lists if fvh
    CustomTags ([Text], [Text])
  deriving stock (HighlightTag -> HighlightTag -> Bool
(HighlightTag -> HighlightTag -> Bool)
-> (HighlightTag -> HighlightTag -> Bool) -> Eq HighlightTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HighlightTag -> HighlightTag -> Bool
== :: HighlightTag -> HighlightTag -> Bool
$c/= :: HighlightTag -> HighlightTag -> Bool
/= :: HighlightTag -> HighlightTag -> Bool
Eq, Int -> HighlightTag -> ShowS
[HighlightTag] -> ShowS
HighlightTag -> String
(Int -> HighlightTag -> ShowS)
-> (HighlightTag -> String)
-> ([HighlightTag] -> ShowS)
-> Show HighlightTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HighlightTag -> ShowS
showsPrec :: Int -> HighlightTag -> ShowS
$cshow :: HighlightTag -> String
show :: HighlightTag -> String
$cshowList :: [HighlightTag] -> ShowS
showList :: [HighlightTag] -> ShowS
Show)

highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
highlightSettingsPairs Maybe HighlightSettings
Nothing = []
highlightSettingsPairs (Just (Plain PlainHighlight
plh)) = Maybe PlainHighlight -> [Pair]
plainHighPairs (PlainHighlight -> Maybe PlainHighlight
forall a. a -> Maybe a
Just PlainHighlight
plh)
highlightSettingsPairs (Just (Postings PostingsHighlight
ph)) = Maybe PostingsHighlight -> [Pair]
postHighPairs (PostingsHighlight -> Maybe PostingsHighlight
forall a. a -> Maybe a
Just PostingsHighlight
ph)
highlightSettingsPairs (Just (FastVector FastVectorHighlight
fvh)) = Maybe FastVectorHighlight -> [Pair]
fastVectorHighPairs (FastVectorHighlight -> Maybe FastVectorHighlight
forall a. a -> Maybe a
Just FastVectorHighlight
fvh)

plainHighPairs :: Maybe PlainHighlight -> [Pair]
plainHighPairs :: Maybe PlainHighlight -> [Pair]
plainHighPairs Maybe PlainHighlight
Nothing = []
plainHighPairs (Just (PlainHighlight Maybe CommonHighlight
plCom Maybe NonPostings
plNonPost)) =
  [Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"plain"]
    [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Maybe CommonHighlight -> [Pair]
commonHighlightPairs Maybe CommonHighlight
plCom
    [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Maybe NonPostings -> [Pair]
nonPostingsToPairs Maybe NonPostings
plNonPost

postHighPairs :: Maybe PostingsHighlight -> [Pair]
postHighPairs :: Maybe PostingsHighlight -> [Pair]
postHighPairs Maybe PostingsHighlight
Nothing = []
postHighPairs (Just (PostingsHighlight Maybe CommonHighlight
pCom)) =
  (Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"postings")
    Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Maybe CommonHighlight -> [Pair]
commonHighlightPairs Maybe CommonHighlight
pCom

fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
fastVectorHighPairs Maybe FastVectorHighlight
Nothing = []
fastVectorHighPairs
  ( Just
      ( FastVectorHighlight
          Maybe CommonHighlight
fvCom
          Maybe NonPostings
fvNonPostSettings'
          Maybe Text
fvBoundChars
          Maybe Int
fvBoundMaxScan
          Maybe Int
fvFragOff
          [Text]
fvMatchedFields
          Maybe Int
fvPhraseLim
        )
    ) =
    [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"fvh",
      Key
"boundary_chars" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
fvBoundChars,
      Key
"boundary_max_scan" Key -> Maybe Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
fvBoundMaxScan,
      Key
"fragment_offset" Key -> Maybe Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
fvFragOff,
      Key
"matched_fields" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Text]
fvMatchedFields,
      Key
"phraseLimit" Key -> Maybe Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
fvPhraseLim
    ]
      [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Maybe CommonHighlight -> [Pair]
commonHighlightPairs Maybe CommonHighlight
fvCom
      [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Maybe NonPostings -> [Pair]
nonPostingsToPairs Maybe NonPostings
fvNonPostSettings'

commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
commonHighlightPairs Maybe CommonHighlight
Nothing = []
commonHighlightPairs
  ( Just
      ( CommonHighlight
          Maybe Text
chScore
          Maybe Bool
chForceSource
          Maybe HighlightTag
chTag
          Maybe HighlightEncoder
chEncoder
          Maybe Int
chNoMatchSize
          Maybe Query
chHighlightQuery
          Maybe Bool
chRequireFieldMatch
        )
    ) =
    [ Key
"order" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
chScore,
      Key
"force_source" Key -> Maybe Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
chForceSource,
      Key
"encoder" Key -> Maybe HighlightEncoder -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe HighlightEncoder
chEncoder,
      Key
"no_match_size" Key -> Maybe Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
chNoMatchSize,
      Key
"highlight_query" Key -> Maybe Query -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Query
chHighlightQuery,
      Key
"require_fieldMatch" Key -> Maybe Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
chRequireFieldMatch
    ]
      [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Maybe HighlightTag -> [Pair]
highlightTagToPairs Maybe HighlightTag
chTag

nonPostingsToPairs :: Maybe NonPostings -> [Pair]
nonPostingsToPairs :: Maybe NonPostings -> [Pair]
nonPostingsToPairs Maybe NonPostings
Nothing = []
nonPostingsToPairs (Just (NonPostings Maybe Int
npFragSize Maybe Int
npNumOfFrags)) =
  [ Key
"fragment_size" Key -> Maybe Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
npFragSize,
    Key
"number_of_fragments" Key -> Maybe Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
npNumOfFrags
  ]

highlightTagToPairs :: Maybe HighlightTag -> [Pair]
highlightTagToPairs :: Maybe HighlightTag -> [Pair]
highlightTagToPairs (Just (TagSchema Text
_)) =
  [ Key
"scheme" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"default"
  ]
highlightTagToPairs (Just (CustomTags ([Text]
pre, [Text]
post))) =
  [ Key
"pre_tags" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Text]
pre,
    Key
"post_tags" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Text]
post
  ]
highlightTagToPairs Maybe HighlightTag
Nothing = []