git.iko.soy/typeable/bloodhound
on master help sign in
geo distance positive validation
d0e0763Chris Allen
Database/Bloodhound/Client.hs+89−32
compare with master
unifiedsplit
@@ -32,6 +32,10 @@ module Database.Bloodhound.Client
32 , GeoBoundingBoxConstraint(..)
32 , GeoBoundingBoxConstraint(..)
33 , GeoBoundingBox(..)
33 , GeoBoundingBox(..)
34 , GeoFilterType(..)
34 , GeoFilterType(..)
35+ , Distance(..)
36+ , DistanceUnit(..)
37+ , DistanceType(..)
38+ , OptimizeBbox(..)
35 , LatLon(..)
39 , LatLon(..)
36 )
40 )
37 where
41 where
@@ -45,6 +49,7 @@ import Data.List (intercalate)
45import Data.Maybe (fromMaybe)
49import Data.Maybe (fromMaybe)
46import Data.Monoid
50import Data.Monoid
47import Data.Text (Text)
51import Data.Text (Text)
52+import qualified Data.Text as T
48import Data.Time.Clock (UTCTime)
53import Data.Time.Clock (UTCTime)
49import GHC.Generics (Generic)
54import GHC.Generics (Generic)
50import Network.HTTP.Conduit
55import Network.HTTP.Conduit
@@ -366,7 +371,7 @@ data Filter = AndFilter [Filter] Cache
366 | BoolFilter BoolMatch
371 | BoolFilter BoolMatch
367 | ExistsFilter FieldName -- always cached
372 | ExistsFilter FieldName -- always cached
368 | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType
373 | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType
369− | GeoDistanceFilter GeoConstraint Distance
374+ | GeoDistanceFilter GeoConstraint Distance DistanceType OptimizeBbox Cache
370 deriving (Eq, Show)
375 deriving (Eq, Show)
371
376
372class Monoid a => Seminearring a where
377class Monoid a => Seminearring a where
@@ -389,37 +394,86 @@ instance ToJSON Filter where
389 toJSON (AndFilter filters cache) =
394 toJSON (AndFilter filters cache) =
390 object ["and" .= fmap toJSON filters
395 object ["and" .= fmap toJSON filters
391 , "_cache" .= cache]
396 , "_cache" .= cache]
397+
392 toJSON (OrFilter filters cache) =
398 toJSON (OrFilter filters cache) =
393 object ["or" .= fmap toJSON filters
399 object ["or" .= fmap toJSON filters
394 , "_cache" .= cache]
400 , "_cache" .= cache]
401+
395 toJSON (IdentityFilter) =
402 toJSON (IdentityFilter) =
396 object ["match_all" .= object []]
403 object ["match_all" .= object []]
404+
397 toJSON (ExistsFilter fieldName) =
405 toJSON (ExistsFilter fieldName) =
398 object ["exists" .= object
406 object ["exists" .= object
399 ["field" .= fieldName]]
407 ["field" .= fieldName]]
408+
400 toJSON (BoolFilter boolMatch) =
409 toJSON (BoolFilter boolMatch) =
401 object ["bool" .= toJSON boolMatch]
410 object ["bool" .= toJSON boolMatch]
411+
402 toJSON (GeoBoundingBoxFilter bbConstraint filterType) =
412 toJSON (GeoBoundingBoxFilter bbConstraint filterType) =
403 object ["geo_bounding_box" .= toJSON bbConstraint
413 object ["geo_bounding_box" .= toJSON bbConstraint
404 , "type" .= toJSON filterType]
414 , "type" .= toJSON filterType]
405
415
416+ toJSON (GeoDistanceFilter (GeoConstraint geoField latLon)
417+ distance distanceType optimizeBbox cache) =
418+ object ["geo_distance" .=
419+ object ["distance" .= toJSON distance
420+ , "distance_type" .= toJSON distanceType
421+ , "optimize_bbox" .= optimizeBbox
422+ , geoField .= toJSON latLon
423+ , "_cache" .= cache
424+ ]]
425+
426+instance ToJSON GeoConstraint where
427+ toJSON (GeoConstraint geoField latLon) =
428+ object [geoField .= toJSON latLon]
429+
430+showText :: Show a => a -> Text
431+showText = T.pack . show
432+
433+instance ToJSON Distance where
434+ toJSON (Distance coefficient unit) =
435+ String boltedTogether where
436+ coefText = showText coefficient
437+ (String unitText) = (toJSON unit)
438+ boltedTogether = mappend coefText unitText
439+
440+instance ToJSON DistanceUnit where
441+ toJSON Miles = String "mi"
442+ toJSON Yards = String "yd"
443+ toJSON Feet = String "ft"
444+ toJSON Inches = String "in"
445+ toJSON Kilometers = String "km"
446+ toJSON Meters = String "m"
447+ toJSON Centimeters = String "cm"
448+ toJSON Millimeters = String "mm"
449+ toJSON NauticalMiles = String "nmi"
450+
451+instance ToJSON DistanceType where
452+ toJSON Arc = String "arc"
453+ toJSON SloppyArc = String "sloppy_arc"
454+ toJSON Plane = String "plane"
455+
456+instance ToJSON OptimizeBbox where
457+ toJSON NoOptimizeBbox = String "none"
458+ toJSON (OptimizeGeoFilterType gft) = toJSON gft
459+
406instance ToJSON GeoBoundingBoxConstraint where
460instance ToJSON GeoBoundingBoxConstraint where
407 toJSON (GeoBoundingBoxConstraint geoBBField constraintBox cache) =
461 toJSON (GeoBoundingBoxConstraint geoBBField constraintBox cache) =
408 object [geoBBField .= toJSON constraintBox
462 object [geoBBField .= toJSON constraintBox
409− , "_cache" .= cache]
463+ , "_cache" .= cache]
410
464
411instance ToJSON GeoFilterType where
465instance ToJSON GeoFilterType where
412− toJSON GeoFilterMemory = "memory"
466+ toJSON GeoFilterMemory = String "memory"
413− toJSON GeoFilterIndexed = "indexed"
467+ toJSON GeoFilterIndexed = String "indexed"
414
468
415instance ToJSON GeoBoundingBox where
469instance ToJSON GeoBoundingBox where
416 toJSON (GeoBoundingBox topLeft bottomRight) =
470 toJSON (GeoBoundingBox topLeft bottomRight) =
417− object ["top_left" .= toJSON topLeft
471+ object ["top_left" .= toJSON topLeft
418 , "bottom_right" .= toJSON bottomRight]
472 , "bottom_right" .= toJSON bottomRight]
419
473
420instance ToJSON LatLon where
474instance ToJSON LatLon where
421 toJSON (LatLon lat lon) =
475 toJSON (LatLon lat lon) =
422− object ["lat" .= lat
476+ object ["lat" .= lat
423 , "lon" .= lon]
477 , "lon" .= lon]
424
478
425data Term = Term { termField :: Text
479data Term = Term { termField :: Text
@@ -434,15 +488,16 @@ data BoolMatch = MustMatch Term Cache
434 | ShouldMatch [Term] Cache deriving (Eq, Show)
488 | ShouldMatch [Term] Cache deriving (Eq, Show)
435
489
436instance ToJSON BoolMatch where
490instance ToJSON BoolMatch where
437− toJSON (MustMatch term cache) = object ["must" .= toJSON term,
491+ toJSON (MustMatch term cache) = object ["must" .= toJSON term,
438− "_cache" .= cache]
492+ "_cache" .= cache]
439− toJSON (MustNotMatch term cache) = object ["must_not" .= toJSON term,
493+ toJSON (MustNotMatch term cache) = object ["must_not" .= toJSON term,
440− "_cache" .= cache]
494+ "_cache" .= cache]
441 toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
495 toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
442 "_cache" .= cache]
496 "_cache" .= cache]
443
497
444-- "memory" or "indexed"
498-- "memory" or "indexed"
445−data GeoFilterType = GeoFilterMemory | GeoFilterIndexed deriving (Eq, Show)
499+data GeoFilterType = GeoFilterMemory
500+ | GeoFilterIndexed deriving (Eq, Show)
446
501
447
502
448data LatLon = LatLon { lat :: Double
503data LatLon = LatLon { lat :: Double
@@ -453,33 +508,35 @@ data GeoBoundingBox =
453 , bottomRight :: LatLon } deriving (Eq, Show)
508 , bottomRight :: LatLon } deriving (Eq, Show)
454
509
455data GeoBoundingBoxConstraint =
510data GeoBoundingBoxConstraint =
456− GeoBoundingBoxConstraint { geoBBField :: FieldName
511+ GeoBoundingBoxConstraint { geoBBField :: FieldName
457− , constraintBox :: GeoBoundingBox
512+ , constraintBox :: GeoBoundingBox
458− , cache :: Cache
513+ , bbConstraintcache :: Cache
459 } deriving (Eq, Show)
514 } deriving (Eq, Show)
460
515
461data GeoConstraint =
516data GeoConstraint =
462− GeoConstraint { geoField :: FieldName
517+ GeoConstraint { geoField :: FieldName
463− , latLon :: LatLon } deriving (Eq, Show)
518+ , latLon :: LatLon} deriving (Eq, Show)
464−
519+
465−data DistanceUnits = Miles
520+data DistanceUnit = Miles
466− | Yards
521+ | Yards
467− | Feet
522+ | Feet
468− | Inches
523+ | Inches
469− | Kilometers
524+ | Kilometers
470− | Meters
525+ | Meters
471− | Centimeters
526+ | Centimeters
472− | Millimeters
527+ | Millimeters
473− | NauticalMiles deriving (Eq, Show)
528+ | NauticalMiles deriving (Eq, Show)
474−
529+
475−data DistanceType = Arc | SloppyArc | Plane deriving (Eq, Show)
530+data DistanceType = Arc
476−
531+ | SloppyArc -- doesn't exist <1.0
477−-- geo_point?
532+ | Plane deriving (Eq, Show)
533+
478−data OptimizeBbox = OptimizeGeoFilterType GeoFilterType | NoOptimizeBbox deriving (Eq, Show)
534+data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
535+ | NoOptimizeBbox deriving (Eq, Show)
479
536
480data Distance =
537data Distance =
481 Distance { coefficient :: Double
538 Distance { coefficient :: Double
482− , unit :: DistanceUnits } deriving (Eq, Show)
539+ , unit :: DistanceUnit } deriving (Eq, Show)
483
540
484data FromJSON a => SearchResult a =
541data FromJSON a => SearchResult a =
485 SearchResult { took :: Int
542 SearchResult { took :: Int
tests/tests.hs+10
@@ -121,3 +121,13 @@ main = hspec $ do
121 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
121 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
122 let emptyHits = fmap (hits . searchHits) result
122 let emptyHits = fmap (hits . searchHits) result
123 emptyHits `shouldBe` Right []
123 emptyHits `shouldBe` Right []
124+
125+ it "returns document for geo distance query" $ do
126+ _ <- insertData
127+ let geoConstraint = GeoConstraint "tweet.location" (LatLon 40.12 (-71.34))
128+ let distance = Distance 10.0 Miles
129+ let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
130+ let geoFilter = GeoDistanceFilter geoConstraint distance SloppyArc optimizeBbox False
131+ let search = Search Nothing (Just geoFilter)
132+ myTweet <- searchTweet search
133+ myTweet `shouldBe` Right exampleTweet