bc0da4a · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

hlint, weeder

bc0da4aChris Allen9 years ago

.hlint.yamlnew file+66

compare with master

unifiedsplit

@@ -0,0 +1,66 @@

1+# HLint configuration file

2+# https://github.com/ndmitchell/hlint

3+##########################

5+# This file contains a template configuration file, which is typically

6+# placed as .hlint.yaml in the root of your project

9+# Specify additional command line arguments

10+#

11+# - arguments: [--color, --cpp-simple, -XQuasiQuotes]

12+

13+

14+# Control which extensions/flags/modules/functions can be used

15+#

16+# - extensions:

17+# - default: false # all extension are banned by default

18+# - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used

19+# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module

20+#

21+# - flags:

22+# - {name: -w, within: []} # -w is allowed nowhere

23+#

24+# - modules:

25+# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'

26+# - {name: Control.Arrow, within: []} # Certain modules are banned entirely

27+#

28+# - functions:

29+# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules

30+

31+

32+# Add custom hints for this project

33+#

34+# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"

35+# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}

36+

37+

38+# Turn on hints that are off by default

39+#

40+# Ban "module X(module X) where", to require a real export list

41+# - warn: {name: Use explicit module export list}

42+#

43+# Replace a $ b $ c with a . b $ c

44+# - group: {name: dollar, enabled: true}

45+#

46+# Generalise map to fmap, ++ to <>

47+# - group: {name: generalise, enabled: true}

48+

49+

50+# Ignore some builtin hints

51+- ignore: {name: "Use <$>"}

52+- ignore: {name: "Use lambda-case"}

53+# When we don't use camelCase it's to match ES.

54+# Possibly this is a mistake.

55+- ignore: {name: "Use camelCase"}

56+- ignore: {name: "Eta reduce"}

57+# - ignore: {name: Use let}

58+# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules

59+

60+

61+# Define some custom infix operators

62+# - fixity: infixr 3 ~^#^~

63+

64+

65+# To generate a suitable file for HLint do:

66+# $ hlint --default > .hlint.yaml

Makefile+16

@@ -3,6 +3,9 @@ stack = STACK_YAML='stack.yaml' stack

3build:

4 stack build

6+build-validate:

7+ stack build --fast --ghc-options '-Werror'

6ghci:

9ghci:

7 stack ghci

10 stack ghci

@@ -18,6 +21,19 @@ test-ghci:

18ghcid:

21ghcid:

19 ghcid -c "$(stack) ghci bloodhound:lib --test --ghci-options='-fobject-code -fno-warn-unused-do-bind' --main-is bloodhound:test:bloodhound-tests"

22 ghcid -c "$(stack) ghci bloodhound:lib --test --ghci-options='-fobject-code -fno-warn-unused-do-bind' --main-is bloodhound:test:bloodhound-tests"

24+ghcid-validate:

25+ ghcid -c "$(stack) ghci bloodhound:lib --test --ghci-options='-Werror -fobject-code -fno-warn-unused-do-bind' --main-is bloodhound:test:bloodhound-tests"

26+

27+weeder:

28+ weeder . --build

29+

30+# hlint --default > .hlint.yaml

31+hlint:

32+ hlint .

33+

34+hlint-watch:

35+ sos src/ -c "hlint ." -p "src/(.*)\.hs"

36+

21mod-build:

37mod-build:

22 stack build --ghc-options '+RTS -A128M -RTS'

38 stack build --ghc-options '+RTS -A128M -RTS'

bloodhound.cabal+8−12

@@ -37,6 +37,11 @@ library

37 Database.V5.Bloodhound.Client

38 Database.V5.Bloodhound.Types

39 Database.V5.Bloodhound.Types.Class

40+ Database.V5.Bloodhound.Internal.Analysis

41+ Database.V5.Bloodhound.Internal.Client

42+ Database.V5.Bloodhound.Internal.Newtypes

43+ Database.V5.Bloodhound.Internal.Query

44+ Database.V5.Bloodhound.Internal.StringlyTyped

40 Database.V1.Bloodhound

45 Database.V1.Bloodhound

41 Database.V1.Bloodhound.Client

46 Database.V1.Bloodhound.Client

42 Database.V1.Bloodhound.Types

47 Database.V1.Bloodhound.Types

@@ -44,11 +49,6 @@ library

44 Database.V1.Bloodhound.Types.Internal

49 Database.V1.Bloodhound.Types.Internal

45 other-modules: Bloodhound.Import

50 other-modules: Bloodhound.Import

46 Database.Bloodhound.Common.Script

51 Database.Bloodhound.Common.Script

47− Database.V5.Bloodhound.Internal.Analysis

48− Database.V5.Bloodhound.Internal.Client

49− Database.V5.Bloodhound.Internal.Newtypes

50− Database.V5.Bloodhound.Internal.Query

51− Database.V5.Bloodhound.Internal.StringlyTyped

52 hs-source-dirs: src

53 build-depends: base >= 4.3 && <5,

54 bytestring >= 0.10.0 && <0.11,

@@ -64,13 +64,10 @@ library

64 http-types >= 0.8 && <0.13,

65 vector >= 0.10.9 && <0.13,

66 scientific >= 0.3.0.0 && <0.4.0.0,

67− bifunctors,

68− exceptions,

69− data-default-class,

70 blaze-builder,

67 blaze-builder,

68+ exceptions,

69+ hashable,

71− unordered-containers,

70+ unordered-containers

72− mtl-compat,

73− hashable

74 default-language: Haskell2010

71 default-language: Haskell2010

76test-suite bloodhound-tests

73test-suite bloodhound-tests

@@ -116,7 +113,6 @@ test-suite bloodhound-tests

116 pretty-simple,

113 pretty-simple,

117 quickcheck-arbitrary-template,

114 quickcheck-arbitrary-template,

118 quickcheck-properties,

115 quickcheck-properties,

119− generics-sop >=0.2 && <0.4,

120 errors,

116 errors,

121 exceptions,

117 exceptions,

122 temporary,

118 temporary,

src/Database/V1/Bloodhound/Client.hs+13−9

@@ -223,7 +223,8 @@ getStatus :: MonadBH m => m (Maybe Status)

223getStatus = do

224 response <- get =<< url

225 return $ decode (responseBody response)

226+ where

226− where url = joinPath []

227+ url = joinPath []

227

228

228-- | 'getSnapshotRepos' gets the definitions of a subset of the

229-- | 'getSnapshotRepos' gets the definitions of a subset of the

229-- defined snapshot repos.

230-- defined snapshot repos.

@@ -252,7 +253,7 @@ instance FromJSON GSRs where

252 parseJSON = withObject "Collection of GenericSnapshotRepo" parse

253 parseJSON = withObject "Collection of GenericSnapshotRepo" parse

253 where

254 where

254 parse = fmap GSRs . mapM (uncurry go) . HM.toList

255 parse = fmap GSRs . mapM (uncurry go) . HM.toList

255− go rawName = withObject "GenericSnapshotRepo" $ \o -> do

256+ go rawName = withObject "GenericSnapshotRepo" $ \o ->

256 GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"

257 GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"

257 <*> o .: "settings"

258 <*> o .: "settings"

258

259

@@ -454,16 +455,18 @@ deleteIndex (IndexName indexName) =

454updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply

455updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply

455updateIndexSettings updates (IndexName indexName) =

456updateIndexSettings updates (IndexName indexName) =

456 bindM2 put url (return body)

457 bindM2 put url (return body)

458+ where

457− where url = joinPath [indexName, "_settings"]

459+ url = joinPath [indexName, "_settings"]

458− body = Just (encode jsonBody)

460+ body = Just (encode jsonBody)

459− jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])

461+ jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])

460

462

461

463

462getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName

464getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName

463 -> m (Either EsError IndexSettingsSummary)

465 -> m (Either EsError IndexSettingsSummary)

464−getIndexSettings (IndexName indexName) = do

466+getIndexSettings (IndexName indexName) =

465 parseEsResponse =<< get =<< url

467 parseEsResponse =<< get =<< url

468+ where

466− where url = joinPath [indexName, "_settings"]

469+ url = joinPath [indexName, "_settings"]

467

470

468

471

469-- | 'optimizeIndex' will optimize a single index, list of indexes or

472-- | 'optimizeIndex' will optimize a single index, list of indexes or

@@ -586,7 +589,7 @@ listIndices =

586 url = joinPath ["_cat/indices?format=json"]

589 url = joinPath ["_cat/indices?format=json"]

587 parse body = maybe (throwM (EsProtocolException body)) return $ do

590 parse body = maybe (throwM (EsProtocolException body)) return $ do

588 vals <- decode body

591 vals <- decode body

589− forM vals $ \val -> do

592+ forM vals $ \val ->

590 case val of

593 case val of

591 Object obj -> do

594 Object obj -> do

592 indexVal <- HM.lookup "index" obj

595 indexVal <- HM.lookup "index" obj

@@ -718,7 +721,8 @@ encodeBulkOperations stream = collapsed where

718 collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")

721 collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")

719

722

720mash :: Builder -> V.Vector L.ByteString -> Builder

723mash :: Builder -> V.Vector L.ByteString -> Builder

724+mash =

721−mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))

725+ V.foldl' (\b x -> b <> byteString "\n" <> lazyByteString x)

722

726

723mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value

727mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value

724mkBulkStreamValue operation indexName mappingName docId =

728mkBulkStreamValue operation indexName mappingName docId =

src/Database/V1/Bloodhound/Types.hs+7−5

@@ -4,7 +4,6 @@

4{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

7−-- {-# LANGUAGE NoMonomorphismRestriction #-}

8{-# LANGUAGE NamedFieldPuns #-}

7{-# LANGUAGE NamedFieldPuns #-}

9{-# LANGUAGE OverloadedStrings #-}

8{-# LANGUAGE OverloadedStrings #-}

10{-# LANGUAGE RecordWildCards #-}

9{-# LANGUAGE RecordWildCards #-}

@@ -1137,8 +1136,10 @@ data Source =

1137 | SourceIncludeExclude Include Exclude

1136 | SourceIncludeExclude Include Exclude

1138 deriving (Read, Show, Eq, Generic, Typeable)

1137 deriving (Read, Show, Eq, Generic, Typeable)

1139

1138

1140−data PatternOrPatterns = PopPattern Pattern

1139+data PatternOrPatterns =

1140+ PopPattern Pattern

1141+ | PopPatterns [Pattern]

1141− | PopPatterns [Pattern] deriving (Eq, Read, Show, Generic, Typeable)

1142+ deriving (Eq, Read, Show, Generic, Typeable)

1142

1143

1143data Include = Include [Pattern] deriving (Eq, Read, Show, Generic, Typeable)

1144data Include = Include [Pattern] deriving (Eq, Read, Show, Generic, Typeable)

1144data Exclude = Exclude [Pattern] deriving (Eq, Read, Show, Generic, Typeable)

1145data Exclude = Exclude [Pattern] deriving (Eq, Read, Show, Generic, Typeable)

@@ -1906,8 +1907,9 @@ instance ToJSON TermOrder where

1906

1907

1907instance ToJSON TermInclusion where

1908instance ToJSON TermInclusion where

1908 toJSON (TermInclusion x) = toJSON x

1909 toJSON (TermInclusion x) = toJSON x

1909− toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,

1910+ toJSON (TermPattern pattern flags) =

1911+ omitNulls [ "pattern" .= pattern

1910− "flags" .= flags]

1912+ , "flags" .= flags]

1911

1913

1912instance ToJSON CollectionMode where

1914instance ToJSON CollectionMode where

1913 toJSON BreadthFirst = "breadth_first"

1915 toJSON BreadthFirst = "breadth_first"

src/Database/V5/Bloodhound/Client.hs+14−11

@@ -317,7 +317,7 @@ instance FromJSON GSRs where

317 parseJSON = withObject "Collection of GenericSnapshotRepo" parse

318 where

319 parse = fmap GSRs . mapM (uncurry go) . HM.toList

320− go rawName = withObject "GenericSnapshotRepo" $ \o -> do

320+ go rawName = withObject "GenericSnapshotRepo" $ \o ->

321 GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"

322 <*> o .: "settings"

323

@@ -555,16 +555,18 @@ deleteIndex (IndexName indexName) =

555updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply

556updateIndexSettings updates (IndexName indexName) =

557 bindM2 put url (return body)

558+ where

558− where url = joinPath [indexName, "_settings"]

559+ url = joinPath [indexName, "_settings"]

559− body = Just (encode jsonBody)

560+ body = Just (encode jsonBody)

560− jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])

561+ jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])

561

562

563

563getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName

564getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName

564 -> m (Either EsError IndexSettingsSummary)

565 -> m (Either EsError IndexSettingsSummary)

565−getIndexSettings (IndexName indexName) = do

566+getIndexSettings (IndexName indexName) =

566 parseEsResponse =<< get =<< url

567 parseEsResponse =<< get =<< url

568+ where

567− where url = joinPath [indexName, "_settings"]

569+ url = joinPath [indexName, "_settings"]

568

570

569-- | 'forceMergeIndex'

571-- | 'forceMergeIndex'

570--

572--

@@ -704,7 +706,7 @@ listIndices =

704 url = joinPath ["_cat/indices?format=json"]

706 url = joinPath ["_cat/indices?format=json"]

705 parse body = maybe (throwM (EsProtocolException body)) return $ do

707 parse body = maybe (throwM (EsProtocolException body)) return $ do

706 vals <- decode body

708 vals <- decode body

707− forM vals $ \val -> do

709+ forM vals $ \val ->

708 case val of

710 case val of

709 Object obj -> do

711 Object obj -> do

710 indexVal <- HM.lookup "index" obj

712 indexVal <- HM.lookup "index" obj

@@ -861,10 +863,11 @@ deleteDocument (IndexName indexName)

861-- >>> _ <- runBH' $ bulk stream

863-- >>> _ <- runBH' $ bulk stream

862-- >>> _ <- runBH' $ refreshIndex testIndex

864-- >>> _ <- runBH' $ refreshIndex testIndex

863bulk :: MonadBH m => V.Vector BulkOperation -> m Reply

865bulk :: MonadBH m => V.Vector BulkOperation -> m Reply

864−bulk bulkOps = do

866+bulk bulkOps =

865 bindM2 post url (return body)

867 bindM2 post url (return body)

868+ where

866− where url = joinPath ["_bulk"]

869+ url = joinPath ["_bulk"]

867− body = Just $ encodeBulkOperations bulkOps

870+ body = Just $ encodeBulkOperations bulkOps

868

871

869-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'

872-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'

870-- into an 'L.ByteString'

873-- into an 'L.ByteString'

@@ -882,7 +885,7 @@ encodeBulkOperations stream = collapsed where

882 toLazyByteString $ mappend mashedTaters (byteString "\n")

885 toLazyByteString $ mappend mashedTaters (byteString "\n")

883

886

884mash :: Builder -> V.Vector L.ByteString -> Builder

887mash :: Builder -> V.Vector L.ByteString -> Builder

885−mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))

888+mash = V.foldl' (\b x -> b <> byteString "\n" <> lazyByteString x)

886

889

887mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value

890mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value

888mkBulkStreamValue operation indexName mappingName docId =

891mkBulkStreamValue operation indexName mappingName docId =

src/Database/V5/Bloodhound/Internal/Analysis.hs+4−4

@@ -52,8 +52,8 @@ instance FromJSON AnalyzerDefinition where

52 <$> m .:? "tokenizer"

53 <*> m .:? "filter" .!= []

55−data TokenizerDefinition

55+newtype TokenizerDefinition =

56− = TokenizerDefinitionNgram Ngram

56+ TokenizerDefinitionNgram Ngram

57 deriving (Eq,Show)

59instance ToJSON TokenizerDefinition where

@@ -70,8 +70,8 @@ instance FromJSON TokenizerDefinition where

70 typ <- m .: "type" :: Parser Text

71 case typ of

72 "ngram" -> fmap TokenizerDefinitionNgram $ Ngram

73− <$> (fmap unStringlyTypedInt (m .: "min_gram"))

73+ <$> fmap unStringlyTypedInt (m .: "min_gram")

74− <*> (fmap unStringlyTypedInt (m .: "max_gram"))

74+ <*> fmap unStringlyTypedInt (m .: "max_gram")

75 <*> m .: "token_chars"

76 _ -> fail "invalid TokenizerDefinition"

src/Database/V5/Bloodhound/Internal/Client.hs+393−60

@@ -10,6 +10,7 @@ module Database.V5.Bloodhound.Internal.Client where

10import Bloodhound.Import

12import qualified Data.Text as T

13+import qualified Data.Traversable as DT

13import qualified Data.HashMap.Strict as HM

14import qualified Data.HashMap.Strict as HM

14import qualified Data.Vector as V

15import qualified Data.Vector as V

15import qualified Data.Version as Vers

16import qualified Data.Version as Vers

@@ -114,6 +115,15 @@ data Status = Status

114 , tagline :: Text }

115 , tagline :: Text }

115 deriving (Eq, Show)

116 deriving (Eq, Show)

116

117

118+instance FromJSON Status where

119+ parseJSON (Object v) = Status <$>

120+ v .: "name" <*>

121+ v .: "cluster_name" <*>

122+ v .: "cluster_uuid" <*>

123+ v .: "version" <*>

124+ v .: "tagline"

125+ parseJSON _ = empty

126+

117{-| 'IndexSettings' is used to configure the shards and replicas when

127{-| 'IndexSettings' is used to configure the shards and replicas when

118 you create an Elasticsearch Index.

128 you create an Elasticsearch Index.

119

129

@@ -125,6 +135,20 @@ data IndexSettings = IndexSettings

125 , indexReplicas :: ReplicaCount }

135 , indexReplicas :: ReplicaCount }

126 deriving (Eq, Show)

136 deriving (Eq, Show)

127

137

138+instance ToJSON IndexSettings where

139+ toJSON (IndexSettings s r) = object ["settings" .=

140+ object ["index" .=

141+ object ["number_of_shards" .= s, "number_of_replicas" .= r]

142+ ]

143+ ]

144+

145+instance FromJSON IndexSettings where

146+ parseJSON = withObject "IndexSettings" parse

147+ where parse o = do s <- o .: "settings"

148+ i <- s .: "index"

149+ IndexSettings <$> i .: "number_of_shards"

150+ <*> i .: "number_of_replicas"

151+

128{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and

152{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and

129 2 replicas. -}

153 2 replicas. -}

130defaultIndexSettings :: IndexSettings

154defaultIndexSettings :: IndexSettings

@@ -212,11 +236,150 @@ data UpdatableIndexSetting = NumberOfReplicas ReplicaCount

212 -- ^ Analysis is not a dynamic setting and can only be performed on a closed index.

236 -- ^ Analysis is not a dynamic setting and can only be performed on a closed index.

213 deriving (Eq, Show)

237 deriving (Eq, Show)

214

238

239+oPath :: ToJSON a => NonEmpty Text -> a -> Value

240+oPath (k :| []) v = object [k .= v]

241+oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]

242+

243+attrFilterJSON :: NonEmpty NodeAttrFilter -> Value

244+attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)

245+ | NodeAttrFilter (NodeAttrName n) vs <- toList fs]

246+

247+parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)

248+parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse

249+ where parse o = case HM.toList o of

250+ [] -> fail "Expected non-empty list of NodeAttrFilters"

251+ x:xs -> DT.mapM (uncurry parse') (x :| xs)

252+ parse' n = withText "Text" $ \t ->

253+ case T.splitOn "," t of

254+ fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))

255+ [] -> fail "Expected non-empty list of filter values"

256+

257+instance ToJSON UpdatableIndexSetting where

258+ toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x

259+ toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x

260+ toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)

261+ toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x

262+ toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x

263+ toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x

264+ toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x

265+ toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)

266+ toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x

267+ toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x

268+ toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)

269+ toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)

270+ toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)

271+ toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)

272+ toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)

273+ toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x

274+ toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x

275+ toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x

276+ toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)

277+ toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x

278+ toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x

279+ toJSON (CompressionSetting x) = oPath ("index" :| ["codec"]) x

280+ toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x

281+ toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x

282+ toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x

283+ toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x

284+ toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x

285+ toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x

286+ toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x

287+ toJSON (MappingTotalFieldsLimit x) = oPath ("index" :| ["mapping","total_fields","limit"]) x

288+ toJSON (AnalysisSetting x) = oPath ("index" :| ["analysis"]) x

289+

290+instance FromJSON UpdatableIndexSetting where

291+ parseJSON = withObject "UpdatableIndexSetting" parse

292+ where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]

293+ <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]

294+ <|> refreshInterval `taggedAt` ["index", "refresh_interval"]

295+ <|> indexConcurrency `taggedAt` ["index", "concurrency"]

296+ <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]

297+ <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]

298+ <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]

299+ <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]

300+ <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]

301+ <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]

302+ <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]

303+ <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]

304+ <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]

305+ <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]

306+ <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]

307+ <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]

308+ <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]

309+ <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]

310+ <|> gcDeletes `taggedAt` ["index", "gc_deletes"]

311+ <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]

312+ <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]

313+ <|> compressionSetting `taggedAt` ["index", "codec"]

314+ <|> compoundFormat `taggedAt` ["index", "compound_format"]

315+ <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]

316+ <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]

317+ <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]

318+ <|> blocksRead `taggedAt` ["blocks", "read"]

319+ <|> blocksWrite `taggedAt` ["blocks", "write"]

320+ <|> blocksMetaData `taggedAt` ["blocks", "metadata"]

321+ <|> mappingTotalFieldsLimit `taggedAt` ["index", "mapping", "total_fields", "limit"]

322+ <|> analysisSetting `taggedAt` ["index", "analysis"]

323+ where taggedAt f ks = taggedAt' f (Object o) ks

324+ taggedAt' f v [] =

325+ f =<< (parseJSON v <|> parseJSON (unStringlyTypeJSON v))

326+ taggedAt' f v (k:ks) =

327+ withObject "Object" (\o -> do v' <- o .: k

328+ taggedAt' f v' ks) v

329+ numberOfReplicas = pure . NumberOfReplicas

330+ autoExpandReplicas = pure . AutoExpandReplicas

331+ refreshInterval = pure . RefreshInterval . ndtJSON

332+ indexConcurrency = pure . IndexConcurrency

333+ failOnMergeFailure = pure . FailOnMergeFailure

334+ translogFlushThresholdOps = pure . TranslogFlushThresholdOps

335+ translogFlushThresholdSize = pure . TranslogFlushThresholdSize

336+ translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON

337+ translogDisableFlush = pure . TranslogDisableFlush

338+ cacheFilterMaxSize = pure . CacheFilterMaxSize

339+ cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON

340+ gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON

341+ routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter

342+ routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter

343+ routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter

344+ routingAllocationEnable = pure . RoutingAllocationEnable

345+ routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode

346+ recoveryInitialShards = pure . RecoveryInitialShards

347+ gcDeletes = pure . GCDeletes . ndtJSON

348+ ttlDisablePurge = pure . TTLDisablePurge

349+ translogFSType = pure . TranslogFSType

350+ compressionSetting = pure . CompressionSetting

351+ compoundFormat = pure . IndexCompoundFormat

352+ compoundOnFlush = pure . IndexCompoundOnFlush

353+ warmerEnabled = pure . WarmerEnabled

354+ blocksReadOnly = pure . BlocksReadOnly

355+ blocksRead = pure . BlocksRead

356+ blocksWrite = pure . BlocksWrite

357+ blocksMetaData = pure . BlocksMetaData

358+ mappingTotalFieldsLimit = pure . MappingTotalFieldsLimit

359+ analysisSetting = pure . AnalysisSetting

360+

215data ReplicaBounds = ReplicasBounded Int Int

361data ReplicaBounds = ReplicasBounded Int Int

216 | ReplicasLowerBounded Int

362 | ReplicasLowerBounded Int

217 | ReplicasUnbounded

363 | ReplicasUnbounded

218 deriving (Eq, Show)

364 deriving (Eq, Show)

219

365

366+

367+instance ToJSON ReplicaBounds where

368+ toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)

369+ toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")

370+ toJSON ReplicasUnbounded = Bool False

371+

372+instance FromJSON ReplicaBounds where

373+ parseJSON v = withText "ReplicaBounds" parseText v

374+ <|> withBool "ReplicaBounds" parseBool v

375+ where parseText t = case T.splitOn "-" t of

376+ [a, "all"] -> ReplicasLowerBounded <$> parseReadText a

377+ [a, b] -> ReplicasBounded <$> parseReadText a

378+ <*> parseReadText b

379+ _ -> fail ("Could not parse ReplicaBounds: " <> show t)

380+ parseBool False = pure ReplicasUnbounded

381+ parseBool _ = fail "ReplicasUnbounded cannot be represented with True"

382+

220data Compression

383data Compression

221 = CompressionDefault

384 = CompressionDefault

222 -- ^ Compress with LZ4

385 -- ^ Compress with LZ4

@@ -267,6 +430,16 @@ kilobytes n = Bytes (1000 * n)

267data FSType = FSSimple

430data FSType = FSSimple

268 | FSBuffered deriving (Eq, Show)

431 | FSBuffered deriving (Eq, Show)

269

432

433+instance ToJSON FSType where

434+ toJSON FSSimple = "simple"

435+ toJSON FSBuffered = "buffered"

436+

437+instance FromJSON FSType where

438+ parseJSON = withText "FSType" parse

439+ where parse "simple" = pure FSSimple

440+ parse "buffered" = pure FSBuffered

441+ parse t = fail ("Invalid FSType: " <> show t)

442+

270data InitialShardCount = QuorumShards

443data InitialShardCount = QuorumShards

271 | QuorumMinus1Shards

444 | QuorumMinus1Shards

272 | FullShards

445 | FullShards

@@ -274,6 +447,22 @@ data InitialShardCount = QuorumShards

274 | ExplicitShards Int

447 | ExplicitShards Int

275 deriving (Eq, Show)

448 deriving (Eq, Show)

276

449

450+instance FromJSON InitialShardCount where

451+ parseJSON v = withText "InitialShardCount" parseText v

452+ <|> ExplicitShards <$> parseJSON v

453+ where parseText "quorum" = pure QuorumShards

454+ parseText "quorum-1" = pure QuorumMinus1Shards

455+ parseText "full" = pure FullShards

456+ parseText "full-1" = pure FullMinus1Shards

457+ parseText _ = mzero

458+

459+instance ToJSON InitialShardCount where

460+ toJSON QuorumShards = String "quorum"

461+ toJSON QuorumMinus1Shards = String "quorum-1"

462+ toJSON FullShards = String "full"

463+ toJSON FullMinus1Shards = String "full-1"

464+ toJSON (ExplicitShards x) = toJSON x

465+

277data NodeAttrFilter = NodeAttrFilter

466data NodeAttrFilter = NodeAttrFilter

278 { nodeAttrFilterName :: NodeAttrName

467 { nodeAttrFilterName :: NodeAttrName

279 , nodeAttrFilterValues :: NonEmpty Text }

468 , nodeAttrFilterValues :: NonEmpty Text }

@@ -286,12 +475,52 @@ data CompoundFormat = CompoundFileFormat Bool

286 -- ^ percentage between 0 and 1 where 0 is false, 1 is true

475 -- ^ percentage between 0 and 1 where 0 is false, 1 is true

287 deriving (Eq, Show)

476 deriving (Eq, Show)

288

477

478+instance ToJSON CompoundFormat where

479+ toJSON (CompoundFileFormat x) = Bool x

480+ toJSON (MergeSegmentVsTotalIndex x) = toJSON x

481+

482+instance FromJSON CompoundFormat where

483+ parseJSON v = CompoundFileFormat <$> parseJSON v

484+ <|> MergeSegmentVsTotalIndex <$> parseJSON v

485+

486+newtype NominalDiffTimeJSON =

289−newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }

487+ NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }

290

488

489+instance ToJSON NominalDiffTimeJSON where

490+ toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")

491+

492+instance FromJSON NominalDiffTimeJSON where

493+ parseJSON = withText "NominalDiffTime" parse

494+ where parse t = case T.takeEnd 1 t of

495+ "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)

496+ _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"

497+

291−data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName

498+data IndexSettingsSummary = IndexSettingsSummary

499+ { sSummaryIndexName :: IndexName

292− , sSummaryFixedSettings :: IndexSettings

500+ , sSummaryFixedSettings :: IndexSettings

293− , sSummaryUpdateable :: [UpdatableIndexSetting]}

501+ , sSummaryUpdateable :: [UpdatableIndexSetting]}

294− deriving (Eq, Show)

502+ deriving (Eq, Show)

503+

504+parseSettings :: Object -> Parser [UpdatableIndexSetting]

505+parseSettings o = do

506+ o' <- o .: "index"

507+ -- slice the index object into singleton hashmaps and try to parse each

508+ parses <- forM (HM.toList o') $ \(k, v) -> do

509+ -- blocks are now nested into the "index" key, which is not how they're serialized

510+ let atRoot = Object (HM.singleton k v)

511+ let atIndex = Object (HM.singleton "index" atRoot)

512+ optional (parseJSON atRoot <|> parseJSON atIndex)

513+ return (catMaybes parses)

514+

515+instance FromJSON IndexSettingsSummary where

516+ parseJSON = withObject "IndexSettingsSummary" parse

517+ where parse o = case HM.toList o of

518+ [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)

519+ <$> parseJSON v

520+ <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")

521+ _ -> fail "Expected single-key object with index name"

522+ redundant (NumberOfReplicas _) = True

523+ redundant _ = False

295

524

296{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}

525{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}

297type Reply = Network.HTTP.Client.Response LByteString

526type Reply = Network.HTTP.Client.Response LByteString

@@ -310,8 +539,9 @@ data FieldType = GeoPointType

310 | ShortType

539 | ShortType

311 | ByteType deriving (Eq, Show)

540 | ByteType deriving (Eq, Show)

312

541

313−data FieldDefinition =

542+newtype FieldDefinition = FieldDefinition

314− FieldDefinition { fieldType :: FieldType } deriving (Eq, Show)

543+ { fieldType :: FieldType

544+ } deriving (Eq, Show)

315

545

316{-| An 'IndexTemplate' defines a template that will automatically be

546{-| An 'IndexTemplate' defines a template that will automatically be

317 applied to new indices created. The templates include both

547 applied to new indices created. The templates include both

@@ -327,6 +557,17 @@ data IndexTemplate =

327 , templateMappings :: [Value]

557 , templateMappings :: [Value]

328 }

558 }

329

559

560+instance ToJSON IndexTemplate where

561+ toJSON (IndexTemplate p s m) = merge

562+ (object [ "template" .= p

563+ , "mappings" .= foldl' merge (object []) m

564+ ])

565+ (toJSON s)

566+ where

567+ merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2

568+ merge o Null = o

569+ merge _ _ = undefined

570+

330data MappingField =

571data MappingField =

331 MappingField { mappingFieldName :: FieldName

572 MappingField { mappingFieldName :: FieldName

332 , fieldDefinition :: FieldDefinition }

573 , fieldDefinition :: FieldDefinition }

@@ -355,6 +596,20 @@ data AllocationPolicy = AllocAll

355 -- ^ No shard allocation is allowed

596 -- ^ No shard allocation is allowed

356 deriving (Eq, Show)

597 deriving (Eq, Show)

357

598

599+instance ToJSON AllocationPolicy where

600+ toJSON AllocAll = String "all"

601+ toJSON AllocPrimaries = String "primaries"

602+ toJSON AllocNewPrimaries = String "new_primaries"

603+ toJSON AllocNone = String "none"

604+

605+instance FromJSON AllocationPolicy where

606+ parseJSON = withText "AllocationPolicy" parse

607+ where parse "all" = pure AllocAll

608+ parse "primaries" = pure AllocPrimaries

609+ parse "new_primaries" = pure AllocNewPrimaries

610+ parse "none" = pure AllocNone

611+ parse t = fail ("Invlaid AllocationPolicy: " <> show t)

612+

358{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk

613{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk

359 operation index, create, delete, and update. 'BulkIndex' behaves like an

614 operation index, create, delete, and update. 'BulkIndex' behaves like an

360 "upsert", 'BulkCreate' will fail if a document already exists at the DocId.

615 "upsert", 'BulkCreate' will fail if a document already exists at the DocId.

@@ -401,6 +656,24 @@ data EsResultFound a =

401 , _source :: a }

656 , _source :: a }

402 deriving (Eq, Show)

657 deriving (Eq, Show)

403

658

659+instance (FromJSON a) => FromJSON (EsResult a) where

660+ parseJSON jsonVal@(Object v) = do

661+ found <- v .:? "found" .!= False

662+ fr <- if found

663+ then parseJSON jsonVal

664+ else return Nothing

665+ EsResult <$> v .: "_index" <*>

666+ v .: "_type" <*>

667+ v .: "_id" <*>

668+ pure fr

669+ parseJSON _ = empty

670+

671+instance (FromJSON a) => FromJSON (EsResultFound a) where

672+ parseJSON (Object v) = EsResultFound <$>

673+ v .: "_version" <*>

674+ v .: "_source"

675+ parseJSON _ = empty

676+

404{-| 'EsError' is the generic type that will be returned when there was a

677{-| 'EsError' is the generic type that will be returned when there was a

405 problem. If you can't parse the expected response, its a good idea to

678 problem. If you can't parse the expected response, its a good idea to

406 try parsing this.

679 try parsing this.

@@ -410,6 +683,12 @@ data EsError =

410 , errorMessage :: Text }

683 , errorMessage :: Text }

411 deriving (Eq, Show)

684 deriving (Eq, Show)

412

685

686+instance FromJSON EsError where

687+ parseJSON (Object v) = EsError <$>

688+ v .: "status" <*>

689+ (v .: "error" <|> (v .: "error" >>= (.: "reason")))

690+ parseJSON _ = empty

691+

413{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response

692{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response

414returned by the ElasticSearch server. If you encounter this error, please

693returned by the ElasticSearch server. If you encounter this error, please

415verify that your domain data types and FromJSON instances are working properly

694verify that your domain data types and FromJSON instances are working properly

@@ -418,8 +697,9 @@ sure that your mappings are correct, then this error may be an indication of an

418incompatibility between Bloodhound and ElasticSearch. Please open a bug report

697incompatibility between Bloodhound and ElasticSearch. Please open a bug report

419and be sure to include the exception body.

698and be sure to include the exception body.

420-}

699-}

421−data EsProtocolException = EsProtocolException { esProtoExBody :: LByteString }

700+newtype EsProtocolException = EsProtocolException

701+ { esProtoExBody :: LByteString

422− deriving (Eq, Show)

702+ } deriving (Eq, Show)

423

703

424instance Exception EsProtocolException

704instance Exception EsProtocolException

425

705

@@ -445,6 +725,13 @@ newtype SearchAliasRouting =

445 SearchAliasRouting (NonEmpty RoutingValue)

725 SearchAliasRouting (NonEmpty RoutingValue)

446 deriving (Eq, Show)

726 deriving (Eq, Show)

447

727

728+instance ToJSON SearchAliasRouting where

729+ toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))

730+

731+instance FromJSON SearchAliasRouting where

732+ parseJSON = withText "SearchAliasRouting" parse

733+ where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)

734+

448newtype IndexAliasRouting =

735newtype IndexAliasRouting =

449 IndexAliasRouting RoutingValue

736 IndexAliasRouting RoutingValue

450 deriving (Eq, Show, ToJSON, FromJSON)

737 deriving (Eq, Show, ToJSON, FromJSON)

@@ -457,6 +744,55 @@ newtype IndexAliasesSummary =

457 IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] }

744 IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] }

458 deriving (Eq, Show)

745 deriving (Eq, Show)

459

746

747+instance FromJSON IndexAliasesSummary where

748+ parseJSON = withObject "IndexAliasesSummary" parse

749+ where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)

750+ go ixn = withObject "index aliases" $ \ia -> do

751+ aliases <- ia .:? "aliases" .!= mempty

752+ forM (HM.toList aliases) $ \(aName, v) -> do

753+ let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))

754+ IndexAliasSummary indexAlias <$> parseJSON v

755+

756+

757+instance ToJSON IndexAliasAction where

758+ toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]

759+ where Object iaObj = toJSON ia

760+ Object optsObj = toJSON opts

761+ toJSON (RemoveAlias ia) = object ["remove" .= iaObj]

762+ where Object iaObj = toJSON ia

763+

764+instance ToJSON IndexAlias where

765+ toJSON IndexAlias {..} = object ["index" .= srcIndex

766+ , "alias" .= indexAlias

767+ ]

768+

769+instance ToJSON IndexAliasCreate where

770+ toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)

771+ where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter

772+ Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting

773+

774+instance ToJSON AliasRouting where

775+ toJSON (AllAliasRouting v) = object ["routing" .= v]

776+ toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)

777+ where prs = [("search_routing" .=) <$> srch

778+ ,("index_routing" .=) <$> idx]

779+

780+instance FromJSON AliasRouting where

781+ parseJSON = withObject "AliasRouting" parse

782+ where parse o = parseAll o <|> parseGranular o

783+ parseAll o = AllAliasRouting <$> o .: "routing"

784+ parseGranular o = do

785+ sr <- o .:? "search_routing"

786+ ir <- o .:? "index_routing"

787+ if isNothing sr && isNothing ir

788+ then fail "Both search_routing and index_routing can't be blank"

789+ else return (GranularAliasRouting sr ir)

790+

791+instance FromJSON IndexAliasCreate where

792+ parseJSON v = withObject "IndexAliasCreate" parse v

793+ where parse o = IndexAliasCreate <$> optional (parseJSON v)

794+ <*> o .:? "filter"

795+

460{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}

796{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}

461data IndexAliasSummary = IndexAliasSummary

797data IndexAliasSummary = IndexAliasSummary

462 { indexAliasSummaryAlias :: IndexAlias

798 { indexAliasSummaryAlias :: IndexAlias

@@ -473,10 +809,32 @@ newtype DocVersion = DocVersion {

473-- | Smart constructor for in-range doc version

809-- | Smart constructor for in-range doc version

474mkDocVersion :: Int -> Maybe DocVersion

810mkDocVersion :: Int -> Maybe DocVersion

475mkDocVersion i

811mkDocVersion i

476− | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =

812+ | i >= docVersionNumber minBound

813+ && i <= docVersionNumber maxBound =

477 Just $ DocVersion i

814 Just $ DocVersion i

478 | otherwise = Nothing

815 | otherwise = Nothing

479

816

817+instance Bounded DocVersion where

818+ minBound = DocVersion 1

819+ maxBound = DocVersion 9200000000000000000 -- 9.2e+18

820+

821+instance Enum DocVersion where

822+ succ x

823+ | x /= maxBound = DocVersion (succ $ docVersionNumber x)

824+ | otherwise = succError "DocVersion"

825+ pred x

826+ | x /= minBound = DocVersion (pred $ docVersionNumber x)

827+ | otherwise = predError "DocVersion"

828+ toEnum i =

829+ fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i

830+ fromEnum = docVersionNumber

831+ enumFrom = boundedEnumFrom

832+ enumFromThen = boundedEnumFromThen

833+

834+instance FromJSON DocVersion where

835+ parseJSON v = do

836+ i <- parseJSON v

837+ maybe (fail "DocVersion out of range") return $ mkDocVersion i

480

838

481{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its

839{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its

482own version numbers instead of ones from ES.

840own version numbers instead of ones from ES.

@@ -576,36 +934,6 @@ newtype TemplateName = TemplateName Text deriving (Eq, Show, ToJSON, FromJSON)

576-}

934-}

577newtype TemplatePattern = TemplatePattern Text deriving (Eq, Show, ToJSON, FromJSON)

935newtype TemplatePattern = TemplatePattern Text deriving (Eq, Show, ToJSON, FromJSON)

578

936

579−-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings

580−instance FromJSON ReplicaCount where

581− parseJSON v = parseAsInt v

582− <|> parseAsString v

583− where parseAsInt = fmap ReplicaCount . parseJSON

584− parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)

585−

586−instance FromJSON ShardCount where

587− parseJSON v = parseAsInt v

588− <|> parseAsString v

589− where parseAsInt = fmap ShardCount . parseJSON

590− parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)

591−

592−instance Bounded DocVersion where

593− minBound = DocVersion 1

594− maxBound = DocVersion 9200000000000000000 -- 9.2e+18

595−

596−instance Enum DocVersion where

597− succ x

598− | x /= maxBound = DocVersion (succ $ docVersionNumber x)

599− | otherwise = succError "DocVersion"

600− pred x

601− | x /= minBound = DocVersion (pred $ docVersionNumber x)

602− | otherwise = predError "DocVersion"

603− toEnum i =

604− fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i

605− fromEnum = docVersionNumber

606− enumFrom = boundedEnumFrom

607− enumFromThen = boundedEnumFromThen

608−

609-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.

937-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.

610newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)

938newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)

611

939

@@ -1225,13 +1553,13 @@ data SnapshotRestoreSettings = SnapshotRestoreSettings {

1225 -- revert back to the server default during the restore process.

1553 -- revert back to the server default during the restore process.

1226 } deriving (Eq, Show)

1554 } deriving (Eq, Show)

1227

1555

1228−data SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings {

1556+newtype SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings

1229− repoUpdateVerify :: Bool

1557+ { repoUpdateVerify :: Bool

1230− -- ^ After creation/update, synchronously check that nodes can

1558+ -- ^ After creation/update, synchronously check that nodes can

1231− -- write to this repo. Defaults to True. You may use False if you

1559+ -- write to this repo. Defaults to True. You may use False if you

1232− -- need a faster response and plan on verifying manually later

1560+ -- need a faster response and plan on verifying manually later

1233− -- with 'verifySnapshotRepo'.

1561+ -- with 'verifySnapshotRepo'.

1234− } deriving (Eq, Show)

1562+ } deriving (Eq, Show)

1235

1563

1236

1564

1237-- | Reasonable defaults for repo creation/update

1565-- | Reasonable defaults for repo creation/update

@@ -1271,7 +1599,7 @@ instance SnapshotRepo FsSnapshotRepo where

1271 fromGSnapshotRepo GenericSnapshotRepo {..}

1599 fromGSnapshotRepo GenericSnapshotRepo {..}

1272 | gSnapshotRepoType == fsRepoType = do

1600 | gSnapshotRepoType == fsRepoType = do

1273 let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings

1601 let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings

1274− parseRepo $ do

1602+ parseRepo $

1275 FsSnapshotRepo gSnapshotRepoName <$> o .: "location"

1603 FsSnapshotRepo gSnapshotRepoName <$> o .: "location"

1276 <*> o .:? "compress" .!= False

1604 <*> o .:? "compress" .!= False

1277 <*> o .:? "chunk_size"

1605 <*> o .:? "chunk_size"

@@ -1370,12 +1698,6 @@ data SnapshotInfo = SnapshotInfo {

1370 } deriving (Eq, Show)

1698 } deriving (Eq, Show)

1371

1699

1372

1700

1373−instance FromJSON POSIXMS where

1374− parseJSON = withScientific "POSIXMS" (return . parse)

1375− where parse n =

1376− let n' = truncate n :: Integer

1377− in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))

1378−

1379instance FromJSON SnapshotInfo where

1701instance FromJSON SnapshotInfo where

1380 parseJSON = withObject "SnapshotInfo" parse

1702 parseJSON = withObject "SnapshotInfo" parse

1381 where

1703 where

@@ -1437,7 +1759,8 @@ instance Bounded RRGroupRefNum where

1437-- | Only allows valid group number references (1-9).

1759-- | Only allows valid group number references (1-9).

1438mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum

1760mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum

1439mkRRGroupRefNum i

1761mkRRGroupRefNum i

1440− | i >= (rrGroupRefNum minBound) && i <= (rrGroupRefNum maxBound) =

1762+ | i >= rrGroupRefNum minBound

1763+ && i <= rrGroupRefNum maxBound =

1441 Just $ RRGroupRefNum i

1764 Just $ RRGroupRefNum i

1442 | otherwise = Nothing

1765 | otherwise = Nothing

1443

1766

@@ -1471,9 +1794,9 @@ defaultSnapshotRestoreSettings = SnapshotRestoreSettings {

1471-- | Index settings that can be overridden. The docs only mention you

1794-- | Index settings that can be overridden. The docs only mention you

1472-- can update number of replicas, but there may be more. You

1795-- can update number of replicas, but there may be more. You

1473-- definitely cannot override shard count.

1796-- definitely cannot override shard count.

1474−data RestoreIndexSettings = RestoreIndexSettings {

1797+newtype RestoreIndexSettings = RestoreIndexSettings

1475− restoreOverrideReplicas :: Maybe ReplicaCount

1798+ { restoreOverrideReplicas :: Maybe ReplicaCount

1476− } deriving (Eq, Show)

1799+ } deriving (Eq, Show)

1477

1800

1478

1801

1479instance ToJSON RestoreIndexSettings where

1802instance ToJSON RestoreIndexSettings where

@@ -1813,7 +2136,7 @@ instance FromJSON NodeBreakersStats where

1813 <*> o .: "fielddata"

2136 <*> o .: "fielddata"

1814

2137

1815parseNodeStats :: FullNodeId -> Object -> Parser NodeStats

2138parseNodeStats :: FullNodeId -> Object -> Parser NodeStats

1816−parseNodeStats fnid o = do

2139+parseNodeStats fnid o =

1817 NodeStats <$> o .: "name"

2140 NodeStats <$> o .: "name"

1818 <*> pure fnid

2141 <*> pure fnid

1819 <*> o .:? "breakers"

2142 <*> o .:? "breakers"

@@ -1871,7 +2194,7 @@ instance FromJSON BoundTransportAddress where

1871instance FromJSON NodeOSInfo where

2194instance FromJSON NodeOSInfo where

1872 parseJSON = withObject "NodeOSInfo" parse

2195 parseJSON = withObject "NodeOSInfo" parse

1873 where

2196 where

1874− parse o = do

2197+ parse o =

1875 NodeOSInfo <$> (unMS <$> o .: "refresh_interval_in_millis")

2198 NodeOSInfo <$> (unMS <$> o .: "refresh_interval_in_millis")

1876 <*> o .: "name"

2199 <*> o .: "name"

1877 <*> o .: "arch"

2200 <*> o .: "arch"

@@ -1990,6 +2313,16 @@ data Interval = Year

1990 | Minute

2313 | Minute

1991 | Second deriving (Eq, Show)

2314 | Second deriving (Eq, Show)

1992

2315

2316+instance ToJSON Interval where

2317+ toJSON Year = "year"

2318+ toJSON Quarter = "quarter"

2319+ toJSON Month = "month"

2320+ toJSON Week = "week"

2321+ toJSON Day = "day"

2322+ toJSON Hour = "hour"

2323+ toJSON Minute = "minute"

2324+ toJSON Second = "second"

2325+

1993parseStringInterval :: (Monad m) => String -> m NominalDiffTime

2326parseStringInterval :: (Monad m) => String -> m NominalDiffTime

1994parseStringInterval s = case span isNumber s of

2327parseStringInterval s = case span isNumber s of

1995 ("", _) -> fail "Invalid interval"

2328 ("", _) -> fail "Invalid interval"

src/Database/V5/Bloodhound/Internal/Newtypes.hs+24−5

@@ -146,6 +146,12 @@ newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, FromJSON, ToJS

146-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ

147newtype POSIXMS = POSIXMS { posixMS :: UTCTime }

148

149+instance FromJSON POSIXMS where

150+ parseJSON = withScientific "POSIXMS" (return . parse)

151+ where parse n =

152+ let n' = truncate n :: Integer

153+ in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))

154+

149newtype Boost =

155newtype Boost =

150 Boost Double

156 Boost Double

151 deriving (Eq, Show, ToJSON, FromJSON)

157 deriving (Eq, Show, ToJSON, FromJSON)

@@ -154,15 +160,28 @@ newtype BoostTerms =

154 BoostTerms Double

160 BoostTerms Double

155 deriving (Eq, Show, ToJSON, FromJSON)

161 deriving (Eq, Show, ToJSON, FromJSON)

156

162

163+{-| 'ReplicaCount' is part of 'IndexSettings' -}

164+newtype ReplicaCount =

165+ ReplicaCount Int

166+ deriving (Eq, Show, ToJSON)

167+

157{-| 'ShardCount' is part of 'IndexSettings' -}

168{-| 'ShardCount' is part of 'IndexSettings' -}

158newtype ShardCount =

169newtype ShardCount =

159 ShardCount Int

170 ShardCount Int

160 deriving (Eq, Show, ToJSON)

171 deriving (Eq, Show, ToJSON)

161

172

162−{-| 'ReplicaCount' is part of 'IndexSettings' -}

173+-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings

163−newtype ReplicaCount =

174+instance FromJSON ReplicaCount where

164− ReplicaCount Int

175+ parseJSON v = parseAsInt v

165− deriving (Eq, Show, ToJSON)

176+ <|> parseAsString v

177+ where parseAsInt = fmap ReplicaCount . parseJSON

178+ parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)

179+

180+instance FromJSON ShardCount where

181+ parseJSON v = parseAsInt v

182+ <|> parseAsString v

183+ where parseAsInt = fmap ShardCount . parseJSON

184+ parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)

166

185

167{-| 'IndexName' is used to describe which index to query/create/delete -}

186{-| 'IndexName' is used to describe which index to query/create/delete -}

168newtype IndexName =

187newtype IndexName =

@@ -195,7 +214,7 @@ unMS (MS t) = t

195instance FromJSON MS where

214instance FromJSON MS where

196 parseJSON = withScientific "MS" (return . MS . parse)

215 parseJSON = withScientific "MS" (return . MS . parse)

197 where

216 where

198− parse n = fromInteger ((truncate n) * 1000)

217+ parse n = fromInteger (truncate n * 1000)

199

218

200newtype TokenFilter =

219newtype TokenFilter =

201 TokenFilter Text deriving (Eq, Show, FromJSON, ToJSON)

220 TokenFilter Text deriving (Eq, Show, FromJSON, ToJSON)

src/Database/V5/Bloodhound/Internal/Query.hs+72−29

@@ -435,6 +435,10 @@ data GeoPoint =

435 GeoPoint { geoField :: FieldName

436 , latLon :: LatLon} deriving (Eq, Show)

437

438+instance ToJSON GeoPoint where

439+ toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =

440+ object [ geoPointField .= geoPointLatLon ]

441+

438data DistanceUnit = Miles

442data DistanceUnit = Miles

439 | Yards

443 | Yards

440 | Feet

444 | Feet

@@ -882,7 +886,8 @@ instance FromJSON QueryStringQuery where

882instance ToJSON RangeQuery where

886instance ToJSON RangeQuery where

883 toJSON (RangeQuery (FieldName fieldName) range boost) =

887 toJSON (RangeQuery (FieldName fieldName) range boost) =

884 object [ fieldName .= object conjoined ]

888 object [ fieldName .= object conjoined ]

889+ where

885− where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)

890+ conjoined = ("boost" .= boost) : rangeValueToPair range

886

891

887instance FromJSON RangeQuery where

892instance FromJSON RangeQuery where

888 parseJSON = withObject "RangeQuery" parse

893 parseJSON = withObject "RangeQuery" parse

@@ -891,38 +896,76 @@ instance FromJSON RangeQuery where

891 <$> parseJSON (Object o)

896 <$> parseJSON (Object o)

892 <*> o .: "boost"

897 <*> o .: "boost"

893

898

899+parseRangeValue :: ( FromJSON t4

900+ , FromJSON t3

901+ , FromJSON t2

902+ , FromJSON t1

903+ )

904+ => (t3 -> t5)

905+ -> (t1 -> t6)

906+ -> (t4 -> t7)

907+ -> (t2 -> t8)

908+ -> (t5 -> t6 -> b)

909+ -> (t7 -> t6 -> b)

910+ -> (t5 -> t8 -> b)

911+ -> (t7 -> t8 -> b)

912+ -> (t5 -> b)

913+ -> (t6 -> b)

914+ -> (t7 -> b)

915+ -> (t8 -> b)

916+ -> Parser b

917+ -> Object

918+ -> Parser b

919+parseRangeValue mkGt mkLt mkGte mkLte

920+ fGtLt fGteLt fGtLte fGteLte

921+ fGt fLt fGte fLte nada o = do

922+ lt <- o .:? "lt"

923+ lte <- o .:? "lte"

924+ gt <- o .:? "gt"

925+ gte <- o .:? "gte"

926+ case (lt, lte, gt, gte) of

927+ (Just a, _, Just b, _) ->

928+ return (fGtLt (mkGt b) (mkLt a))

929+ (Just a, _, _, Just b) ->

930+ return (fGteLt (mkGte b) (mkLt a))

931+ (_, Just a, Just b, _) ->

932+ return (fGtLte (mkGt b) (mkLte a))

933+ (_, Just a, _, Just b) ->

934+ return (fGteLte (mkGte b) (mkLte a))

935+ (_, _, Just a, _) ->

936+ return (fGt (mkGt a))

937+ (Just a, _, _, _) ->

938+ return (fLt (mkLt a))

939+ (_, _, _, Just a) ->

940+ return (fGte (mkGte a))

941+ (_, Just a, _, _) ->

942+ return (fLte (mkLte a))

943+ (Nothing, Nothing, Nothing, Nothing) ->

944+ nada

945+

946+

894instance FromJSON RangeValue where

947instance FromJSON RangeValue where

895 parseJSON = withObject "RangeValue" parse

948 parseJSON = withObject "RangeValue" parse

896 where parse o = parseDate o

949 where parse o = parseDate o

897 <|> parseDouble o

950 <|> parseDouble o

898− parseDate o = do lt <- o .:? "lt"

951+ parseDate o =

899− lte <- o .:? "lte"

952+ parseRangeValue

900− gt <- o .:? "gt"

953+ GreaterThanD LessThanD

901− gte <- o .:? "gte"

954+ GreaterThanEqD LessThanEqD

902− case (lt, lte, gt, gte) of

955+ RangeDateGtLt RangeDateGteLt

903− (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))

956+ RangeDateGtLte RangeDateGteLte

904− (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))

957+ RangeDateGt RangeDateLt

905− (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))

958+ RangeDateGte RangeDateLte

906− (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))

959+ mzero o

907− (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))

908− (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))

909− (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))

910− (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))

911− (Nothing, Nothing, Nothing, Nothing) -> mzero

912− parseDouble o = do lt <- o .:? "lt"

960+ parseDouble o =

913− lte <- o .:? "lte"

961+ parseRangeValue

914− gt <- o .:? "gt"

962+ GreaterThan LessThan

915− gte <- o .:? "gte"

963+ GreaterThanEq LessThanEq

916− case (lt, lte, gt, gte) of

964+ RangeDoubleGtLt RangeDoubleGteLt

917− (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))

965+ RangeDoubleGtLte RangeDoubleGteLte

918− (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))

919− (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))

920− (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))

921− (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))

922− (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))

966+ RangeDoubleGt RangeDoubleLt

923− (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))

924− (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))

967+ RangeDoubleGte RangeDoubleLte

925− (Nothing, Nothing, Nothing, Nothing) -> mzero

968+ mzero o

926

969

927instance ToJSON PrefixQuery where

970instance ToJSON PrefixQuery where

928 toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =

971 toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =

src/Database/V5/Bloodhound/Types.hs+317−659

@@ -414,7 +414,6 @@ module Database.V5.Bloodhound.Types

414

415import Bloodhound.Import

416

417−import qualified Data.Traversable as DT

418import qualified Data.HashMap.Strict as HM

417import qualified Data.HashMap.Strict as HM

419import qualified Data.Map.Strict as M

418import qualified Data.Map.Strict as M

420import qualified Data.Text as T

419import qualified Data.Text as T

@@ -424,7 +423,6 @@ import Database.V5.Bloodhound.Internal.Analysis

424import Database.V5.Bloodhound.Internal.Client

423import Database.V5.Bloodhound.Internal.Client

425import Database.V5.Bloodhound.Internal.Newtypes

424import Database.V5.Bloodhound.Internal.Newtypes

426import Database.V5.Bloodhound.Internal.Query

425import Database.V5.Bloodhound.Internal.Query

427−import Database.V5.Bloodhound.Internal.StringlyTyped

428

426

429{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order

427{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order

430 dependent with later sorts acting as tie-breakers for earlier sorts.

428 dependent with later sorts acting as tie-breakers for earlier sorts.

@@ -438,8 +436,26 @@ type Sort = [SortSpec]

438

436

439<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>

437<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>

440-}

438-}

439+data SortSpec =

441−data SortSpec = DefaultSortSpec DefaultSort

440+ DefaultSortSpec DefaultSort

442− | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Show)

441+ | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit

442+ deriving (Eq, Show)

443+

444+instance ToJSON SortSpec where

445+ toJSON (DefaultSortSpec

446+ (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped

447+ dsSortMode dsMissingSort dsNestedFilter)) =

448+ object [dsSortFieldName .= omitNulls base] where

449+ base = [ "order" .= dsSortOrder

450+ , "unmapped_type" .= dsIgnoreUnmapped

451+ , "mode" .= dsSortMode

452+ , "missing" .= dsMissingSort

453+ , "nested_filter" .= dsNestedFilter ]

454+

455+ toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =

456+ object [ "unit" .= units

457+ , field .= gdsLatLon

458+ , "order" .= gdsSortOrder ]

443

459

444{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a

460{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a

445 'mkSort' convenience function for when you want to specify only the most

461 'mkSort' convenience function for when you want to specify only the most

@@ -466,6 +482,10 @@ data DefaultSort =

466data SortOrder = Ascending

482data SortOrder = Ascending

467 | Descending deriving (Eq, Show)

483 | Descending deriving (Eq, Show)

468

484

485+instance ToJSON SortOrder where

486+ toJSON Ascending = String "asc"

487+ toJSON Descending = String "desc"

488+

469{-| 'Missing' prescribes how to handle missing fields. A missing field can be

489{-| 'Missing' prescribes how to handle missing fields. A missing field can be

470 sorted last, first, or using a custom value as a substitute.

490 sorted last, first, or using a custom value as a substitute.

471

491

@@ -475,6 +495,11 @@ data Missing = LastMissing

475 | FirstMissing

495 | FirstMissing

476 | CustomMissing Text deriving (Eq, Show)

496 | CustomMissing Text deriving (Eq, Show)

477

497

498+instance ToJSON Missing where

499+ toJSON LastMissing = String "_last"

500+ toJSON FirstMissing = String "_first"

501+ toJSON (CustomMissing txt) = String txt

502+

478{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.

503{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.

479

504

480http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option

505http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option

@@ -484,6 +509,12 @@ data SortMode = SortMin

484 | SortSum

509 | SortSum

485 | SortAvg deriving (Eq, Show)

510 | SortAvg deriving (Eq, Show)

486

511

512+instance ToJSON SortMode where

513+ toJSON SortMin = String "min"

514+ toJSON SortMax = String "max"

515+ toJSON SortSum = String "sum"

516+ toJSON SortAvg = String "avg"

517+

487{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so

518{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so

488 that you can concisely describe the usual kind of 'SortSpec's you want.

519 that you can concisely describe the usual kind of 'SortSpec's you want.

489-}

520-}

@@ -590,6 +621,10 @@ data HighlightEncoder = DefaultEncoder

590 | HTMLEncoder

621 | HTMLEncoder

591 deriving (Eq, Show)

622 deriving (Eq, Show)

592

623

624+instance ToJSON HighlightEncoder where

625+ toJSON DefaultEncoder = String "default"

626+ toJSON HTMLEncoder = String "html"

627+

593-- NOTE: Should the tags use some kind of HTML type, rather than Text?

628-- NOTE: Should the tags use some kind of HTML type, rather than Text?

594data HighlightTag =

629data HighlightTag =

595 TagSchema Text

630 TagSchema Text

@@ -609,6 +644,18 @@ data SearchResult a =

609 }

644 }

610 deriving (Eq, Show)

645 deriving (Eq, Show)

611

646

647+

648+instance (FromJSON a) => FromJSON (SearchResult a) where

649+ parseJSON (Object v) = SearchResult <$>

650+ v .: "took" <*>

651+ v .: "timed_out" <*>

652+ v .: "_shards" <*>

653+ v .: "hits" <*>

654+ v .:? "aggregations" <*>

655+ v .:? "_scroll_id" <*>

656+ v .:? "suggest"

657+ parseJSON _ = empty

658+

612newtype ScrollId =

659newtype ScrollId =

613 ScrollId Text

660 ScrollId Text

614 deriving (Eq, Show, Ord, ToJSON, FromJSON)

661 deriving (Eq, Show, Ord, ToJSON, FromJSON)

@@ -618,6 +665,14 @@ data SearchHits a =

618 , maxScore :: Score

665 , maxScore :: Score

619 , hits :: [Hit a] } deriving (Eq, Show)

666 , hits :: [Hit a] } deriving (Eq, Show)

620

667

668+

669+instance (FromJSON a) => FromJSON (SearchHits a) where

670+ parseJSON (Object v) = SearchHits <$>

671+ v .: "total" <*>

672+ v .: "max_score" <*>

673+ v .: "hits"

674+ parseJSON _ = empty

675+

621instance Semigroup (SearchHits a) where

676instance Semigroup (SearchHits a) where

622 (SearchHits ta ma ha) <> (SearchHits tb mb hb) = SearchHits (ta + tb) (max ma mb) (ha <> hb)

677 (SearchHits ta ma ha) <> (SearchHits tb mb hb) = SearchHits (ta + tb) (max ma mb) (ha <> hb)

623

678

@@ -634,12 +689,26 @@ data Hit a =

634 , hitFields :: Maybe HitFields

689 , hitFields :: Maybe HitFields

635 , hitHighlight :: Maybe HitHighlight } deriving (Eq, Show)

690 , hitHighlight :: Maybe HitHighlight } deriving (Eq, Show)

636

691

692+instance (FromJSON a) => FromJSON (Hit a) where

693+ parseJSON (Object v) = Hit <$>

694+ v .: "_index" <*>

695+ v .: "_type" <*>

696+ v .: "_id" <*>

697+ v .: "_score" <*>

698+ v .:? "_source" <*>

699+ v .:? "fields" <*>

700+ v .:? "highlight"

701+ parseJSON _ = empty

702+

637newtype HitFields =

703newtype HitFields =

638 HitFields (M.Map Text [Value])

704 HitFields (M.Map Text [Value])

639 deriving (Eq, Show)

705 deriving (Eq, Show)

640

706

641−type HitHighlight = M.Map Text [Text]

707+instance FromJSON HitFields where

708+ parseJSON x

709+ = HitFields <$> parseJSON x

642

710

711+type HitHighlight = M.Map Text [Text]

643

712

644type Aggregations = M.Map Text Aggregation

713type Aggregations = M.Map Text Aggregation

645

714

@@ -649,21 +718,43 @@ emptyAggregations = M.empty

649mkAggregations :: Text -> Aggregation -> Aggregations

718mkAggregations :: Text -> Aggregation -> Aggregations

650mkAggregations name aggregation = M.insert name aggregation emptyAggregations

719mkAggregations name aggregation = M.insert name aggregation emptyAggregations

651

720

652−data TermOrder = TermOrder{ termSortField :: Text

721+data TermOrder = TermOrder

722+ { termSortField :: Text

653− , termSortOrder :: SortOrder } deriving (Eq, Show)

723+ , termSortOrder :: SortOrder } deriving (Eq, Show)

724+

725+instance ToJSON TermOrder where

726+ toJSON (TermOrder termSortField termSortOrder) =

727+ object [termSortField .= termSortOrder]

654

728

655data TermInclusion = TermInclusion Text

729data TermInclusion = TermInclusion Text

656 | TermPattern Text Text deriving (Eq, Show)

730 | TermPattern Text Text deriving (Eq, Show)

657

731

732+instance ToJSON TermInclusion where

733+ toJSON (TermInclusion x) = toJSON x

734+ toJSON (TermPattern pattern flags) =

735+ omitNulls [ "pattern" .= pattern

736+ , "flags" .= flags]

737+

658data CollectionMode = BreadthFirst

738data CollectionMode = BreadthFirst

659 | DepthFirst deriving (Eq, Show)

739 | DepthFirst deriving (Eq, Show)

660

740

741+instance ToJSON CollectionMode where

742+ toJSON BreadthFirst = "breadth_first"

743+ toJSON DepthFirst = "depth_first"

744+

661data ExecutionHint = Ordinals

745data ExecutionHint = Ordinals

662 | GlobalOrdinals

746 | GlobalOrdinals

663 | GlobalOrdinalsHash

747 | GlobalOrdinalsHash

664 | GlobalOrdinalsLowCardinality

748 | GlobalOrdinalsLowCardinality

665 | Map deriving (Eq, Show)

749 | Map deriving (Eq, Show)

666

750

751+instance ToJSON ExecutionHint where

752+ toJSON Ordinals = "ordinals"

753+ toJSON GlobalOrdinals = "global_ordinals"

754+ toJSON GlobalOrdinalsHash = "global_ordinals_hash"

755+ toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"

756+ toJSON Map = "map"

757+

667data Aggregation = TermsAgg TermsAggregation

758data Aggregation = TermsAgg TermsAggregation

668 | CardinalityAgg CardinalityAggregation

759 | CardinalityAgg CardinalityAggregation

669 | DateHistogramAgg DateHistogramAggregation

760 | DateHistogramAgg DateHistogramAggregation

@@ -675,6 +766,67 @@ data Aggregation = TermsAgg TermsAggregation

675 | StatsAgg StatisticsAggregation

766 | StatsAgg StatisticsAggregation

676 deriving (Eq, Show)

767 deriving (Eq, Show)

677

768

769+instance ToJSON Aggregation where

770+ toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =

771+ omitNulls ["terms" .= omitNulls [ toJSON' term,

772+ "include" .= include,

773+ "exclude" .= exclude,

774+ "order" .= order,

775+ "min_doc_count" .= minDocCount,

776+ "size" .= size,

777+ "shard_size" .= shardSize,

778+ "collect_mode" .= collectMode,

779+ "execution_hint" .= executionHint

780+ ],

781+ "aggs" .= termAggs ]

782+ where

783+ toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }

784+

785+ toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =

786+ object ["cardinality" .= omitNulls [ "field" .= field,

787+ "precisionThreshold" .= precisionThreshold

788+ ]

789+ ]

790+

791+ toJSON (DateHistogramAgg

792+ (DateHistogramAggregation field interval format

793+ preZone postZone preOffset postOffset dateHistoAggs)) =

794+ omitNulls ["date_histogram" .= omitNulls [ "field" .= field,

795+ "interval" .= interval,

796+ "format" .= format,

797+ "pre_zone" .= preZone,

798+ "post_zone" .= postZone,

799+ "pre_offset" .= preOffset,

800+ "post_offset" .= postOffset

801+ ],

802+ "aggs" .= dateHistoAggs ]

803+ toJSON (ValueCountAgg a) = object ["value_count" .= v]

804+ where v = case a of

805+ (FieldValueCount (FieldName n)) ->

806+ object ["field" .= n]

807+ (ScriptValueCount s) ->

808+ object ["script" .= s]

809+ toJSON (FilterAgg (FilterAggregation filt ags)) =

810+ omitNulls [ "filter" .= filt

811+ , "aggs" .= ags]

812+ toJSON (DateRangeAgg a) = object [ "date_range" .= a

813+ ]

814+ toJSON (MissingAgg (MissingAggregation{..})) =

815+ object ["missing" .= object ["field" .= maField]]

816+

817+ toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =

818+ omitNulls ["top_hits" .= omitNulls [ "size" .= msize

819+ , "from" .= mfrom

820+ , "sort" .= msort

821+ ]

822+ ]

823+

824+ toJSON (StatsAgg (StatisticsAggregation typ field)) =

825+ object [stType .= omitNulls [ "field" .= field ]]

826+ where

827+ stType | typ == Basic = "stats"

828+ | otherwise = "extended_stats"

829+

678data TopHitsAggregation = TopHitsAggregation

830data TopHitsAggregation = TopHitsAggregation

679 { taFrom :: Maybe From

831 { taFrom :: Maybe From

680 , taSize :: Maybe Size

832 , taSize :: Maybe Size

@@ -685,17 +837,18 @@ data MissingAggregation = MissingAggregation

685 { maField :: Text

837 { maField :: Text

686 } deriving (Eq, Show)

838 } deriving (Eq, Show)

687

839

688−data TermsAggregation = TermsAggregation { term :: Either Text Text

840+data TermsAggregation = TermsAggregation

841+ { term :: Either Text Text

689− , termInclude :: Maybe TermInclusion

842+ , termInclude :: Maybe TermInclusion

690− , termExclude :: Maybe TermInclusion

843+ , termExclude :: Maybe TermInclusion

691− , termOrder :: Maybe TermOrder

844+ , termOrder :: Maybe TermOrder

692− , termMinDocCount :: Maybe Int

845+ , termMinDocCount :: Maybe Int

693− , termSize :: Maybe Int

846+ , termSize :: Maybe Int

694− , termShardSize :: Maybe Int

847+ , termShardSize :: Maybe Int

695− , termCollectMode :: Maybe CollectionMode

848+ , termCollectMode :: Maybe CollectionMode

696− , termExecutionHint :: Maybe ExecutionHint

849+ , termExecutionHint :: Maybe ExecutionHint

697− , termAggs :: Maybe Aggregations

850+ , termAggs :: Maybe Aggregations

698− } deriving (Eq, Show)

851+ } deriving (Eq, Show)

699

852

700data CardinalityAggregation = CardinalityAggregation

853data CardinalityAggregation = CardinalityAggregation

701 { cardinalityField :: FieldName,

854 { cardinalityField :: FieldName,

@@ -720,17 +873,43 @@ data DateRangeAggregation = DateRangeAggregation

720 , draRanges :: NonEmpty DateRangeAggRange

873 , draRanges :: NonEmpty DateRangeAggRange

721 } deriving (Eq, Show)

874 } deriving (Eq, Show)

722

875

876+instance ToJSON DateRangeAggregation where

877+ toJSON DateRangeAggregation {..} =

878+ omitNulls [ "field" .= draField

879+ , "format" .= draFormat

880+ , "ranges" .= toList draRanges

881+ ]

882+

723data DateRangeAggRange =

883data DateRangeAggRange =

724 DateRangeFrom DateMathExpr

884 DateRangeFrom DateMathExpr

725 | DateRangeTo DateMathExpr

885 | DateRangeTo DateMathExpr

726 | DateRangeFromAndTo DateMathExpr DateMathExpr

886 | DateRangeFromAndTo DateMathExpr DateMathExpr

727 deriving (Eq, Show)

887 deriving (Eq, Show)

728

888

889+instance ToJSON DateRangeAggRange where

890+ toJSON (DateRangeFrom e) = object [ "from" .= e ]

891+ toJSON (DateRangeTo e) = object [ "to" .= e ]

892+ toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]

893+

729-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.

894-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.

730data DateMathExpr =

895data DateMathExpr =

731 DateMathExpr DateMathAnchor [DateMathModifier]

896 DateMathExpr DateMathAnchor [DateMathModifier]

732 deriving (Eq, Show)

897 deriving (Eq, Show)

733

898

899+instance ToJSON DateMathExpr where

900+ toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))

901+ where fmtA DMNow = "now"

902+ fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"

903+ fmtMod (AddTime n u) = "+" <> showText n <> fmtU u

904+ fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u

905+ fmtMod (RoundDownTo u) = "/" <> fmtU u

906+ fmtU DMYear = "y"

907+ fmtU DMMonth = "M"

908+ fmtU DMWeek = "w"

909+ fmtU DMDay = "d"

910+ fmtU DMHour = "h"

911+ fmtU DMMinute = "m"

912+ fmtU DMSecond = "s"

734

913

735-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.

914-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.

736data DateMathAnchor =

915data DateMathAnchor =

@@ -796,124 +975,6 @@ mkStatsAggregation = StatisticsAggregation Basic

796mkExtendedStatsAggregation :: FieldName -> StatisticsAggregation

975mkExtendedStatsAggregation :: FieldName -> StatisticsAggregation

797mkExtendedStatsAggregation = StatisticsAggregation Extended

976mkExtendedStatsAggregation = StatisticsAggregation Extended

798

977

799−instance ToJSON TermOrder where

800− toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]

801−

802−instance ToJSON TermInclusion where

803− toJSON (TermInclusion x) = toJSON x

804− toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,

805− "flags" .= flags]

806−

807−instance ToJSON CollectionMode where

808− toJSON BreadthFirst = "breadth_first"

809− toJSON DepthFirst = "depth_first"

810−

811−instance ToJSON ExecutionHint where

812− toJSON Ordinals = "ordinals"

813− toJSON GlobalOrdinals = "global_ordinals"

814− toJSON GlobalOrdinalsHash = "global_ordinals_hash"

815− toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"

816− toJSON Map = "map"

817−

818−instance ToJSON Interval where

819− toJSON Year = "year"

820− toJSON Quarter = "quarter"

821− toJSON Month = "month"

822− toJSON Week = "week"

823− toJSON Day = "day"

824− toJSON Hour = "hour"

825− toJSON Minute = "minute"

826− toJSON Second = "second"

827−

828−instance ToJSON Aggregation where

829− toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =

830− omitNulls ["terms" .= omitNulls [ toJSON' term,

831− "include" .= include,

832− "exclude" .= exclude,

833− "order" .= order,

834− "min_doc_count" .= minDocCount,

835− "size" .= size,

836− "shard_size" .= shardSize,

837− "collect_mode" .= collectMode,

838− "execution_hint" .= executionHint

839− ],

840− "aggs" .= termAggs ]

841− where

842− toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }

843−

844− toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =

845− object ["cardinality" .= omitNulls [ "field" .= field,

846− "precisionThreshold" .= precisionThreshold

847− ]

848− ]

849−

850− toJSON (DateHistogramAgg

851− (DateHistogramAggregation field interval format

852− preZone postZone preOffset postOffset dateHistoAggs)) =

853− omitNulls ["date_histogram" .= omitNulls [ "field" .= field,

854− "interval" .= interval,

855− "format" .= format,

856− "pre_zone" .= preZone,

857− "post_zone" .= postZone,

858− "pre_offset" .= preOffset,

859− "post_offset" .= postOffset

860− ],

861− "aggs" .= dateHistoAggs ]

862− toJSON (ValueCountAgg a) = object ["value_count" .= v]

863− where v = case a of

864− (FieldValueCount (FieldName n)) ->

865− object ["field" .= n]

866− (ScriptValueCount s) ->

867− object ["script" .= s]

868− toJSON (FilterAgg (FilterAggregation filt ags)) =

869− omitNulls [ "filter" .= filt

870− , "aggs" .= ags]

871− toJSON (DateRangeAgg a) = object [ "date_range" .= a

872− ]

873− toJSON (MissingAgg (MissingAggregation{..})) =

874− object ["missing" .= object ["field" .= maField]]

875−

876− toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =

877− omitNulls ["top_hits" .= omitNulls [ "size" .= msize

878− , "from" .= mfrom

879− , "sort" .= msort

880− ]

881− ]

882−

883− toJSON (StatsAgg (StatisticsAggregation typ field)) =

884− object [stType .= omitNulls [ "field" .= field ]]

885− where

886− stType | typ == Basic = "stats"

887− | otherwise = "extended_stats"

888−

889−instance ToJSON DateRangeAggregation where

890− toJSON DateRangeAggregation {..} =

891− omitNulls [ "field" .= draField

892− , "format" .= draFormat

893− , "ranges" .= toList draRanges

894− ]

895−

896−instance ToJSON DateRangeAggRange where

897− toJSON (DateRangeFrom e) = object [ "from" .= e ]

898− toJSON (DateRangeTo e) = object [ "to" .= e ]

899− toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]

900−

901−instance ToJSON DateMathExpr where

902− toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))

903− where fmtA DMNow = "now"

904− fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"

905− fmtMod (AddTime n u) = "+" <> showText n <> fmtU u

906− fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u

907− fmtMod (RoundDownTo u) = "/" <> fmtU u

908− fmtU DMYear = "y"

909− fmtU DMMonth = "M"

910− fmtU DMWeek = "w"

911− fmtU DMDay = "d"

912− fmtU DMHour = "h"

913− fmtU DMMinute = "m"

914− fmtU DMSecond = "s"

915−

916−

917type AggregationResults = M.Map Text Value

978type AggregationResults = M.Map Text Value

918

979

919class BucketAggregation a where

980class BucketAggregation a where

@@ -921,83 +982,48 @@ class BucketAggregation a where

921 docCount :: a -> Int

982 docCount :: a -> Int

922 aggs :: a -> Maybe AggregationResults

983 aggs :: a -> Maybe AggregationResults

923

984

924−

925−data Bucket a = Bucket { buckets :: [a]} deriving (Read, Show)

985+data Bucket a = Bucket

926−

986+ { buckets :: [a]

927−data BucketValue = TextValue Text

928− | ScientificValue Scientific

929− | BoolValue Bool deriving (Read, Show)

930−

931−data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)

932−

933−data TopHitResult a = TopHitResult { tarHits :: (SearchHits a)

934− } deriving Show

935−

936−data TermsResult = TermsResult { termKey :: BucketValue

937− , termsDocCount :: Int

938− , termsAggs :: Maybe AggregationResults } deriving (Read, Show)

987+ } deriving (Read, Show)

939−

940−data DateHistogramResult = DateHistogramResult { dateKey :: Int

941− , dateKeyStr :: Maybe Text

942− , dateDocCount :: Int

943− , dateHistogramAggs :: Maybe AggregationResults } deriving (Read, Show)

944−

945−data DateRangeResult =

946− DateRangeResult { dateRangeKey :: Text

947− , dateRangeFrom :: Maybe UTCTime

948− , dateRangeFromAsString :: Maybe Text

949− , dateRangeTo :: Maybe UTCTime

950− , dateRangeToAsString :: Maybe Text

951− , dateRangeDocCount :: Int

952− , dateRangeAggs :: Maybe AggregationResults }

953− deriving (Eq, Show)

954−

955−toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)

956−toTerms = toAggResult

957−

958−toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)

959−toDateHistogram = toAggResult

960−

961−toMissing :: Text -> AggregationResults -> Maybe MissingResult

962−toMissing = toAggResult

963−

964−toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)

965−toTopHits = toAggResult

966−

967−toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a

968−toAggResult t a = M.lookup t a >>= deserialize

969− where deserialize = parseMaybe parseJSON

970−

971−instance BucketAggregation TermsResult where

972− key = termKey

973− docCount = termsDocCount

974− aggs = termsAggs

975−

976−instance BucketAggregation DateHistogramResult where

977− key = TextValue . showText . dateKey

978− docCount = dateDocCount

979− aggs = dateHistogramAggs

980−

981−instance BucketAggregation DateRangeResult where

982− key = TextValue . dateRangeKey

983− docCount = dateRangeDocCount

984− aggs = dateRangeAggs

985

988

986instance (FromJSON a) => FromJSON (Bucket a) where

989instance (FromJSON a) => FromJSON (Bucket a) where

987 parseJSON (Object v) = Bucket <$>

990 parseJSON (Object v) = Bucket <$>

988 v .: "buckets"

991 v .: "buckets"

989 parseJSON _ = mempty

992 parseJSON _ = mempty

990

993

994+data BucketValue = TextValue Text

995+ | ScientificValue Scientific

996+ | BoolValue Bool deriving (Read, Show)

997+

991instance FromJSON BucketValue where

998instance FromJSON BucketValue where

992 parseJSON (String t) = return $ TextValue t

999 parseJSON (String t) = return $ TextValue t

993 parseJSON (Number s) = return $ ScientificValue s

1000 parseJSON (Number s) = return $ ScientificValue s

994 parseJSON (Bool b) = return $ BoolValue b

1001 parseJSON (Bool b) = return $ BoolValue b

995 parseJSON _ = mempty

1002 parseJSON _ = mempty

996

1003

1004+data MissingResult = MissingResult

1005+ { missingDocCount :: Int

1006+ } deriving (Show)

1007+

997instance FromJSON MissingResult where

1008instance FromJSON MissingResult where

998 parseJSON = withObject "MissingResult" parse

1009 parseJSON = withObject "MissingResult" parse

999 where parse v = MissingResult <$> v .: "doc_count"

1010 where parse v = MissingResult <$> v .: "doc_count"

1000

1011

1012+data TopHitResult a = TopHitResult

1013+ { tarHits :: (SearchHits a)

1014+ } deriving Show

1015+

1016+instance (FromJSON a) => FromJSON (TopHitResult a) where

1017+ parseJSON (Object v) = TopHitResult <$>

1018+ v .: "hits"

1019+ parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"

1020+

1021+data TermsResult = TermsResult

1022+ { termKey :: BucketValue

1023+ , termsDocCount :: Int

1024+ , termsAggs :: Maybe AggregationResults

1025+ } deriving (Read, Show)

1026+

1001instance FromJSON TermsResult where

1027instance FromJSON TermsResult where

1002 parseJSON (Object v) = TermsResult <$>

1028 parseJSON (Object v) = TermsResult <$>

1003 v .: "key" <*>

1029 v .: "key" <*>

@@ -1005,6 +1031,18 @@ instance FromJSON TermsResult where

1005 (pure $ getNamedSubAgg v ["key", "doc_count"])

1031 (pure $ getNamedSubAgg v ["key", "doc_count"])

1006 parseJSON _ = mempty

1032 parseJSON _ = mempty

1007

1033

1034+instance BucketAggregation TermsResult where

1035+ key = termKey

1036+ docCount = termsDocCount

1037+ aggs = termsAggs

1038+

1039+data DateHistogramResult = DateHistogramResult

1040+ { dateKey :: Int

1041+ , dateKeyStr :: Maybe Text

1042+ , dateDocCount :: Int

1043+ , dateHistogramAggs :: Maybe AggregationResults

1044+ } deriving (Show)

1045+

1008instance FromJSON DateHistogramResult where

1046instance FromJSON DateHistogramResult where

1009 parseJSON (Object v) = DateHistogramResult <$>

1047 parseJSON (Object v) = DateHistogramResult <$>

1010 v .: "key" <*>

1048 v .: "key" <*>

@@ -1017,6 +1055,21 @@ instance FromJSON DateHistogramResult where

1017 )

1055 )

1018 parseJSON _ = mempty

1056 parseJSON _ = mempty

1019

1057

1058+instance BucketAggregation DateHistogramResult where

1059+ key = TextValue . showText . dateKey

1060+ docCount = dateDocCount

1061+ aggs = dateHistogramAggs

1062+

1063+data DateRangeResult = DateRangeResult

1064+ { dateRangeKey :: Text

1065+ , dateRangeFrom :: Maybe UTCTime

1066+ , dateRangeFromAsString :: Maybe Text

1067+ , dateRangeTo :: Maybe UTCTime

1068+ , dateRangeToAsString :: Maybe Text

1069+ , dateRangeDocCount :: Int

1070+ , dateRangeAggs :: Maybe AggregationResults

1071+ } deriving (Eq, Show)

1072+

1020instance FromJSON DateRangeResult where

1073instance FromJSON DateRangeResult where

1021 parseJSON = withObject "DateRangeResult" parse

1074 parseJSON = withObject "DateRangeResult" parse

1022 where parse v = DateRangeResult <$>

1075 where parse v = DateRangeResult <$>

@@ -1035,10 +1088,26 @@ instance FromJSON DateRangeResult where

1035 ]

1088 ]

1036 )

1089 )

1037

1090

1091+instance BucketAggregation DateRangeResult where

1092+ key = TextValue . dateRangeKey

1093+ docCount = dateRangeDocCount

1094+ aggs = dateRangeAggs

1095+

1096+toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)

1097+toTerms = toAggResult

1098+

1099+toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)

1100+toDateHistogram = toAggResult

1101+

1102+toMissing :: Text -> AggregationResults -> Maybe MissingResult

1103+toMissing = toAggResult

1104+

1038−instance (FromJSON a) => FromJSON (TopHitResult a) where

1105+toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)

1039− parseJSON (Object v) = TopHitResult <$>

1106+toTopHits = toAggResult

1040− v .: "hits"

1107+

1041− parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"

1108+toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a

1109+toAggResult t a = M.lookup t a >>= deserialize

1110+ where deserialize = parseMaybe parseJSON

1042

1111

1043-- Try to get an AggregationResults when we don't know the

1112-- Try to get an AggregationResults when we don't know the

1044-- field name. We filter out the known keys to try to minimize the noise.

1113-- field name. We filter out the known keys to try to minimize the noise.

@@ -1049,339 +1118,6 @@ getNamedSubAgg o knownKeys = maggRes

1049 | HM.null unknownKeys = Nothing

1118 | HM.null unknownKeys = Nothing

1050 | otherwise = Just . M.fromList $ HM.toList unknownKeys

1119 | otherwise = Just . M.fromList $ HM.toList unknownKeys

1051

1120

1052−instance ToJSON GeoPoint where

1053− toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =

1054− object [ geoPointField .= geoPointLatLon ]

1055−

1056−instance FromJSON Status where

1057− parseJSON (Object v) = Status <$>

1058− v .: "name" <*>

1059− v .: "cluster_name" <*>

1060− v .: "cluster_uuid" <*>

1061− v .: "version" <*>

1062− v .: "tagline"

1063− parseJSON _ = empty

1064−

1065−instance ToJSON IndexSettings where

1066− toJSON (IndexSettings s r) = object ["settings" .=

1067− object ["index" .=

1068− object ["number_of_shards" .= s, "number_of_replicas" .= r]

1069− ]

1070− ]

1071−

1072−instance FromJSON IndexSettings where

1073− parseJSON = withObject "IndexSettings" parse

1074− where parse o = do s <- o .: "settings"

1075− i <- s .: "index"

1076− IndexSettings <$> i .: "number_of_shards"

1077− <*> i .: "number_of_replicas"

1078−

1079−instance ToJSON UpdatableIndexSetting where

1080− toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x

1081− toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x

1082− toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)

1083− toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x

1084− toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x

1085− toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x

1086− toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x

1087− toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)

1088− toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x

1089− toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x

1090− toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)

1091− toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)

1092− toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)

1093− toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)

1094− toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)

1095− toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x

1096− toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x

1097− toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x

1098− toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)

1099− toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x

1100− toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x

1101− toJSON (CompressionSetting x) = oPath ("index" :| ["codec"]) x

1102− toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x

1103− toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x

1104− toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x

1105− toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x

1106− toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x

1107− toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x

1108− toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x

1109− toJSON (MappingTotalFieldsLimit x) = oPath ("index" :| ["mapping","total_fields","limit"]) x

1110− toJSON (AnalysisSetting x) = oPath ("index" :| ["analysis"]) x

1111−

1112−instance FromJSON UpdatableIndexSetting where

1113− parseJSON = withObject "UpdatableIndexSetting" parse

1114− where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]

1115− <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]

1116− <|> refreshInterval `taggedAt` ["index", "refresh_interval"]

1117− <|> indexConcurrency `taggedAt` ["index", "concurrency"]

1118− <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]

1119− <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]

1120− <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]

1121− <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]

1122− <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]

1123− <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]

1124− <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]

1125− <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]

1126− <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]

1127− <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]

1128− <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]

1129− <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]

1130− <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]

1131− <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]

1132− <|> gcDeletes `taggedAt` ["index", "gc_deletes"]

1133− <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]

1134− <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]

1135− <|> compressionSetting `taggedAt` ["index", "codec"]

1136− <|> compoundFormat `taggedAt` ["index", "compound_format"]

1137− <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]

1138− <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]

1139− <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]

1140− <|> blocksRead `taggedAt` ["blocks", "read"]

1141− <|> blocksWrite `taggedAt` ["blocks", "write"]

1142− <|> blocksMetaData `taggedAt` ["blocks", "metadata"]

1143− <|> mappingTotalFieldsLimit `taggedAt` ["index", "mapping", "total_fields", "limit"]

1144− <|> analysisSetting `taggedAt` ["index", "analysis"]

1145− where taggedAt f ks = taggedAt' f (Object o) ks

1146− taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v)))

1147− taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k

1148− taggedAt' f v' ks) v

1149− numberOfReplicas = pure . NumberOfReplicas

1150− autoExpandReplicas = pure . AutoExpandReplicas

1151− refreshInterval = pure . RefreshInterval . ndtJSON

1152− indexConcurrency = pure . IndexConcurrency

1153− failOnMergeFailure = pure . FailOnMergeFailure

1154− translogFlushThresholdOps = pure . TranslogFlushThresholdOps

1155− translogFlushThresholdSize = pure . TranslogFlushThresholdSize

1156− translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON

1157− translogDisableFlush = pure . TranslogDisableFlush

1158− cacheFilterMaxSize = pure . CacheFilterMaxSize

1159− cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON

1160− gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON

1161− routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter

1162− routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter

1163− routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter

1164− routingAllocationEnable = pure . RoutingAllocationEnable

1165− routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode

1166− recoveryInitialShards = pure . RecoveryInitialShards

1167− gcDeletes = pure . GCDeletes . ndtJSON

1168− ttlDisablePurge = pure . TTLDisablePurge

1169− translogFSType = pure . TranslogFSType

1170− compressionSetting = pure . CompressionSetting

1171− compoundFormat = pure . IndexCompoundFormat

1172− compoundOnFlush = pure . IndexCompoundOnFlush

1173− warmerEnabled = pure . WarmerEnabled

1174− blocksReadOnly = pure . BlocksReadOnly

1175− blocksRead = pure . BlocksRead

1176− blocksWrite = pure . BlocksWrite

1177− blocksMetaData = pure . BlocksMetaData

1178− mappingTotalFieldsLimit = pure . MappingTotalFieldsLimit

1179− analysisSetting = pure . AnalysisSetting

1180−

1181−instance FromJSON IndexSettingsSummary where

1182− parseJSON = withObject "IndexSettingsSummary" parse

1183− where parse o = case HM.toList o of

1184− [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)

1185− <$> parseJSON v

1186− <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")

1187− _ -> fail "Expected single-key object with index name"

1188− redundant (NumberOfReplicas _) = True

1189− redundant _ = False

1190−

1191−

1192−parseSettings :: Object -> Parser [UpdatableIndexSetting]

1193−parseSettings o = do

1194− o' <- o .: "index"

1195− -- slice the index object into singleton hashmaps and try to parse each

1196− parses <- forM (HM.toList o') $ \(k, v) -> do

1197− -- blocks are now nested into the "index" key, which is not how they're serialized

1198− let atRoot = Object (HM.singleton k v)

1199− let atIndex = Object (HM.singleton "index" atRoot)

1200− optional (parseJSON atRoot <|> parseJSON atIndex)

1201− return (catMaybes parses)

1202−

1203−oPath :: ToJSON a => NonEmpty Text -> a -> Value

1204−oPath (k :| []) v = object [k .= v]

1205−oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]

1206−

1207−attrFilterJSON :: NonEmpty NodeAttrFilter -> Value

1208−attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)

1209− | NodeAttrFilter (NodeAttrName n) vs <- toList fs]

1210−

1211−parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)

1212−parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse

1213− where parse o = case HM.toList o of

1214− [] -> fail "Expected non-empty list of NodeAttrFilters"

1215− x:xs -> DT.mapM (uncurry parse') (x :| xs)

1216− parse' n = withText "Text" $ \t ->

1217− case T.splitOn "," t of

1218− fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))

1219− [] -> fail "Expected non-empty list of filter values"

1220−

1221−instance ToJSON ReplicaBounds where

1222− toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)

1223− toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")

1224− toJSON ReplicasUnbounded = Bool False

1225−

1226−instance FromJSON ReplicaBounds where

1227− parseJSON v = withText "ReplicaBounds" parseText v

1228− <|> withBool "ReplicaBounds" parseBool v

1229− where parseText t = case T.splitOn "-" t of

1230− [a, "all"] -> ReplicasLowerBounded <$> parseReadText a

1231− [a, b] -> ReplicasBounded <$> parseReadText a

1232− <*> parseReadText b

1233− _ -> fail ("Could not parse ReplicaBounds: " <> show t)

1234− parseBool False = pure ReplicasUnbounded

1235− parseBool _ = fail "ReplicasUnbounded cannot be represented with True"

1236−

1237−instance ToJSON AllocationPolicy where

1238− toJSON AllocAll = String "all"

1239− toJSON AllocPrimaries = String "primaries"

1240− toJSON AllocNewPrimaries = String "new_primaries"

1241− toJSON AllocNone = String "none"

1242−

1243−instance FromJSON AllocationPolicy where

1244− parseJSON = withText "AllocationPolicy" parse

1245− where parse "all" = pure AllocAll

1246− parse "primaries" = pure AllocPrimaries

1247− parse "new_primaries" = pure AllocNewPrimaries

1248− parse "none" = pure AllocNone

1249− parse t = fail ("Invlaid AllocationPolicy: " <> show t)

1250−

1251−instance ToJSON InitialShardCount where

1252− toJSON QuorumShards = String "quorum"

1253− toJSON QuorumMinus1Shards = String "quorum-1"

1254− toJSON FullShards = String "full"

1255− toJSON FullMinus1Shards = String "full-1"

1256− toJSON (ExplicitShards x) = toJSON x

1257−

1258−instance FromJSON InitialShardCount where

1259− parseJSON v = withText "InitialShardCount" parseText v

1260− <|> ExplicitShards <$> parseJSON v

1261− where parseText "quorum" = pure QuorumShards

1262− parseText "quorum-1" = pure QuorumMinus1Shards

1263− parseText "full" = pure FullShards

1264− parseText "full-1" = pure FullMinus1Shards

1265− parseText _ = mzero

1266−

1267−instance ToJSON FSType where

1268− toJSON FSSimple = "simple"

1269− toJSON FSBuffered = "buffered"

1270−

1271−instance FromJSON FSType where

1272− parseJSON = withText "FSType" parse

1273− where parse "simple" = pure FSSimple

1274− parse "buffered" = pure FSBuffered

1275− parse t = fail ("Invalid FSType: " <> show t)

1276−

1277−instance ToJSON CompoundFormat where

1278− toJSON (CompoundFileFormat x) = Bool x

1279− toJSON (MergeSegmentVsTotalIndex x) = toJSON x

1280−

1281−instance FromJSON CompoundFormat where

1282− parseJSON v = CompoundFileFormat <$> parseJSON v

1283− <|> MergeSegmentVsTotalIndex <$> parseJSON v

1284−

1285−instance ToJSON NominalDiffTimeJSON where

1286− toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")

1287−

1288−instance FromJSON NominalDiffTimeJSON where

1289− parseJSON = withText "NominalDiffTime" parse

1290− where parse t = case T.takeEnd 1 t of

1291− "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)

1292− _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"

1293−

1294−instance ToJSON IndexTemplate where

1295− toJSON (IndexTemplate p s m) = merge

1296− (object [ "template" .= p

1297− , "mappings" .= foldl' merge (object []) m

1298− ])

1299− (toJSON s)

1300− where

1301− merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2

1302− merge o Null = o

1303− merge _ _ = undefined

1304−

1305−instance (FromJSON a) => FromJSON (EsResult a) where

1306− parseJSON jsonVal@(Object v) = do

1307− found <- v .:? "found" .!= False

1308− fr <- if found

1309− then parseJSON jsonVal

1310− else return Nothing

1311− EsResult <$> v .: "_index" <*>

1312− v .: "_type" <*>

1313− v .: "_id" <*>

1314− pure fr

1315− parseJSON _ = empty

1316−

1317−instance (FromJSON a) => FromJSON (EsResultFound a) where

1318− parseJSON (Object v) = EsResultFound <$>

1319− v .: "_version" <*>

1320− v .: "_source"

1321− parseJSON _ = empty

1322−

1323−instance FromJSON EsError where

1324− parseJSON (Object v) = EsError <$>

1325− v .: "status" <*>

1326− (v .: "error" <|> (v .: "error" >>= (.: "reason")))

1327− parseJSON _ = empty

1328−

1329−instance FromJSON IndexAliasesSummary where

1330− parseJSON = withObject "IndexAliasesSummary" parse

1331− where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)

1332− go ixn = withObject "index aliases" $ \ia -> do

1333− aliases <- ia .:? "aliases" .!= mempty

1334− forM (HM.toList aliases) $ \(aName, v) -> do

1335− let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))

1336− IndexAliasSummary indexAlias <$> parseJSON v

1337−

1338−

1339−instance ToJSON IndexAliasAction where

1340− toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]

1341− where Object iaObj = toJSON ia

1342− Object optsObj = toJSON opts

1343− toJSON (RemoveAlias ia) = object ["remove" .= iaObj]

1344− where Object iaObj = toJSON ia

1345−

1346−instance ToJSON IndexAlias where

1347− toJSON IndexAlias {..} = object ["index" .= srcIndex

1348− , "alias" .= indexAlias

1349− ]

1350−

1351−instance ToJSON IndexAliasCreate where

1352− toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)

1353− where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter

1354− Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting

1355−

1356−instance ToJSON AliasRouting where

1357− toJSON (AllAliasRouting v) = object ["routing" .= v]

1358− toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)

1359− where prs = [("search_routing" .=) <$> srch

1360− ,("index_routing" .=) <$> idx]

1361−

1362−instance FromJSON AliasRouting where

1363− parseJSON = withObject "AliasRouting" parse

1364− where parse o = parseAll o <|> parseGranular o

1365− parseAll o = AllAliasRouting <$> o .: "routing"

1366− parseGranular o = do

1367− sr <- o .:? "search_routing"

1368− ir <- o .:? "index_routing"

1369− if isNothing sr && isNothing ir

1370− then fail "Both search_routing and index_routing can't be blank"

1371− else return (GranularAliasRouting sr ir)

1372−

1373−instance FromJSON IndexAliasCreate where

1374− parseJSON v = withObject "IndexAliasCreate" parse v

1375− where parse o = IndexAliasCreate <$> optional (parseJSON v)

1376− <*> o .:? "filter"

1377−

1378−instance ToJSON SearchAliasRouting where

1379− toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))

1380−

1381−instance FromJSON SearchAliasRouting where

1382− parseJSON = withText "SearchAliasRouting" parse

1383− where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)

1384−

1385instance ToJSON Search where

1121instance ToJSON Search where

1386 toJSON (Search mquery sFilter sort searchAggs

1122 toJSON (Search mquery sFilter sort searchAggs

1387 highlight sTrackSortScores sFrom sSize _ sFields

1123 highlight sTrackSortScores sFrom sSize _ sFields

@@ -1494,91 +1230,12 @@ nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =

1494 [ "fragment_size" .= npFragSize

1230 [ "fragment_size" .= npFragSize

1495 , "number_of_fragments" .= npNumOfFrags]

1231 , "number_of_fragments" .= npNumOfFrags]

1496

1232

1497−

1498−instance ToJSON HighlightEncoder where

1499− toJSON DefaultEncoder = String "default"

1500− toJSON HTMLEncoder = String "html"

1501−

1502highlightTagToPairs :: Maybe HighlightTag -> [Pair]

1233highlightTagToPairs :: Maybe HighlightTag -> [Pair]

1503highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]

1234highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]

1504highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre

1235highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre

1505 , "post_tags" .= post]

1236 , "post_tags" .= post]

1506highlightTagToPairs Nothing = []

1237highlightTagToPairs Nothing = []

1507

1238

1508−instance ToJSON SortSpec where

1509− toJSON (DefaultSortSpec

1510− (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped

1511− dsSortMode dsMissingSort dsNestedFilter)) =

1512− object [dsSortFieldName .= omitNulls base] where

1513− base = [ "order" .= dsSortOrder

1514− , "unmapped_type" .= dsIgnoreUnmapped

1515− , "mode" .= dsSortMode

1516− , "missing" .= dsMissingSort

1517− , "nested_filter" .= dsNestedFilter ]

1518−

1519− toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =

1520− object [ "unit" .= units

1521− , field .= gdsLatLon

1522− , "order" .= gdsSortOrder ]

1523−

1524−

1525−instance ToJSON SortOrder where

1526− toJSON Ascending = String "asc"

1527− toJSON Descending = String "desc"

1528−

1529−

1530−instance ToJSON SortMode where

1531− toJSON SortMin = String "min"

1532− toJSON SortMax = String "max"

1533− toJSON SortSum = String "sum"

1534− toJSON SortAvg = String "avg"

1535−

1536−

1537−instance ToJSON Missing where

1538− toJSON LastMissing = String "_last"

1539− toJSON FirstMissing = String "_first"

1540− toJSON (CustomMissing txt) = String txt

1541−

1542−

1543−

1544−instance (FromJSON a) => FromJSON (SearchResult a) where

1545− parseJSON (Object v) = SearchResult <$>

1546− v .: "took" <*>

1547− v .: "timed_out" <*>

1548− v .: "_shards" <*>

1549− v .: "hits" <*>

1550− v .:? "aggregations" <*>

1551− v .:? "_scroll_id" <*>

1552− v .:? "suggest"

1553− parseJSON _ = empty

1554−

1555−instance (FromJSON a) => FromJSON (SearchHits a) where

1556− parseJSON (Object v) = SearchHits <$>

1557− v .: "total" <*>

1558− v .: "max_score" <*>

1559− v .: "hits"

1560− parseJSON _ = empty

1561−

1562−instance (FromJSON a) => FromJSON (Hit a) where

1563− parseJSON (Object v) = Hit <$>

1564− v .: "_index" <*>

1565− v .: "_type" <*>

1566− v .: "_id" <*>

1567− v .: "_score" <*>

1568− v .:? "_source" <*>

1569− v .:? "fields" <*>

1570− v .:? "highlight"

1571− parseJSON _ = empty

1572−

1573−instance FromJSON HitFields where

1574− parseJSON x

1575− = HitFields <$> parseJSON x

1576−

1577−instance FromJSON DocVersion where

1578− parseJSON v = do

1579− i <- parseJSON v

1580− maybe (fail "DocVersion out of range") return $ mkDocVersion i

1581−

1582data Suggest = Suggest { suggestText :: Text

1239data Suggest = Suggest { suggestText :: Text

1583 , suggestName :: Text

1240 , suggestName :: Text

1584 , suggestType :: SuggestType

1241 , suggestType :: SuggestType

@@ -1613,36 +1270,38 @@ instance FromJSON SuggestType where

1613 where taggedWith parser k = parser =<< o .: k

1270 where taggedWith parser k = parser =<< o .: k

1614 phraseSuggester = pure . SuggestTypePhraseSuggester

1271 phraseSuggester = pure . SuggestTypePhraseSuggester

1615

1272

1616−data PhraseSuggester =

1273+data PhraseSuggester = PhraseSuggester

1617− PhraseSuggester { phraseSuggesterField :: FieldName

1274+ { phraseSuggesterField :: FieldName

1618− , phraseSuggesterGramSize :: Maybe Int

1275+ , phraseSuggesterGramSize :: Maybe Int

1619− , phraseSuggesterRealWordErrorLikelihood :: Maybe Int

1276+ , phraseSuggesterRealWordErrorLikelihood :: Maybe Int

1620− , phraseSuggesterConfidence :: Maybe Int

1277+ , phraseSuggesterConfidence :: Maybe Int

1621− , phraseSuggesterMaxErrors :: Maybe Int

1278+ , phraseSuggesterMaxErrors :: Maybe Int

1622− , phraseSuggesterSeparator :: Maybe Text

1279+ , phraseSuggesterSeparator :: Maybe Text

1623− , phraseSuggesterSize :: Maybe Size

1280+ , phraseSuggesterSize :: Maybe Size

1624− , phraseSuggesterAnalyzer :: Maybe Analyzer

1281+ , phraseSuggesterAnalyzer :: Maybe Analyzer

1625− , phraseSuggesterShardSize :: Maybe Int

1282+ , phraseSuggesterShardSize :: Maybe Int

1626− , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter

1283+ , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter

1627− , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate

1284+ , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate

1628− , phraseSuggesterCandidateGenerators :: [DirectGenerators]

1285+ , phraseSuggesterCandidateGenerators :: [DirectGenerators]

1629− }

1630− deriving (Eq, Show)

1286+ } deriving (Eq, Show)

1631

1287

1632instance ToJSON PhraseSuggester where

1288instance ToJSON PhraseSuggester where

1289+ toJSON PhraseSuggester{..} =

1633− toJSON PhraseSuggester{..} = omitNulls [ "field" .= phraseSuggesterField

1290+ omitNulls [ "field" .= phraseSuggesterField

1634− , "gram_size" .= phraseSuggesterGramSize

1291+ , "gram_size" .= phraseSuggesterGramSize

1292+ , "real_word_error_likelihood" .=

1635− , "real_word_error_likelihood" .= phraseSuggesterRealWordErrorLikelihood

1293+ phraseSuggesterRealWordErrorLikelihood

1636− , "confidence" .= phraseSuggesterConfidence

1294+ , "confidence" .= phraseSuggesterConfidence

1637− , "max_errors" .= phraseSuggesterMaxErrors

1295+ , "max_errors" .= phraseSuggesterMaxErrors

1638− , "separator" .= phraseSuggesterSeparator

1296+ , "separator" .= phraseSuggesterSeparator

1639− , "size" .= phraseSuggesterSize

1297+ , "size" .= phraseSuggesterSize

1640− , "analyzer" .= phraseSuggesterAnalyzer

1298+ , "analyzer" .= phraseSuggesterAnalyzer

1641− , "shard_size" .= phraseSuggesterShardSize

1299+ , "shard_size" .= phraseSuggesterShardSize

1642− , "highlight" .= phraseSuggesterHighlight

1300+ , "highlight" .= phraseSuggesterHighlight

1643− , "collate" .= phraseSuggesterCollate

1301+ , "collate" .= phraseSuggesterCollate

1302+ , "direct_generator" .=

1644− , "direct_generator" .= phraseSuggesterCandidateGenerators

1303+ phraseSuggesterCandidateGenerators

1645− ]

1304+ ]

1646

1305

1647instance FromJSON PhraseSuggester where

1306instance FromJSON PhraseSuggester where

1648 parseJSON = withObject "PhraseSuggester" parse

1307 parseJSON = withObject "PhraseSuggester" parse

@@ -1683,19 +1342,19 @@ instance FromJSON PhraseSuggesterHighlighter where

1683 <$> o .: "pre_tag"

1342 <$> o .: "pre_tag"

1684 <*> o .: "post_tag"

1343 <*> o .: "post_tag"

1685

1344

1686−data PhraseSuggesterCollate =

1345+data PhraseSuggesterCollate = PhraseSuggesterCollate

1687− PhraseSuggesterCollate { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline

1346+ { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline

1688− , phraseSuggesterCollatePrune :: Bool

1347+ , phraseSuggesterCollatePrune :: Bool

1689− }

1690− deriving (Eq, Show)

1348+ } deriving (Eq, Show)

1691

1349

1692instance ToJSON PhraseSuggesterCollate where

1350instance ToJSON PhraseSuggesterCollate where

1693− toJSON PhraseSuggesterCollate{..} = object [ "query" .= object

1351+ toJSON PhraseSuggesterCollate{..} =

1352+ object [ "query" .= object

1694− [ "inline" .= (inline phraseSuggesterCollateTemplateQuery)

1353+ [ "inline" .= (inline phraseSuggesterCollateTemplateQuery)

1695− ]

1354+ ]

1696− , "params" .= (params phraseSuggesterCollateTemplateQuery)

1355+ , "params" .= (params phraseSuggesterCollateTemplateQuery)

1697− , "prune" .= phraseSuggesterCollatePrune

1356+ , "prune" .= phraseSuggesterCollatePrune

1698− ]

1357+ ]

1699

1358

1700instance FromJSON PhraseSuggesterCollate where

1359instance FromJSON PhraseSuggesterCollate where

1701 parseJSON (Object o) = do

1360 parseJSON (Object o) = do

@@ -1703,7 +1362,8 @@ instance FromJSON PhraseSuggesterCollate where

1703 inline' <- query' .: "inline"

1362 inline' <- query' .: "inline"

1704 params' <- o .: "params"

1363 params' <- o .: "params"

1705 prune' <- o .:? "prune" .!= False

1364 prune' <- o .:? "prune" .!= False

1365+ return $ PhraseSuggesterCollate

1706− return $ PhraseSuggesterCollate (TemplateQueryInline inline' params') prune'

1366+ (TemplateQueryInline inline' params') prune'

1707 parseJSON x = typeMismatch "PhraseSuggesterCollate" x

1367 parseJSON x = typeMismatch "PhraseSuggesterCollate" x

1708

1368

1709data SuggestOptions =

1369data SuggestOptions =

@@ -1738,11 +1398,10 @@ instance FromJSON SuggestResponse where

1738 <*> o .: "length"

1398 <*> o .: "length"

1739 <*> o .: "options"

1399 <*> o .: "options"

1740

1400

1741−data NamedSuggestionResponse =

1401+data NamedSuggestionResponse = NamedSuggestionResponse

1742− NamedSuggestionResponse { nsrName :: Text

1402+ { nsrName :: Text

1743− , nsrResponses :: [SuggestResponse]

1403+ , nsrResponses :: [SuggestResponse]

1744− }

1745− deriving (Eq, Read, Show)

1404+ } deriving (Eq, Read, Show)

1746

1405

1747instance FromJSON NamedSuggestionResponse where

1406instance FromJSON NamedSuggestionResponse where

1748 parseJSON (Object o) = do

1407 parseJSON (Object o) = do

@@ -1786,7 +1445,6 @@ data DirectGenerators = DirectGenerators

1786 }

1445 }

1787 deriving (Eq, Show)

1446 deriving (Eq, Show)

1788

1447

1789−

1790instance ToJSON DirectGenerators where

1448instance ToJSON DirectGenerators where

1791 toJSON DirectGenerators{..} = omitNulls [ "field" .= directGeneratorsField

1449 toJSON DirectGenerators{..} = omitNulls [ "field" .= directGeneratorsField

1792 , "size" .= directGeneratorsSize

1450 , "size" .= directGeneratorsSize

tests/V5/Test/Aggregation.hs+2−2

@@ -1,6 +1,6 @@

1{-# LANGUAGE OverloadedStrings #-}

3−module Test.Aggregation where

3+module Test.Aggregation (spec) where

5import Test.Common

6import Test.Import

@@ -29,7 +29,7 @@ spec =

29 usersAggResults = result >>= aggregations >>= toTerms "users"

30 subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"

31 subAddResultsExists = isJust subAggResults

32− liftIO $ (subAddResultsExists) `shouldBe` True

32+ liftIO $ subAddResultsExists `shouldBe` True

34 it "returns cardinality aggregation results" $ withTestEnv $ do

35 _ <- insertData

tests/V5/Test/BulkAPI.hs+4−4

@@ -1,6 +1,6 @@

1{-# LANGUAGE OverloadedStrings #-}

3−module Test.BulkAPI where

3+module Test.BulkAPI (spec) where

5import Test.Common

6import Test.Import

@@ -9,7 +9,7 @@ import qualified Data.Vector as V

9import qualified Lens.Micro.Aeson as LMA

11newtype BulkTest =

12− BulkTest { name :: Text }

12+ BulkTest Text

13 deriving (Eq, Show)

15instance ToJSON BulkTest where

@@ -25,7 +25,7 @@ instance FromJSON BulkTest where

26spec :: Spec

27spec =

28− describe "Bulk API" $ do

28+ describe "Bulk API" $

29 it "inserts all documents we request" $ withTestEnv $ do

30 _ <- insertData

31 let firstTest = BulkTest "blah"

@@ -84,7 +84,7 @@ spec =

84 hitsTotal (searchHits sr) `shouldBe` 6

85 let nameList :: [Text]

86 nameList =

87− (hits (searchHits sr))

87+ hits (searchHits sr)

88 ^.. traverse

89 . to hitSource

90 . _Just

tests/V5/Test/Documents.hs+2−2

@@ -14,14 +14,14 @@ spec =

14 docInserted <- getDocument testIndex testMapping (DocId "1")

15 let newTweet = eitherDecode

16 (responseBody docInserted) :: Either String (EsResult Tweet)

17− liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))

17+ liftIO $ fmap getSource newTweet `shouldBe` Right (Just patchedTweet)

19 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do

20 _ <- insertWithSpaceInId

21 docInserted <- getDocument testIndex testMapping (DocId "Hello World")

22 let newTweet = eitherDecode

23 (responseBody docInserted) :: Either String (EsResult Tweet)

24− liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))

24+ liftIO $ fmap getSource newTweet `shouldBe` Right (Just exampleTweet)

26 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do

27 doc <- getDocument testIndex testMapping (DocId "bogus")

tests/V5/Test/Generators.hs+4−2

@@ -36,8 +36,10 @@ instance Arbitrary UTCTime where

36 <*> (fromRational . toRational <$> choose (0::Double, 86400))

38instance Arbitrary Day where

39+ arbitrary =

39− arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary

40+ ModifiedJulianDay . (2000 +) <$> arbitrary

41+ shrink =

40− shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay

42+ (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay

42#if !MIN_VERSION_QuickCheck(2,9,0)

44#if !MIN_VERSION_QuickCheck(2,9,0)

43instance Arbitrary a => Arbitrary (NonEmpty a) where

45instance Arbitrary a => Arbitrary (NonEmpty a) where

tests/V5/Test/Highlights.hs+11−15

@@ -7,28 +7,24 @@ import Test.Import

8import qualified Data.Map as M

10+initHighlights :: Text -> BH IO (Either EsError (Maybe HitHighlight))

11+initHighlights fieldName = do

12+ _ <- insertData

13+ _ <- insertOther

14+ let query = QueryMatchQuery $ mkMatchQuery (FieldName fieldName) (QueryString "haskell")

15+ let testHighlight = Highlights Nothing [FieldHighlight (FieldName fieldName) Nothing]

16+ let search = mkHighlightSearch (Just query) testHighlight

17+ searchTweetHighlight search

18+

10spec :: Spec

19spec :: Spec

11spec =

20spec =

12 describe "Highlights API" $ do

21 describe "Highlights API" $ do

13−

14 it "returns highlight from query when there should be one" $ withTestEnv $ do

22 it "returns highlight from query when there should be one" $ withTestEnv $ do

15− _ <- insertData

23+ myHighlight <- initHighlights "message"

16− _ <- insertOther

17− let query = QueryMatchQuery $ mkMatchQuery (FieldName "message") (QueryString "haskell")

18− let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]

19−

20− let search = mkHighlightSearch (Just query) testHighlight

21− myHighlight <- searchTweetHighlight search

22 liftIO $

24 liftIO $

23 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))

25 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))

25 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do

27 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do

26− _ <- insertData

28+ myHighlight <- initHighlights "user"

27− _ <- insertOther

28− let query = QueryMatchQuery $ mkMatchQuery (FieldName "message") (QueryString "haskell")

29− let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]

30−

31− let search = mkHighlightSearch (Just query) testHighlight

32− myHighlight <- searchTweetHighlight search

33 liftIO $

29 liftIO $

34 myHighlight `shouldBe` Right Nothing

30 myHighlight `shouldBe` Right Nothing

tests/V5/Test/JSON.hs+1−1

@@ -1,7 +1,7 @@

1{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE ScopedTypeVariables #-}

4−module Test.JSON where

4+module Test.JSON (spec) where

6import Test.Import

tests/V5/Test/Script.hs+3−2

@@ -10,7 +10,7 @@ import qualified Data.Map as M

11spec :: Spec

12spec =

13− describe "Script" $ do

13+ describe "Script" $

14 it "returns a transformed document based on the script field" $ withTestEnv $ do

15 _ <- insertData

16 let query = MatchAllQuery Nothing

@@ -32,4 +32,5 @@ spec =

32 Right sr -> do

33 let Just results =

34 hitFields (head (hits (searchHits sr)))

35+ liftIO $

35− liftIO $ results `shouldBe` (HitFields (M.fromList [("test1", [Number 20000.0])]))

36+ results `shouldBe` HitFields (M.fromList [("test1", [Number 20000.0])])

tests/V5/Test/Snapshots.hs+4−4

@@ -1,7 +1,7 @@

1{-# LANGUAGE RecordWildCards #-}

2{-# LANGUAGE OverloadedStrings #-}

4−module Test.Snapshots where

4+module Test.Snapshots (spec) where

6import Test.Common

7import Test.Import

@@ -18,7 +18,7 @@ import Test.Generators ()

19spec :: Spec

20spec = do

21− describe "FsSnapshotRepo" $ do

21+ describe "FsSnapshotRepo" $

22 prop "SnapshotRepo laws" $ \fsr ->

23 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)

@@ -149,7 +149,7 @@ canSnapshot :: IO Bool

149canSnapshot = do

150 caresAboutRepos <- atleast es16

151 repoPaths <- getRepoPaths

152− return (not caresAboutRepos || not (null (repoPaths)))

152+ return (not caresAboutRepos || not (null repoPaths))

153

154withSnapshotRepo

155 :: ( MonadMask m

@@ -197,5 +197,5 @@ withSnapshot srn sn = bracket_ alloc free

197 , snapIndices = Just (IndexList (testIndex :| []))

198 -- We don't actually need to back up any data

199 }

200− free = do

200+ free =

201 deleteSnapshot srn sn

tests/V5/Test/Sorting.hs+1−1

@@ -7,7 +7,7 @@ import Test.Import

8spec :: Spec

9spec =

10− describe "sorting" $ do

10+ describe "sorting" $

11 it "returns documents in the right order" $ withTestEnv $ do

12 _ <- insertData

13 _ <- insertOther

tests/V5/Test/SourceFiltering.hs+5−5

@@ -11,27 +11,27 @@ spec :: Spec

11spec =

12 describe "Source filtering" $ do

14− it "doesn't include source when sources are disabled" $ withTestEnv $ do

14+ it "doesn't include source when sources are disabled" $ withTestEnv $

15 searchExpectSource

16 NoSource

17 (Left (EsError 500 "Source was missing"))

19− it "includes a source" $ withTestEnv $ do

19+ it "includes a source" $ withTestEnv $

20 searchExpectSource

21 (SourcePatterns (PopPattern (Pattern "message")))

22 (Right (Object (HM.fromList [("message", String "Use haskell!")])))

24− it "includes sources" $ withTestEnv $ do

24+ it "includes sources" $ withTestEnv $

25 searchExpectSource

26 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))

27 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))

29− it "includes source patterns" $ withTestEnv $ do

29+ it "includes source patterns" $ withTestEnv $

30 searchExpectSource

31 (SourcePatterns (PopPattern (Pattern "*ge")))

32 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))

34− it "excludes source patterns" $ withTestEnv $ do

34+ it "excludes source patterns" $ withTestEnv $

35 searchExpectSource

36 (SourceIncludeExclude (Include [])

37 (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))

tests/V5/Test/Suggest.hs+1−1

@@ -7,7 +7,7 @@ import Test.Import

8spec :: Spec

9spec =

10− describe "Suggest" $ do

10+ describe "Suggest" $

11 it "returns a search suggestion using the phrase suggester" $ withTestEnv $ do

12 _ <- insertData

13 let query = QueryMatchNoneQuery

tests/V5/tests.hs+11−13

@@ -1,13 +1,8 @@

1{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DefaultSignatures #-}

3−{-# LANGUAGE DeriveDataTypeable #-}

4−{-# LANGUAGE DeriveGeneric #-}

5{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE FlexibleContexts #-}

6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

7{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE OverloadedStrings #-}

8{-# LANGUAGE RecordWildCards #-}

4{-# LANGUAGE RecordWildCards #-}

9{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE ScopedTypeVariables #-}

10−{-# LANGUAGE TemplateHaskell #-}

11{-# LANGUAGE TypeOperators #-}

6{-# LANGUAGE TypeOperators #-}

12{-# OPTIONS_GHC -fno-warn-orphans #-}

7{-# OPTIONS_GHC -fno-warn-orphans #-}

13#if __GLASGOW_HASKELL__ < 800

8#if __GLASGOW_HASKELL__ < 800

@@ -21,7 +16,7 @@ module Main where

21import Test.Common

16import Test.Common

22import Test.Import

17import Test.Import

24−import Prelude hiding (filter)

19+import Prelude

26import qualified Test.Aggregation as Aggregation

21import qualified Test.Aggregation as Aggregation

27import qualified Test.BulkAPI as Bulk

22import qualified Test.BulkAPI as Bulk

@@ -64,11 +59,11 @@ main = hspec $ do

64 let errorResp = eitherDecode (responseBody res)

59 let errorResp = eitherDecode (responseBody res)

65 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))

60 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))

67− describe "Monoid (SearchHits a)" $ do

62+ describe "Monoid (SearchHits a)" $

68 prop "abides the monoid laws" $ eq $

63 prop "abides the monoid laws" $ eq $

69 prop_Monoid (T :: T (SearchHits ()))

64 prop_Monoid (T :: T (SearchHits ()))

71− describe "mkDocVersion" $ do

66+ describe "mkDocVersion" $

72 prop "can never construct an out of range docVersion" $ \i ->

67 prop "can never construct an out of range docVersion" $ \i ->

73 let res = mkDocVersion i

68 let res = mkDocVersion i

74 in case res of

69 in case res of

@@ -77,7 +72,7 @@ main = hspec $ do

77 (dv <= maxBound) .&&.

72 (dv <= maxBound) .&&.

78 docVersionNumber dv === i

73 docVersionNumber dv === i

80− describe "getNodesInfo" $ do

75+ describe "getNodesInfo" $

81 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do

76 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do

82 res <- getNodesInfo LocalNode

77 res <- getNodesInfo LocalNode

83 liftIO $ case res of

78 liftIO $ case res of

@@ -87,7 +82,7 @@ main = hspec $ do

87 Right NodesInfo {..} -> length nodesInfo `shouldBe` 1

82 Right NodesInfo {..} -> length nodesInfo `shouldBe` 1

88 Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)

83 Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)

90− describe "getNodesStats" $ do

85+ describe "getNodesStats" $

91 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do

86 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do

92 res <- getNodesStats LocalNode

87 res <- getNodesStats LocalNode

93 liftIO $ case res of

88 liftIO $ case res of

@@ -97,7 +92,7 @@ main = hspec $ do

97 Right NodesStats {..} -> length nodesStats `shouldBe` 1

92 Right NodesStats {..} -> length nodesStats `shouldBe` 1

98 Left e -> expectationFailure ("Expected NodesStats but got " <> show e)

93 Left e -> expectationFailure ("Expected NodesStats but got " <> show e)

100− describe "Enum DocVersion" $ do

95+ describe "Enum DocVersion" $

101 it "follows the laws of Enum, Bounded" $ do

96 it "follows the laws of Enum, Bounded" $ do

102 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall

97 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall

103 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall

98 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall

@@ -107,11 +102,14 @@ main = hspec $ do

107 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]

102 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]

108 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]

103 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]

109

104

110− describe "Scan & Scroll API" $ do

105+ describe "Scan & Scroll API" $

111 it "returns documents using the scan&scroll API" $ withTestEnv $ do

106 it "returns documents using the scan&scroll API" $ withTestEnv $ do

112 _ <- insertData

107 _ <- insertData

113 _ <- insertOther

108 _ <- insertOther

109+ let search =

110+ (mkSearch

114− let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }

111+ (Just $ MatchAllQuery Nothing) Nothing)

112+ { size = Size 1 }

115 regular_search <- searchTweet search

113 regular_search <- searchTweet search

116 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]

114 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]

117 let scan_search = map hitSource scan_search'

115 let scan_search = map hitSource scan_search'