From 5ce22d3a9f170e8b960dbdbabef3cdceececb7dc Mon Sep 17 00:00:00 2001 From: Chris Allen Date: Sat, 3 Mar 2018 13:00:25 -0600 Subject: [PATCH] Split out Highlight --- bloodhound.cabal | 1 + .../V5/Bloodhound/Internal/Analysis.hs | 6 +- .../V5/Bloodhound/Internal/Highlight.hs | 83 +++++++++++++++++++ .../V5/Bloodhound/Internal/Newtypes.hs | 11 +++ .../V5/Bloodhound/Internal/StringlyTyped.hs | 4 +- src/Database/V5/Bloodhound/Types.hs | 79 +----------------- 6 files changed, 99 insertions(+), 85 deletions(-) create mode 100644 src/Database/V5/Bloodhound/Internal/Highlight.hs diff --git a/bloodhound.cabal b/bloodhound.cabal index 85281e3..8269333 100644 --- a/bloodhound.cabal +++ b/bloodhound.cabal @@ -40,6 +40,7 @@ library Database.V5.Bloodhound.Internal.Aggregation Database.V5.Bloodhound.Internal.Analysis Database.V5.Bloodhound.Internal.Client + Database.V5.Bloodhound.Internal.Highlight Database.V5.Bloodhound.Internal.Newtypes Database.V5.Bloodhound.Internal.Query Database.V5.Bloodhound.Internal.Sort diff --git a/src/Database/V5/Bloodhound/Internal/Analysis.hs b/src/Database/V5/Bloodhound/Internal/Analysis.hs index 9f0e9d3..481a042 100644 --- a/src/Database/V5/Bloodhound/Internal/Analysis.hs +++ b/src/Database/V5/Bloodhound/Internal/Analysis.hs @@ -5,11 +5,7 @@ module Database.V5.Bloodhound.Internal.Analysis where import Bloodhound.Import -import Data.Aeson -import Data.Aeson.Types (Parser) import qualified Data.Map.Strict as M -import Data.Maybe (catMaybes) -import Data.Text (Text) import qualified Data.Text as T import Database.V5.Bloodhound.Internal.Newtypes @@ -216,7 +212,7 @@ data Language deriving (Eq, Show) instance ToJSON Language where - toJSON = Data.Aeson.String . languageToText + toJSON = String . languageToText instance FromJSON Language where parseJSON = withText "Language" $ \t -> case languageFromText t of diff --git a/src/Database/V5/Bloodhound/Internal/Highlight.hs b/src/Database/V5/Bloodhound/Internal/Highlight.hs new file mode 100644 index 0000000..2bcb8fd --- /dev/null +++ b/src/Database/V5/Bloodhound/Internal/Highlight.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} + +module Database.V5.Bloodhound.Internal.Highlight where + +import Bloodhound.Import + +-- import Data.Aeson +-- import Data.Aeson.Types (Parser) +import qualified Data.Map.Strict as M + +import Database.V5.Bloodhound.Internal.Newtypes +import Database.V5.Bloodhound.Internal.Query + +type HitHighlight = M.Map Text [Text] + +data Highlights = Highlights + { globalsettings :: Maybe HighlightSettings + , highlightFields :: [FieldHighlight] + } deriving (Eq, Show) + +data FieldHighlight = + FieldHighlight FieldName (Maybe HighlightSettings) + deriving (Eq, Show) + + +data HighlightSettings = + Plain PlainHighlight + | Postings PostingsHighlight + | FastVector FastVectorHighlight + deriving (Eq, Show) + +data PlainHighlight = + PlainHighlight { plainCommon :: Maybe CommonHighlight + , plainNonPost :: Maybe NonPostings } + deriving (Eq, Show) + + -- This requires that index_options are set to 'offset' in the mapping. +data PostingsHighlight = + PostingsHighlight (Maybe CommonHighlight) + deriving (Eq, Show) + +-- This requires that term_vector is set to 'with_positions_offsets' in the mapping. +data FastVectorHighlight = FastVectorHighlight + { fvCommon :: Maybe CommonHighlight + , fvNonPostSettings :: Maybe NonPostings + , boundaryChars :: Maybe Text + , boundaryMaxScan :: Maybe Int + , fragmentOffset :: Maybe Int + , matchedFields :: [Text] + , phraseLimit :: Maybe Int + } deriving (Eq, Show) + +data CommonHighlight = CommonHighlight + { order :: Maybe Text + , forceSource :: Maybe Bool + , tag :: Maybe HighlightTag + , encoder :: Maybe HighlightEncoder + , noMatchSize :: Maybe Int + , highlightQuery :: Maybe Query + , requireFieldMatch :: Maybe Bool + } deriving (Eq, Show) + +-- Settings that are only applicable to FastVector and Plain highlighters. +data NonPostings = + NonPostings { fragmentSize :: Maybe Int + , numberOfFragments :: Maybe Int + } deriving (Eq, Show) + +data HighlightEncoder = DefaultEncoder + | HTMLEncoder + deriving (Eq, Show) + +instance ToJSON HighlightEncoder where + toJSON DefaultEncoder = String "default" + toJSON HTMLEncoder = String "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 (Eq, Show) diff --git a/src/Database/V5/Bloodhound/Internal/Newtypes.hs b/src/Database/V5/Bloodhound/Internal/Newtypes.hs index 5863ce0..d58690e 100644 --- a/src/Database/V5/Bloodhound/Internal/Newtypes.hs +++ b/src/Database/V5/Bloodhound/Internal/Newtypes.hs @@ -5,9 +5,20 @@ module Database.V5.Bloodhound.Internal.Newtypes where import Bloodhound.Import +import qualified Data.Map.Strict as M + newtype From = From Int deriving (Eq, Show, ToJSON) newtype Size = Size Int deriving (Eq, Show, ToJSON, FromJSON) +-- Used with scripts +newtype HitFields = + HitFields (M.Map Text [Value]) + deriving (Eq, Show) + +instance FromJSON HitFields where + parseJSON x + = HitFields <$> parseJSON x + -- Slight misnomer. type Score = Maybe Double diff --git a/src/Database/V5/Bloodhound/Internal/StringlyTyped.hs b/src/Database/V5/Bloodhound/Internal/StringlyTyped.hs index c669295..ea3d41a 100644 --- a/src/Database/V5/Bloodhound/Internal/StringlyTyped.hs +++ b/src/Database/V5/Bloodhound/Internal/StringlyTyped.hs @@ -2,10 +2,10 @@ module Database.V5.Bloodhound.Internal.StringlyTyped where -import Data.Aeson +import Bloodhound.Import + import qualified Data.Text as T -import Bloodhound.Import -- This whole module is a sin bucket to deal with Elasticsearch badness. newtype StringlyTypedDouble = StringlyTypedDouble diff --git a/src/Database/V5/Bloodhound/Types.hs b/src/Database/V5/Bloodhound/Types.hs index fd4ad61..9e4bb46 100644 --- a/src/Database/V5/Bloodhound/Types.hs +++ b/src/Database/V5/Bloodhound/Types.hs @@ -421,6 +421,7 @@ import Database.V5.Bloodhound.Types.Class import Database.V5.Bloodhound.Internal.Analysis import Database.V5.Bloodhound.Internal.Aggregation import Database.V5.Bloodhound.Internal.Client +import Database.V5.Bloodhound.Internal.Highlight import Database.V5.Bloodhound.Internal.Newtypes import Database.V5.Bloodhound.Internal.Query import Database.V5.Bloodhound.Internal.Sort @@ -491,74 +492,6 @@ data Exclude = Exclude [Pattern] deriving (Eq, Read, Show) newtype Pattern = Pattern Text deriving (Eq, Read, Show) -data Highlights = Highlights - { globalsettings :: Maybe HighlightSettings - , highlightFields :: [FieldHighlight] - } deriving (Eq, Show) - -data FieldHighlight = - FieldHighlight FieldName (Maybe HighlightSettings) - deriving (Eq, Show) - - -data HighlightSettings = - Plain PlainHighlight - | Postings PostingsHighlight - | FastVector FastVectorHighlight - deriving (Eq, Show) - -data PlainHighlight = - PlainHighlight { plainCommon :: Maybe CommonHighlight - , plainNonPost :: Maybe NonPostings } - deriving (Eq, Show) - - -- This requires that index_options are set to 'offset' in the mapping. -data PostingsHighlight = - PostingsHighlight (Maybe CommonHighlight) - deriving (Eq, Show) - --- This requires that term_vector is set to 'with_positions_offsets' in the mapping. -data FastVectorHighlight = FastVectorHighlight - { fvCommon :: Maybe CommonHighlight - , fvNonPostSettings :: Maybe NonPostings - , boundaryChars :: Maybe Text - , boundaryMaxScan :: Maybe Int - , fragmentOffset :: Maybe Int - , matchedFields :: [Text] - , phraseLimit :: Maybe Int - } deriving (Eq, Show) - -data CommonHighlight = CommonHighlight - { order :: Maybe Text - , forceSource :: Maybe Bool - , tag :: Maybe HighlightTag - , encoder :: Maybe HighlightEncoder - , noMatchSize :: Maybe Int - , highlightQuery :: Maybe Query - , requireFieldMatch :: Maybe Bool - } deriving (Eq, Show) - --- Settings that are only applicable to FastVector and Plain highlighters. -data NonPostings = - NonPostings { fragmentSize :: Maybe Int - , numberOfFragments :: Maybe Int - } deriving (Eq, Show) - -data HighlightEncoder = DefaultEncoder - | HTMLEncoder - deriving (Eq, Show) - -instance ToJSON HighlightEncoder where - toJSON DefaultEncoder = String "default" - toJSON HTMLEncoder = String "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 (Eq, Show) - data SearchResult a = SearchResult { took :: Int , timedOut :: Bool @@ -627,16 +560,6 @@ instance (FromJSON a) => FromJSON (Hit a) where v .:? "highlight" parseJSON _ = empty -newtype HitFields = - HitFields (M.Map Text [Value]) - deriving (Eq, Show) - -instance FromJSON HitFields where - parseJSON x - = HitFields <$> parseJSON x - -type HitHighlight = M.Map Text [Text] - data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)