git.iko.soy/typeable/bloodhound
on master help sign in
geo distance positive validation
commitd0e07631c5a28caedf9fc3c1438fe5c0a5c42ba2 authorChris Allen <cma@bitemyapp.com> dateThu 10 Apr 2014, 19:01 (13 years ago) parenteb668ce
2 files changed+99−32
Database/Bloodhound/Client.hs+89−32 tests/tests.hs+10
Database/Bloodhound/Client.hs+89−32
@@ -32,6 +32,10 @@ module Database.Bloodhound.Client
3232 , GeoBoundingBoxConstraint(..)
3333 , GeoBoundingBox(..)
3434 , GeoFilterType(..)
35+ , Distance(..)
36+ , DistanceUnit(..)
37+ , DistanceType(..)
38+ , OptimizeBbox(..)
3539 , LatLon(..)
3640 )
3741 where
@@ -45,6 +49,7 @@ import Data.List (intercalate)
4549import Data.Maybe (fromMaybe)
4650import Data.Monoid
4751import Data.Text (Text)
52+import qualified Data.Text as T
4853import Data.Time.Clock (UTCTime)
4954import GHC.Generics (Generic)
5055import Network.HTTP.Conduit
@@ -366,7 +371,7 @@ data Filter = AndFilter [Filter] Cache
366371 | BoolFilter BoolMatch
367372 | ExistsFilter FieldName -- always cached
368373 | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType
369− | GeoDistanceFilter GeoConstraint Distance
374+ | GeoDistanceFilter GeoConstraint Distance DistanceType OptimizeBbox Cache
370375 deriving (Eq, Show)
371376
372377class Monoid a => Seminearring a where
@@ -389,37 +394,86 @@ instance ToJSON Filter where
389394 toJSON (AndFilter filters cache) =
390395 object ["and" .= fmap toJSON filters
391396 , "_cache" .= cache]
397+
392398 toJSON (OrFilter filters cache) =
393399 object ["or" .= fmap toJSON filters
394400 , "_cache" .= cache]
401+
395402 toJSON (IdentityFilter) =
396403 object ["match_all" .= object []]
404+
397405 toJSON (ExistsFilter fieldName) =
398406 object ["exists" .= object
399407 ["field" .= fieldName]]
408+
400409 toJSON (BoolFilter boolMatch) =
401410 object ["bool" .= toJSON boolMatch]
411+
402412 toJSON (GeoBoundingBoxFilter bbConstraint filterType) =
403413 object ["geo_bounding_box" .= toJSON bbConstraint
404414 , "type" .= toJSON filterType]
405415
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+
406460instance ToJSON GeoBoundingBoxConstraint where
407461 toJSON (GeoBoundingBoxConstraint geoBBField constraintBox cache) =
408462 object [geoBBField .= toJSON constraintBox
409− , "_cache" .= cache]
463+ , "_cache" .= cache]
410464
411465instance ToJSON GeoFilterType where
412− toJSON GeoFilterMemory = "memory"
413− toJSON GeoFilterIndexed = "indexed"
466+ toJSON GeoFilterMemory = String "memory"
467+ toJSON GeoFilterIndexed = String "indexed"
414468
415469instance ToJSON GeoBoundingBox where
416470 toJSON (GeoBoundingBox topLeft bottomRight) =
417− object ["top_left" .= toJSON topLeft
471+ object ["top_left" .= toJSON topLeft
418472 , "bottom_right" .= toJSON bottomRight]
419473
420474instance ToJSON LatLon where
421475 toJSON (LatLon lat lon) =
422− object ["lat" .= lat
476+ object ["lat" .= lat
423477 , "lon" .= lon]
424478
425479data Term = Term { termField :: Text
@@ -434,15 +488,16 @@ data BoolMatch = MustMatch Term Cache
434488 | ShouldMatch [Term] Cache deriving (Eq, Show)
435489
436490instance ToJSON BoolMatch where
437− toJSON (MustMatch term cache) = object ["must" .= toJSON term,
438− "_cache" .= cache]
439− toJSON (MustNotMatch term cache) = object ["must_not" .= toJSON term,
440− "_cache" .= cache]
491+ toJSON (MustMatch term cache) = object ["must" .= toJSON term,
492+ "_cache" .= cache]
493+ toJSON (MustNotMatch term cache) = object ["must_not" .= toJSON term,
494+ "_cache" .= cache]
441495 toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
442496 "_cache" .= cache]
443497
444498-- "memory" or "indexed"
445−data GeoFilterType = GeoFilterMemory | GeoFilterIndexed deriving (Eq, Show)
499+data GeoFilterType = GeoFilterMemory
500+ | GeoFilterIndexed deriving (Eq, Show)
446501
447502
448503data LatLon = LatLon { lat :: Double
@@ -453,33 +508,35 @@ data GeoBoundingBox =
453508 , bottomRight :: LatLon } deriving (Eq, Show)
454509
455510data GeoBoundingBoxConstraint =
456− GeoBoundingBoxConstraint { geoBBField :: FieldName
457− , constraintBox :: GeoBoundingBox
458− , cache :: Cache
511+ GeoBoundingBoxConstraint { geoBBField :: FieldName
512+ , constraintBox :: GeoBoundingBox
513+ , bbConstraintcache :: Cache
459514 } deriving (Eq, Show)
460515
461516data GeoConstraint =
462− GeoConstraint { geoField :: FieldName
463− , latLon :: LatLon } deriving (Eq, Show)
464−
465−data DistanceUnits = Miles
466− | Yards
467− | Feet
468− | Inches
469− | Kilometers
470− | Meters
471− | Centimeters
472− | Millimeters
473− | NauticalMiles deriving (Eq, Show)
474−
475−data DistanceType = Arc | SloppyArc | Plane deriving (Eq, Show)
476−
477−-- geo_point?
478−data OptimizeBbox = OptimizeGeoFilterType GeoFilterType | NoOptimizeBbox deriving (Eq, Show)
517+ GeoConstraint { geoField :: FieldName
518+ , latLon :: LatLon} deriving (Eq, Show)
519+
520+data DistanceUnit = Miles
521+ | Yards
522+ | Feet
523+ | Inches
524+ | Kilometers
525+ | Meters
526+ | Centimeters
527+ | Millimeters
528+ | NauticalMiles deriving (Eq, Show)
529+
530+data DistanceType = Arc
531+ | SloppyArc -- doesn't exist <1.0
532+ | Plane deriving (Eq, Show)
533+
534+data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
535+ | NoOptimizeBbox deriving (Eq, Show)
479536
480537data Distance =
481538 Distance { coefficient :: Double
482− , unit :: DistanceUnits } deriving (Eq, Show)
539+ , unit :: DistanceUnit } deriving (Eq, Show)
483540
484541data FromJSON a => SearchResult a =
485542 SearchResult { took :: Int
tests/tests.hs+10
@@ -121,3 +121,13 @@ main = hspec $ do
121121 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
122122 let emptyHits = fmap (hits . searchHits) result
123123 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