55783a2 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

Merge pull request #15 from latkins/master

55783a2Chris Allen12 years ago

Database/Bloodhound/Types.hs+42−39

compare with master

unifiedsplit

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

1−{-# LANGUAGE DeriveGeneric #-}

1+{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE RecordWildCards #-}

4{-| Data types for describing actions and data structures performed to interact

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

22 , mkBoolQuery

23 , mkRangeQuery

24 , mkQueryStringQuery

25+ , omitNulls

25 , Version(..)

26 , Version(..)

26 , Status(..)

27 , Status(..)

27 , Existence(..)

28 , Existence(..)

@@ -144,20 +145,21 @@ module Database.Bloodhound.Types

144 , ToJSON(..)

145 , ToJSON(..)

145 ) where

146 ) where

146

147

147−import Control.Applicative

148+import Control.Applicative

148−import Data.Aeson

149+import Data.Aeson

149−import qualified Data.ByteString.Lazy.Char8 as L

150+import qualified Data.ByteString.Lazy.Char8 as L

150−import Data.List (nub)

151+import Data.List (nub)

151−import Data.List.NonEmpty (NonEmpty(..))

152+import Data.List.NonEmpty (NonEmpty (..))

152−import Data.Monoid

153+import Data.Monoid

153−import Data.Text (Text)

154+import Data.Text (Text)

154−import qualified Data.Text as T

155+import qualified Data.Text as T

155−import Data.Time.Clock (UTCTime)

156+import Data.Time.Clock (UTCTime)

157+import qualified Data.Vector as V

156−import GHC.Generics (Generic)

158+import GHC.Generics (Generic)

157−import Network.HTTP.Client

159+import Network.HTTP.Client

158−import qualified Network.HTTP.Types.Method as NHTM

160+import qualified Network.HTTP.Types.Method as NHTM

159

161

160−import Database.Bloodhound.Types.Class

162+import Database.Bloodhound.Types.Class

161

163

162

164

163{-| 'Version' is embedded in 'Status' -}

165{-| 'Version' is embedded in 'Status' -}

@@ -215,8 +217,8 @@ data FieldDefinition =

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

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

216

218

217data MappingField =

219data MappingField =

218− MappingField { mappingFieldName :: FieldName

220+ MappingField { mappingFieldName :: FieldName

219− , fieldDefinition :: FieldDefinition } deriving (Eq, Show)

221+ , fieldDefinition :: FieldDefinition } deriving (Eq, Show)

220

222

221{-| Support for type reification of 'Mapping's is currently incomplete, for

223{-| Support for type reification of 'Mapping's is currently incomplete, for

222 now the mapping API verbiage expects a 'ToJSON'able blob.

224 now the mapping API verbiage expects a 'ToJSON'able blob.

@@ -471,13 +473,13 @@ type TrackSortScores = Bool

471type From = Int

473type From = Int

472type Size = Int

474type Size = Int

473

475

474−data Search = Search { queryBody :: Maybe Query

476+data Search = Search { queryBody :: Maybe Query

475− , filterBody :: Maybe Filter

477+ , filterBody :: Maybe Filter

476− , sortBody :: Maybe Sort

478+ , sortBody :: Maybe Sort

477 -- default False

479 -- default False

478 , trackSortScores :: TrackSortScores

480 , trackSortScores :: TrackSortScores

479− , from :: From

481+ , from :: From

480− , size :: Size } deriving (Eq, Show)

482+ , size :: Size } deriving (Eq, Show)

481

483

482data Query =

484data Query =

483 TermQuery Term (Maybe Boost)

485 TermQuery Term (Maybe Boost)

@@ -510,10 +512,10 @@ data Query =

510 deriving (Eq, Show)

512 deriving (Eq, Show)

511

513

512data RegexpQuery =

514data RegexpQuery =

513− RegexpQuery { regexpQueryField :: FieldName

515+ RegexpQuery { regexpQueryField :: FieldName

514− , regexpQuery :: Regexp

516+ , regexpQuery :: Regexp

515− , regexpQueryFlags :: RegexpFlags

517+ , regexpQueryFlags :: RegexpFlags

516− , regexpQueryBoost :: Maybe Boost

518+ , regexpQueryBoost :: Maybe Boost

517 } deriving (Eq, Show)

519 } deriving (Eq, Show)

518

520

519data RangeQuery =

521data RangeQuery =

@@ -633,9 +635,9 @@ data MoreLikeThisQuery =

633data IndicesQuery =

635data IndicesQuery =

634 IndicesQuery

636 IndicesQuery

635 { indicesQueryIndices :: [IndexName]

637 { indicesQueryIndices :: [IndexName]

636− , indicesQuery :: Query

638+ , indicesQuery :: Query

637 -- default "all"

639 -- default "all"

638− , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show)

640+ , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show)

639

641

640data HasParentQuery =

642data HasParentQuery =

641 HasParentQuery

643 HasParentQuery

@@ -752,15 +754,15 @@ data MultiMatchQueryType =

752 | MultiMatchPhrasePrefix deriving (Eq, Show)

754 | MultiMatchPhrasePrefix deriving (Eq, Show)

753

755

754data BoolQuery =

756data BoolQuery =

755− BoolQuery { boolQueryMustMatch :: Maybe Query

757+ BoolQuery { boolQueryMustMatch :: [Query]

756− , boolQueryMustNotMatch :: Maybe Query

758+ , boolQueryMustNotMatch :: [Query]

757− , boolQueryShouldMatch :: Maybe [Query]

759+ , boolQueryShouldMatch :: [Query]

758 , boolQueryMinimumShouldMatch :: Maybe MinimumMatch

760 , boolQueryMinimumShouldMatch :: Maybe MinimumMatch

759 , boolQueryBoost :: Maybe Boost

761 , boolQueryBoost :: Maybe Boost

760 , boolQueryDisableCoord :: Maybe DisableCoord

762 , boolQueryDisableCoord :: Maybe DisableCoord

761 } deriving (Eq, Show)

763 } deriving (Eq, Show)

762

764

763−mkBoolQuery :: Maybe Query -> Maybe Query -> Maybe [Query] -> BoolQuery

765+mkBoolQuery :: [Query] -> [Query] -> [Query] -> BoolQuery

764mkBoolQuery must mustNot should =

766mkBoolQuery must mustNot should =

765 BoolQuery must mustNot should Nothing Nothing Nothing

767 BoolQuery must mustNot should Nothing Nothing Nothing

766

768

@@ -787,7 +789,7 @@ data CommonMinimumMatch =

787 deriving (Eq, Show)

789 deriving (Eq, Show)

788

790

789data MinimumMatchHighLow =

791data MinimumMatchHighLow =

790− MinimumMatchHighLow { lowFreq :: MinimumMatch

792+ MinimumMatchHighLow { lowFreq :: MinimumMatch

791 , highFreq :: MinimumMatch } deriving (Eq, Show)

793 , highFreq :: MinimumMatch } deriving (Eq, Show)

792

794

793data Filter = AndFilter [Filter] Cache

795data Filter = AndFilter [Filter] Cache

@@ -926,11 +928,11 @@ data FromJSON a => SearchHits a =

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

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

927

929

928data FromJSON a => Hit a =

930data FromJSON a => Hit a =

929− Hit { hitIndex :: IndexName

931+ Hit { hitIndex :: IndexName

930− , hitType :: MappingName

932+ , hitType :: MappingName

931− , hitDocId :: DocId

933+ , hitDocId :: DocId

932− , hitScore :: Score

934+ , hitScore :: Score

933− , hitSource :: a } deriving (Eq, Show)

935+ , hitSource :: a } deriving (Eq, Show)

934

936

935data ShardResult =

937data ShardResult =

936 ShardResult { shardTotal :: Int

938 ShardResult { shardTotal :: Int

@@ -1152,8 +1154,9 @@ instance ToJSON Query where

1152

1154

1153omitNulls :: [(Text, Value)] -> Value

1155omitNulls :: [(Text, Value)] -> Value

1154omitNulls = object . filter notNull where

1156omitNulls = object . filter notNull where

1155− notNull (_, Null) = False

1157+ notNull (_, Null) = False

1158+ notNull (_, (Array a)) = (not . V.null) a

1156− notNull _ = True

1159+ notNull _ = True

1157

1160

1158

1161

1159instance ToJSON SimpleQueryStringQuery where

1162instance ToJSON SimpleQueryStringQuery where

README.org+1−1

@@ -386,7 +386,7 @@ let search = mkSearch (Just query) Nothing

386let innerQuery = QueryMatchQuery $

387 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")

388let query = QueryBoolQuery $

389− mkBoolQuery (Just innerQuery) Nothing Nothing

389+ mkBoolQuery [innerQuery] [] []

390let search = mkSearch (Just query) Nothing

391

392#+END_SRC

bloodhound.cabal+5−2

@@ -31,7 +31,8 @@ library

31 semigroups >= 0.15,

32 time >= 1.4,

33 text >= 0.11,

34− http-types >= 0.8

34+ http-types >= 0.8,

35+ vector >= 0.10.11

35 default-language: Haskell2010

36 default-language: Haskell2010

37test-suite tests

38test-suite tests

@@ -49,5 +50,7 @@ test-suite tests

49 time >= 1.4,

50 time >= 1.4,

50 aeson >= 0.7,

51 aeson >= 0.7,

51 semigroups >= 0.15,

52 semigroups >= 0.15,

52− QuickCheck

53+ QuickCheck,

54+ vector >= 0.10.11,

55+ unordered-containers >=0.2.5.0

53 default-language: Haskell2010

56 default-language: Haskell2010

tests/tests.hs+41−17

@@ -1,24 +1,26 @@

1−{-# LANGUAGE DeriveGeneric #-}

1+{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE ScopedTypeVariables #-}

4module Main where

6−import Control.Applicative

6+import Control.Applicative

7−import Database.Bloodhound

8−import Data.Aeson

7+import Data.Aeson

8+import Data.HashMap.Strict (fromList)

9−import Data.List (nub)

9+import Data.List (nub)

10−import Data.List.NonEmpty (NonEmpty(..))

10+import Data.List.NonEmpty (NonEmpty (..))

11+import Data.Text (Text)

12+import qualified Data.Text as T

11−import Data.Time.Calendar (Day(..))

13+import Data.Time.Calendar (Day (..))

12−import Data.Time.Clock (secondsToDiffTime, UTCTime(..))

14+import Data.Time.Clock (UTCTime (..), secondsToDiffTime)

13−import Data.Text (Text)

14−import qualified Data.Text as T

15+import qualified Data.Vector as V

16+import Database.Bloodhound

15−import GHC.Generics (Generic)

17+import GHC.Generics (Generic)

16−import Network.HTTP.Client

18+import Network.HTTP.Client

17import qualified Network.HTTP.Types.Status as NHTS

19import qualified Network.HTTP.Types.Status as NHTS

18−import Prelude hiding (filter, putStrLn)

20+import Prelude hiding (filter, putStrLn)

19−import Test.Hspec

21+import Test.Hspec

20−import Test.Hspec.QuickCheck (prop)

22+import Test.Hspec.QuickCheck (prop)

21−import Test.QuickCheck

23+import Test.QuickCheck

23testServer :: Server

25testServer :: Server

24testServer = Server "http://localhost:9200"

26testServer = Server "http://localhost:9200"

@@ -203,7 +205,7 @@ main = hspec $ do

203 let innerQuery = QueryMatchQuery $

205 let innerQuery = QueryMatchQuery $

204 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")

206 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")

205 let query = QueryBoolQuery $

207 let query = QueryBoolQuery $

206− mkBoolQuery (Just innerQuery) Nothing Nothing

208+ mkBoolQuery [innerQuery] [] []

207 let search = mkSearch (Just query) Nothing

209 let search = mkSearch (Just query) Nothing

208 myTweet <- searchTweet search

210 myTweet <- searchTweet search

209 myTweet `shouldBe` Right exampleTweet

211 myTweet `shouldBe` Right exampleTweet

@@ -382,3 +384,25 @@ main = hspec $ do

382 let String str = toJSON flags

384 let String str = toJSON flags

383 flagStrs = T.splitOn "|" str

385 flagStrs = T.splitOn "|" str

384 in noDuplicates flagStrs

386 in noDuplicates flagStrs

387+

388+

389+ describe "omitNulls" $ do

390+ it "checks that omitNulls drops list elements when it should" $

391+ let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))

392+ , "test2" .= (toJSON ("some value" :: Text))]

393+ in dropped `shouldBe` Object (fromList [("test2", String "some value")])

394+

395+ it "checks that omitNulls doesn't drop list elements when it shouldn't" $

396+ let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))

397+ , "test2" .= (toJSON ("some value" :: Text))]

398+ in notDropped `shouldBe` Object (fromList [ ("test1", Array (V.fromList [Number 1.0]))

399+ , ("test2", String "some value")])

400+ it "checks that omitNulls drops non list elements when it should" $

401+ let dropped = omitNulls $ [ "test1" .= (toJSON Null)

402+ , "test2" .= (toJSON ("some value" :: Text))]

403+ in dropped `shouldBe` Object (fromList [("test2", String "some value")])

404+ it "checks that omitNulls doesn't drop non list elements when it shouldn't" $

405+ let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))

406+ , "test2" .= (toJSON ("some value" :: Text))]

407+ in notDropped `shouldBe` Object (fromList [ ("test1", Number 1.0)

408+ , ("test2", String "some value")])