df27a37 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

Merge branch 'master' into node-stats-api

df27a37Michael Xavier10 years ago

Makefile+15−1

compare with master

unifiedsplit

@@ -1,10 +1,24 @@

1build:

2 stack build

4−test:

4+echo-warn:

5 echo "Make certain you have an elasticsearch instance on localhost:9200 !"

7+test: echo-warn

6 stack test

8 stack test

10+7.8-build:

11+ STACK_YAML="stack-7.8.yaml" stack build

12+

13+7.8-test: echo-warn

14+ STACK_YAML="stack-7.8.yaml" stack test

15+

16+8.0-build:

17+ STACK_YAML="stack-8.0.yaml" stack build

18+

19+8.0-test: echo-warn

20+ STACK_YAML="stack-8.0.yaml" stack test

21+

8ghci:

22ghci:

9 stack ghci

23 stack ghci

README.md+1

@@ -70,6 +70,7 @@ Index Operations

70-- the multi-line examples into your ghci REPL.

72:set -XDeriveGeneric

73+:set -XOverloadedStrings

73:{

74:{

74import Control.Applicative

75import Control.Applicative

75import Database.Bloodhound

76import Database.Bloodhound

src/Database/Bloodhound/Types.hs+19−6

@@ -45,6 +45,7 @@ module Database.Bloodhound.Types

45 , mkTermsAggregation

46 , mkTermsScriptAggregation

47 , mkDateHistogram

48+ , mkCardinalityAggregation

48 , mkDocVersion

49 , mkDocVersion

49 , docVersionNumber

50 , docVersionNumber

50 , toMissing

51 , toMissing

@@ -330,6 +331,7 @@ module Database.Bloodhound.Types

330 , MissingAggregation(..)

331 , MissingAggregation(..)

331 , ValueCountAggregation(..)

332 , ValueCountAggregation(..)

332 , FilterAggregation(..)

333 , FilterAggregation(..)

334+ , CardinalityAggregation(..)

333 , DateHistogramAggregation(..)

335 , DateHistogramAggregation(..)

334 , DateRangeAggregation(..)

336 , DateRangeAggregation(..)

335 , DateRangeAggRange(..)

337 , DateRangeAggRange(..)

@@ -1714,6 +1716,7 @@ data Interval = Year

1714 | FractionalInterval Float TimeInterval deriving (Eq, Read, Show, Generic, Typeable)

1716 | FractionalInterval Float TimeInterval deriving (Eq, Read, Show, Generic, Typeable)

1715

1717

1716data Aggregation = TermsAgg TermsAggregation

1718data Aggregation = TermsAgg TermsAggregation

1719+ | CardinalityAgg CardinalityAggregation

1717 | DateHistogramAgg DateHistogramAggregation

1720 | DateHistogramAgg DateHistogramAggregation

1718 | ValueCountAgg ValueCountAggregation

1721 | ValueCountAgg ValueCountAggregation

1719 | FilterAgg FilterAggregation

1722 | FilterAgg FilterAggregation

@@ -1736,6 +1739,10 @@ data TermsAggregation = TermsAggregation { term :: Either Text Text

1736 , termAggs :: Maybe Aggregations

1739 , termAggs :: Maybe Aggregations

1737 } deriving (Eq, Read, Show, Generic, Typeable)

1740 } deriving (Eq, Read, Show, Generic, Typeable)

1738

1741

1742+data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,

1743+ precisionThreshold :: Maybe Int

1744+ } deriving (Eq, Read, Show, Generic, Typeable)

1745+

1739data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName

1746data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName

1740 , dateInterval :: Interval

1747 , dateInterval :: Interval

1741 , dateFormat :: Maybe Text

1748 , dateFormat :: Maybe Text

@@ -1794,6 +1801,9 @@ mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing

1794mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation

1801mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation

1795mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing

1802mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing

1796

1803

1804+mkCardinalityAggregation :: FieldName -> CardinalityAggregation

1805+mkCardinalityAggregation t = CardinalityAggregation t Nothing

1806+

1797instance ToJSON Version where

1807instance ToJSON Version where

1798 toJSON Version {..} = object ["number" .= number

1808 toJSON Version {..} = object ["number" .= number

1799 ,"build_hash" .= build_hash

1809 ,"build_hash" .= build_hash

@@ -1884,6 +1894,12 @@ instance ToJSON Aggregation where

1884 where

1894 where

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

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

1886

1896

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

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

1899+ "precisionThreshold" .= precisionThreshold

1900+ ]

1901+ ]

1902+

1887 toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =

1903 toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =

1888 omitNulls ["date_histogram" .= omitNulls [ "field" .= field,

1904 omitNulls ["date_histogram" .= omitNulls [ "field" .= field,

1889 "interval" .= interval,

1905 "interval" .= interval,

@@ -1921,10 +1937,7 @@ instance ToJSON DateRangeAggRange where

1921instance ToJSON DateMathExpr where

1937instance ToJSON DateMathExpr where

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

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

1923 where fmtA DMNow = "now"

1939 where fmtA DMNow = "now"

1924− fmtA (DMDate date) = case toGregorian date of

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

1925− (y,m,d) -> showText y <> "-" <>

1926− showText m <> "-" <>

1927− showText d <> "||"

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

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

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

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

1930 fmtMod (RoundDownTo u) = "/" <> fmtU u

1943 fmtMod (RoundDownTo u) = "/" <> fmtU u

@@ -3010,7 +3023,7 @@ instance FromJSON MatchQueryType where

3010instance FromJSON Status where

3023instance FromJSON Status where

3011 parseJSON (Object v) = Status <$>

3024 parseJSON (Object v) = Status <$>

3012 v .:? "ok" <*>

3025 v .:? "ok" <*>

3013− v .: "status" <*>

3026+ (v .:? "status" .!= 200) <*>

3014 v .: "name" <*>

3027 v .: "name" <*>

3015 v .: "version" <*>

3028 v .: "version" <*>

3016 v .: "tagline"

3029 v .: "tagline"

@@ -3281,7 +3294,7 @@ instance (FromJSON a) => FromJSON (EsResultFound a) where

3281instance FromJSON EsError where

3294instance FromJSON EsError where

3282 parseJSON (Object v) = EsError <$>

3295 parseJSON (Object v) = EsError <$>

3283 v .: "status" <*>

3296 v .: "status" <*>

3284− v .: "error"

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

3285 parseJSON _ = empty

3298 parseJSON _ = empty

3286

3299

3287instance FromJSON IndexAliasesSummary where

3300instance FromJSON IndexAliasesSummary where

stack-7.10.yaml+1−1

@@ -13,4 +13,4 @@ extra-deps:

13- semigroups-0.18.0.1

14- uri-bytestring-0.1.9

15- temporary-resourcet-0.1.0.0

16−resolver: lts-5.1

16+resolver: lts-6.12

stack-8.0.yamlnew file+16

@@ -0,0 +1,16 @@

1+flags: {}

2+packages:

3+- '.'

4+extra-deps:

5+- doctest-prop-0.2.0.1

6+- quickcheck-properties-0.1

8+# - http-client-0.5.0

9+# - fail-4.9.0.0

10+# - http-types-0.9

11+# - attoparsec-0.13.0.1

12+# - doctest-0.10.1

13+# - semigroups-0.18.0.1

14+# - uri-bytestring-0.1.9

15+# - temporary-resourcet-0.1.0.0

16+resolver: nightly-2016-08-20

tests/tests.hs+45−6

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE DefaultSignatures #-}

2{-# LANGUAGE DefaultSignatures #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE FlexibleContexts #-}

4{-# LANGUAGE FlexibleContexts #-}

@@ -95,6 +96,9 @@ es15 = Vers.Version [1, 5, 0] []

95es16 :: Vers.Version

96es16 :: Vers.Version

96es16 = Vers.Version [1, 6, 0] []

97es16 = Vers.Version [1, 6, 0] []

99+es20 :: Vers.Version

100+es20 = Vers.Version [2, 0, 0] []

101+

98getServerVersion :: IO (Maybe Vers.Version)

102getServerVersion :: IO (Maybe Vers.Version)

99getServerVersion = fmap extractVersion <$> withTestEnv getStatus

103getServerVersion = fmap extractVersion <$> withTestEnv getStatus

100 where

104 where

@@ -173,15 +177,32 @@ data ParentMapping = ParentMapping deriving (Eq, Show)

173

177

174instance ToJSON ParentMapping where

178instance ToJSON ParentMapping where

175 toJSON ParentMapping =

179 toJSON ParentMapping =

176− object ["parent" .= Null ]

180+ object ["parent" .=

181+ object ["properties" .=

182+ object [ "user" .= object ["type" .= ("string" :: Text)]

183+ -- Serializing the date as a date is breaking other tests, mysteriously.

184+ -- , "postDate" .= object [ "type" .= ("date" :: Text)

185+ -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]

186+ , "message" .= object ["type" .= ("string" :: Text)]

187+ , "age" .= object ["type" .= ("integer" :: Text)]

188+ , "location" .= object ["type" .= ("geo_point" :: Text)]

189+ ]]]

177

190

178data ChildMapping = ChildMapping deriving (Eq, Show)

191data ChildMapping = ChildMapping deriving (Eq, Show)

179

192

180instance ToJSON ChildMapping where

193instance ToJSON ChildMapping where

181 toJSON ChildMapping =

194 toJSON ChildMapping =

182 object ["child" .=

195 object ["child" .=

183− object ["_parent" .= object ["type" .= ("parent" :: Text)]]

196+ object ["_parent" .= object ["type" .= ("parent" :: Text)]

197+ , "properties" .=

198+ object [ "user" .= object ["type" .= ("string" :: Text)]

199+ -- Serializing the date as a date is breaking other tests, mysteriously.

200+ -- , "postDate" .= object [ "type" .= ("date" :: Text)

201+ -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]

202+ , "message" .= object ["type" .= ("string" :: Text)]

203+ , "age" .= object ["type" .= ("integer" :: Text)]

204+ , "location" .= object ["type" .= ("geo_point" :: Text)]

184− ]

205+ ]]]

185

206

186data TweetMapping = TweetMapping deriving (Eq, Show)

207data TweetMapping = TweetMapping deriving (Eq, Show)

187

208

@@ -585,8 +606,10 @@ noDuplicates xs = nub xs == xs

585instance Arbitrary NominalDiffTime where

606instance Arbitrary NominalDiffTime where

586 arbitrary = fromInteger <$> arbitrary

607 arbitrary = fromInteger <$> arbitrary

587

608

609+#if !MIN_VERSION_QuickCheck(2,8,0)

588instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where

610instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where

589 arbitrary = M.fromList <$> arbitrary

611 arbitrary = M.fromList <$> arbitrary

612+#endif

590

613

591instance Arbitrary Text where

614instance Arbitrary Text where

592 arbitrary = T.pack <$> arbitrary

615 arbitrary = T.pack <$> arbitrary

@@ -882,12 +905,17 @@ main = hspec $ do

882 validateStatus resp 200

905 validateStatus resp 200

883 validateStatus deleteResp 200

906 validateStatus deleteResp 200

884

907

885− describe "error parsing" $ do

908+ describe "error parsing" $ do

886− it "can parse EsErrors" $ withTestEnv $ do

909+ it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do

887 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")

910 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")

888 let errorResp = eitherDecode (responseBody res)

911 let errorResp = eitherDecode (responseBody res)

889 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))

912 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))

890

913

914+ it "can parse EsErrors for >= 2.0" $ when' (atleast es20) $ withTestEnv $ do

915+ res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")

916+ let errorResp = eitherDecode (responseBody res)

917+ liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))

918+

891 describe "document API" $ do

919 describe "document API" $ do

892 it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do

920 it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do

893 _ <- insertData

921 _ <- insertData

@@ -921,8 +949,8 @@ main = hspec $ do

921

949

922 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do

950 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do

923 resetIndex

951 resetIndex

924− _ <- putMapping testIndex (MappingName "parent") ParentMapping

925 _ <- putMapping testIndex (MappingName "child") ChildMapping

952 _ <- putMapping testIndex (MappingName "child") ChildMapping

953+ _ <- putMapping testIndex (MappingName "parent") ParentMapping

926 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")

954 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")

927 let parent = (Just . DocumentParent . DocId) "1"

955 let parent = (Just . DocumentParent . DocId) "1"

928 ids = IndexDocumentSettings NoVersionControl parent

956 ids = IndexDocumentSettings NoVersionControl parent

@@ -1241,6 +1269,17 @@ main = hspec $ do

1241 searchExpectAggs search

1269 searchExpectAggs search

1242 searchValidBucketAgg search "users" toTerms

1270 searchValidBucketAgg search "users" toTerms

1243

1271

1272+ it "returns cardinality aggregation results" $ withTestEnv $ do

1273+ _ <- insertData

1274+ let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"

1275+ let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality

1276+ let search' = search { Database.Bloodhound.from = From 0, size = Size 0 }

1277+ searchExpectAggs search'

1278+ let docCountPair k n = (k, object ["value" .= Number n])

1279+ res <- searchTweets search'

1280+ liftIO $

1281+ fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))

1282+

1244 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do

1283 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do

1245 _ <- insertData

1284 _ <- insertData

1246 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }

1285 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }