git.iko.soy/typeable/bloodhound
on master help sign in
Merge branch 'master' of github.com:bitemyapp/bloodhound
commit57a7ee3b64c0858c0e64f4478d2a3f08d38ee643 authorChris Allen <cma@bitemyapp.com> dateFri 20 Jun 2014, 11:22 (12 years ago) parent5558959411069f
4 files changed+81−9
Database/Bloodhound/Types.hs+13−1 Database/Bloodhound/Types/Instances.hs+15−5 bloodhound.cabal+4−1 tests/tests.hs+49−2
Database/Bloodhound/Types.hs+13−1
@@ -60,6 +60,7 @@ module Database.Bloodhound.Types
6060 , GreaterThanEq(..)
6161 , Regexp(..)
6262 , RegexpFlags(..)
63+ , RegexpFlag(..)
6364 , FieldName(..)
6465 , IndexName(..)
6566 , MappingName(..)
@@ -144,6 +145,7 @@ module Database.Bloodhound.Types
144145
145146import Data.Aeson
146147import qualified Data.ByteString.Lazy.Char8 as L
148+import Data.List.NonEmpty (NonEmpty)
147149import Data.Text (Text)
148150import qualified Data.Text as T
149151import Data.Time.Clock (UTCTime)
@@ -824,7 +826,17 @@ data RangeExecution = RangeExecutionIndex
824826 | RangeExecutionFielddata deriving (Eq, Show)
825827
826828newtype Regexp = Regexp Text deriving (Eq, Show)
827−newtype RegexpFlags = RegexpFlags Text deriving (Eq, Show)
829+
830+data RegexpFlags = AllRegexpFlags
831+ | NoRegexpFlags
832+ | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show)
833+
834+data RegexpFlag = AnyString
835+ | Automaton
836+ | Complement
837+ | Empty
838+ | Intersection
839+ | Interval deriving (Eq, Show)
828840
829841halfRangeToKV :: HalfRange -> (Text, Double)
830842halfRangeToKV (HalfRangeLt (LessThan n)) = ("lt", n)
Database/Bloodhound/Types/Instances.hs+15−5
@@ -8,6 +8,8 @@ module Database.Bloodhound.Types.Instances
88
99import Control.Applicative
1010import Data.Aeson
11+import Data.List (nub)
12+import Data.List.NonEmpty (NonEmpty(..))
1113import Data.Maybe (catMaybes)
1214import Data.Monoid
1315import qualified Data.Text as T
@@ -57,7 +59,7 @@ instance ToJSON Filter where
5759 , "distance_type" .= toJSON distanceType
5860 , "optimize_bbox" .= optimizeBbox
5961 , distanceGeoField .= toJSON geoDistLatLon
60− , "_cache" .= cache]]
62+ , "_cache" .= cache]]
6163
6264 toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
6365 (DistanceRange geoDistRangeDistFrom drDistanceTo)) =
@@ -213,7 +215,7 @@ instance ToJSON Query where
213215 toJSON (QueryRangeQuery query) =
214216 object [ "range" .= toJSON query ]
215217
216− toJSON (QueryRegexpQuery query) =
218+ toJSON (QueryRegexpQuery query) =
217219 object [ "regexp" .= toJSON query ]
218220
219221 toJSON (QuerySimpleQueryStringQuery query) =
@@ -645,7 +647,7 @@ instance ToJSON SortSpec where
645647
646648
647649instance ToJSON SortOrder where
648− toJSON Ascending = String "asc"
650+ toJSON Ascending = String "asc"
649651 toJSON Descending = String "desc"
650652
651653
@@ -731,8 +733,16 @@ instance ToJSON RangeExecution where
731733
732734
733735instance ToJSON RegexpFlags where
734− toJSON (RegexpFlags txt) = String txt
735−
736+ toJSON AllRegexpFlags = String "ALL"
737+ toJSON NoRegexpFlags = String "NONE"
738+ toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
739+ where flagStrs = map flagStr . nub $ h:fs
740+ flagStr AnyString = "ANYSTRING"
741+ flagStr Automaton = "AUTOMATON"
742+ flagStr Complement = "COMPLEMENT"
743+ flagStr Empty = "EMPTY"
744+ flagStr Intersection = "INTERSECTION"
745+ flagStr Interval = "INTERVAL"
736746
737747instance ToJSON Term where
738748 toJSON (Term field value) = object ["term" .= object
bloodhound.cabal+4−1
@@ -29,6 +29,7 @@ library
2929 aeson >= 0.7,
3030 conduit >= 1.0,
3131 http-client >= 0.3,
32+ semigroups >= 0.15,
3233 time >= 1.4,
3334 text >= 0.11,
3435 http-types >= 0.8
@@ -47,5 +48,7 @@ test-suite tests
4748 hspec >= 1.8,
4849 text >= 0.11,
4950 time >= 1.4,
50− aeson >= 0.7
51+ aeson >= 0.7,
52+ semigroups >= 0.15,
53+ QuickCheck
5154 default-language: Haskell2010
tests/tests.hs+49−2
@@ -1,17 +1,24 @@
11{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
23
34module Main where
45
6+import Control.Applicative
57import Database.Bloodhound
68import Data.Aeson
9+import Data.List (nub)
10+import Data.List.NonEmpty (NonEmpty(..))
711import Data.Time.Calendar (Day(..))
812import Data.Time.Clock (secondsToDiffTime, UTCTime(..))
913import Data.Text (Text)
14+import qualified Data.Text as T
1015import GHC.Generics (Generic)
1116import Network.HTTP.Client
1217import qualified Network.HTTP.Types.Status as NHTS
1318import Prelude hiding (filter, putStrLn)
1419import Test.Hspec
20+import Test.Hspec.QuickCheck (prop)
21+import Test.QuickCheck
1522
1623testServer :: Server
1724testServer = Server "http://localhost:9200"
@@ -104,6 +111,27 @@ data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
104111instance FromJSON BulkTest
105112instance ToJSON BulkTest
106113
114+noDuplicates :: Eq a => [a] -> Bool
115+noDuplicates xs = nub xs == xs
116+
117+instance Arbitrary RegexpFlags where
118+ arbitrary = oneof [ pure AllRegexpFlags
119+ , pure NoRegexpFlags
120+ , SomeRegexpFlags <$> arbitrary
121+ ]
122+
123+instance Arbitrary a => Arbitrary (NonEmpty a) where
124+ arbitrary = liftA2 (:|) arbitrary arbitrary
125+
126+instance Arbitrary RegexpFlag where
127+ arbitrary = oneof [ pure AnyString
128+ , pure Automaton
129+ , pure Complement
130+ , pure Empty
131+ , pure Intersection
132+ , pure Interval
133+ ]
134+
107135main :: IO ()
108136main = hspec $ do
109137
@@ -314,7 +342,7 @@ main = hspec $ do
314342 it "returns document for regexp filter" $ do
315343 _ <- insertData
316344 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
317− (RegexpFlags "ALL") (CacheName "test") False (CacheKey "key")
345+ AllRegexpFlags (CacheName "test") False (CacheKey "key")
318346 let search = mkSearch Nothing (Just filter)
319347 myTweet <- searchTweet search
320348 myTweet `shouldBe` Right exampleTweet
@@ -322,7 +350,26 @@ main = hspec $ do
322350 it "doesn't return document for non-matching regexp filter" $ do
323351 _ <- insertData
324352 let filter = RegexpFilter (FieldName "user")
325− (Regexp "boy") (RegexpFlags "ALL")
353+ (Regexp "boy") AllRegexpFlags
326354 (CacheName "test") False (CacheKey "key")
327355 let search = mkSearch Nothing (Just filter)
328356 searchExpectNoResults search
357+ describe "ToJSON RegexpFlags" $ do
358+ it "generates the correct JSON for AllRegexpFlags" $
359+ toJSON AllRegexpFlags `shouldBe` String "ALL"
360+
361+ it "generates the correct JSON for NoRegexpFlags" $
362+ toJSON NoRegexpFlags `shouldBe` String "NONE"
363+
364+ it "generates the correct JSON for SomeRegexpFlags" $
365+ let flags = AnyString :| [ Automaton
366+ , Complement
367+ , Empty
368+ , Intersection
369+ , Interval ]
370+ in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
371+
372+ prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
373+ let String str = toJSON flags
374+ flagStrs = T.splitOn "|" str
375+ in noDuplicates flagStrs