Split out Highlight

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

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

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)

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
 

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

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)