git.iko.soy/typeable/bloodhound
on master help sign in
dated ranges, out with the old
cebfe79Alex K
src/Database/Bloodhound/Types.hs+44−118
compare with master
unifiedsplit
@@ -24,9 +24,7 @@
24module Database.Bloodhound.Types
24module Database.Bloodhound.Types
25 ( defaultCache
25 ( defaultCache
26 , defaultIndexSettings
26 , defaultIndexSettings
27− , halfRangeToKV
28 , mkSort
27 , mkSort
29− , rangeToKV
30 , showText
28 , showText
31 , unpackId
29 , unpackId
32 , mkMatchQuery
30 , mkMatchQuery
@@ -69,10 +67,7 @@ module Database.Bloodhound.Types
69 , DistanceRange(..)
67 , DistanceRange(..)
70 , OptimizeBbox(..)
68 , OptimizeBbox(..)
71 , LatLon(..)
69 , LatLon(..)
72− , Range(..)
70+ , RangeValue(..)
73− , RangeDouble(..)
74− , RangeText(..)
75− , HalfRange(..)
76 , RangeExecution(..)
71 , RangeExecution(..)
77 , LessThan(..)
72 , LessThan(..)
78 , LessThanEq(..)
73 , LessThanEq(..)
@@ -637,10 +632,10 @@ data RegexpQuery =
637
632
638data RangeQuery =
633data RangeQuery =
639 RangeQuery { rangeQueryField :: FieldName
634 RangeQuery { rangeQueryField :: FieldName
640− , rangeQueryRange :: Either HalfRange Range
635+ , rangeQueryRange :: RangeValue
641 , rangeQueryBoost :: Boost } deriving (Eq, Show)
636 , rangeQueryBoost :: Boost } deriving (Eq, Show)
642
637
643−mkRangeQuery :: FieldName -> Either HalfRange Range -> RangeQuery
638+mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
644mkRangeQuery f r = RangeQuery f r (Boost 1.0)
639mkRangeQuery f r = RangeQuery f r (Boost 1.0)
645
640
646data SimpleQueryStringQuery =
641data SimpleQueryStringQuery =
@@ -923,9 +918,7 @@ data Filter = AndFilter [Filter] Cache
923 | LimitFilter Int
918 | LimitFilter Int
924 | MissingFilter FieldName Existence NullValue
919 | MissingFilter FieldName Existence NullValue
925 | PrefixFilter FieldName PrefixValue Cache
920 | PrefixFilter FieldName PrefixValue Cache
926− | RangeFilter FieldName (Either HalfRange Range) RangeExecution Cache
921+ | RangeFilter FieldName RangeValue RangeExecution Cache
927− | RangeFilterText FieldName RangeText RangeExecution Cache
928− | RangeFilterDouble FieldName RangeDouble RangeExecution Cache
929 | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey
922 | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey
930 | TermFilter Term Cache
923 | TermFilter Term Cache
931 deriving (Eq, Show)
924 deriving (Eq, Show)
@@ -933,22 +926,6 @@ data Filter = AndFilter [Filter] Cache
933data ZeroTermsQuery = ZeroTermsNone
926data ZeroTermsQuery = ZeroTermsNone
934 | ZeroTermsAll deriving (Eq, Show)
927 | ZeroTermsAll deriving (Eq, Show)
935
928
936−-- lt, lte | gt, gte
937−newtype LessThan = LessThan Double deriving (Eq, Show)
938−newtype LessThanEq = LessThanEq Double deriving (Eq, Show)
939−newtype GreaterThan = GreaterThan Double deriving (Eq, Show)
940−newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Show)
941−
942−data HalfRange = HalfRangeLt LessThan
943− | HalfRangeLte LessThanEq
944− | HalfRangeGt GreaterThan
945− | HalfRangeGte GreaterThanEq deriving (Eq, Show)
946−
947−data Range = RangeLtGt LessThan GreaterThan
948− | RangeLtGte LessThan GreaterThanEq
949− | RangeLteGt LessThanEq GreaterThan
950− | RangeLteGte LessThanEq GreaterThanEq deriving (Eq, Show)
951−
952data RangeExecution = RangeExecutionIndex
929data RangeExecution = RangeExecutionIndex
953 | RangeExecutionFielddata deriving (Eq, Show)
930 | RangeExecutionFielddata deriving (Eq, Show)
954
931
@@ -965,41 +942,42 @@ data RegexpFlag = AnyString
965 | Intersection
942 | Intersection
966 | Interval deriving (Eq, Show)
943 | Interval deriving (Eq, Show)
967
944
968−halfRangeToKV :: HalfRange -> (Text, Double)
945+data RangeValue = RangeDateLte UTCTime
969−halfRangeToKV (HalfRangeLt (LessThan n)) = ("lt", n)
946+ | RangeDateLt UTCTime
970−halfRangeToKV (HalfRangeLte (LessThanEq n)) = ("lte", n)
947+ | RangeDateGte UTCTime
971−halfRangeToKV (HalfRangeGt (GreaterThan n)) = ("gt", n)
948+ | RangeDateGt UTCTime
972−halfRangeToKV (HalfRangeGte (GreaterThanEq n)) = ("gte", n)
949+ | RangeDateGtLt UTCTime UTCTime
973−
950+ | RangeDateGteLte UTCTime UTCTime
974−rangeToKV :: Range -> (Text, Double, Text, Double)
951+ | RangeDateGteLt UTCTime UTCTime
975−rangeToKV (RangeLtGt (LessThan m) (GreaterThan n)) = ("lt", m, "gt", n)
952+ | RangeDateGtLte UTCTime UTCTime
976−rangeToKV (RangeLtGte (LessThan m) (GreaterThanEq n)) = ("lt", m, "gte", n)
953+ | RangeDoubleLte Double
977−rangeToKV (RangeLteGt (LessThanEq m) (GreaterThan n)) = ("lte", m, "gt", n)
954+ | RangeDoubleLt Double
978−rangeToKV (RangeLteGte (LessThanEq m) (GreaterThanEq n)) = ("lte", m, "gte", n)
955+ | RangeDoubleGte Double
979−
956+ | RangeDoubleGt Double
980−-- phew. Coulda used Agda style case breaking there but, you know, whatever. :)
957+ | RangeDoubleGtLt Double Double
981−
958+ | RangeDoubleGteLte Double Double
982−-- Different, subjectively saner ranges.
959+ | RangeDoubleGteLt Double Double
983−
960+ | RangeDoubleGtLte Double Double
984−data RangeText = RangeTextLte Text
961+ deriving (Eq, Show)
985− | RangeTextLt Text
962+
986− | RangeTextGte Text
963+rangeValueToPair :: RangeValue -> [Pair]
987− | RangeTextGt Text
964+rangeValueToPair rv = case rv of
988− | RangeTextGtLt Text Text
965+ RangeDateLte t -> ["lte" .= t]
989− | RangeTextGteLte Text Text
966+ RangeDateGte t -> ["gte" .= t]
990− | RangeTextGteLt Text Text
967+ RangeDateLt t -> ["lt" .= t]
991− | RangeTextGtLte Text Text
968+ RangeDateGt t -> ["gt" .= t]
992− deriving (Eq, Show)
969+ RangeDateGteLte l g -> ["gte" .= l, "lte" .= g]
993−
970+ RangeDateGtLte l g -> ["gt" .= l, "lte" .= g]
994−data RangeDouble = RangeDoubleLte Double
971+ RangeDateGteLt l g -> ["gte" .= l, "lt" .= g]
995− | RangeDoubleLt Double
972+ RangeDateGtLt l g -> ["gt" .= l, "lt" .= g]
973+ RangeDoubleLte t -> ["lte" .= t]
996− | RangeDoubleGte Double
974+ RangeDoubleGte t -> ["gte" .= t]
975+ RangeDoubleLt t -> ["lt" .= t]
997− | RangeDoubleGt Double
976+ RangeDoubleGt t -> ["gt" .= t]
998− | RangeDoubleGtLt Double Double
977+ RangeDoubleGteLte l g -> ["gte" .= l, "lte" .= g]
999− | RangeDoubleGteLte Double Double
978+ RangeDoubleGtLte l g -> ["gt" .= l, "lte" .= g]
1000− | RangeDoubleGteLt Double Double
979+ RangeDoubleGteLt l g -> ["gte" .= l, "lt" .= g]
1001− | RangeDoubleGtLte Double Double
980+ RangeDoubleGtLt l g -> ["gt" .= l, "lt" .= g]
1002− deriving (Eq, Show)
1003
981
1004data Term = Term { termField :: Text
982data Term = Term { termField :: Text
1005 , termValue :: Text } deriving (Eq, Show)
983 , termValue :: Text } deriving (Eq, Show)
@@ -1363,54 +1341,11 @@ instance ToJSON Filter where
1363 object [fieldName .= fieldValue
1341 object [fieldName .= fieldValue
1364 , "_cache" .= cache]]
1342 , "_cache" .= cache]]
1365
1343
1366− toJSON (RangeFilter (FieldName fieldName) (Left halfRange) rangeExecution cache) =
1344+ toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =
1367− object ["range" .=
1368− object [fieldName .=
1369− object [rqFKey .= rqFVal]
1370− , "execution" .= toJSON rangeExecution
1371− , "_cache" .= cache]]
1372− where
1373− (rqFKey, rqFVal) = halfRangeToKV halfRange
1374−
1375− toJSON (RangeFilter (FieldName fieldName) (Right range) rangeExecution cache) =
1376− object ["range" .=
1377− object [fieldName .=
1378− object [lessKey .= lessVal
1379− , greaterKey .= greaterVal]
1380− , "execution" .= toJSON rangeExecution
1381− , "_cache" .= cache]]
1382− where
1383− (lessKey, lessVal, greaterKey, greaterVal) = rangeToKV range
1384−
1385− toJSON (RangeFilterText (FieldName fieldName) rangeSpec rangeExecution cache) =
1386 object ["range" .=
1345 object ["range" .=
1387− object [ fieldName .= object (rangeObject rangeSpec)
1346+ object [ fieldName .= object (rangeValueToPair rangeValue)
1388 , "execution" .= toJSON rangeExecution
1347 , "execution" .= toJSON rangeExecution
1389 , "_cache" .= cache]]
1348 , "_cache" .= cache]]
1390− where
1391− rangeObject (RangeTextLte t) = ["lte" .= t]
1392− rangeObject (RangeTextGte t) = ["gte" .= t]
1393− rangeObject (RangeTextLt t) = ["lt" .= t]
1394− rangeObject (RangeTextGt t) = ["gt" .= t]
1395− rangeObject (RangeTextGteLte l g) = ["gte" .= l, "lte" .= g]
1396− rangeObject (RangeTextGtLte l g) = ["gt" .= l, "lte" .= g]
1397− rangeObject (RangeTextGteLt l g) = ["gte" .= l, "lt" .= g]
1398− rangeObject (RangeTextGtLt l g) = ["gt" .= l, "lt" .= g]
1399−
1400− toJSON (RangeFilterDouble (FieldName fieldName) rangeSpec rangeExecution cache) =
1401− object ["range" .=
1402− object [ fieldName .= object (rangeObject rangeSpec)
1403− , "execution" .= toJSON rangeExecution
1404− , "_cache" .= cache]]
1405− where
1406− rangeObject (RangeDoubleLte t) = ["lte" .= t]
1407− rangeObject (RangeDoubleGte t) = ["gte" .= t]
1408− rangeObject (RangeDoubleLt t) = ["lt" .= t]
1409− rangeObject (RangeDoubleGt t) = ["gt" .= t]
1410− rangeObject (RangeDoubleGteLte l g) = ["gte" .= l, "lte" .= g]
1411− rangeObject (RangeDoubleGtLte l g) = ["gt" .= l, "lte" .= g]
1412− rangeObject (RangeDoubleGteLt l g) = ["gte" .= l, "lt" .= g]
1413− rangeObject (RangeDoubleGtLt l g) = ["gt" .= l, "lt" .= g]
1414
1349
1415 toJSON (RegexpFilter (FieldName fieldName)
1350 toJSON (RegexpFilter (FieldName fieldName)
1416 (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =
1351 (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =
@@ -1604,18 +1539,9 @@ instance ToJSON QueryStringQuery where
1604
1539
1605
1540
1606instance ToJSON RangeQuery where
1541instance ToJSON RangeQuery where
1607− toJSON (RangeQuery (FieldName fieldName) (Right range) boost) =
1542+ toJSON (RangeQuery (FieldName fieldName) range boost) =
1608− object [ fieldName .= conjoined ]
1609− where conjoined = [ "boost" .= toJSON boost
1610− , lessKey .= lessVal
1611− , greaterKey .= greaterVal ]
1612− (lessKey, lessVal, greaterKey, greaterVal) = rangeToKV range
1613−
1614− toJSON (RangeQuery (FieldName fieldName) (Left halfRange) boost) =
1615 object [ fieldName .= conjoined ]
1543 object [ fieldName .= conjoined ]
1616− where conjoined = [ "boost" .= toJSON boost
1544+ where conjoined = [ "boost" .= toJSON boost ] ++ (rangeValueToPair range)
1617− , rqKey .= rqVal ]
1618− (rqKey, rqVal) = halfRangeToKV halfRange
1619
1545
1620
1546
1621instance ToJSON PrefixQuery where
1547instance ToJSON PrefixQuery where
tests/tests.hs+11−5
@@ -432,19 +432,25 @@ main = hspec $ do
432 myTweet <- searchTweet search
432 myTweet <- searchTweet search
433 myTweet `shouldBe` Right exampleTweet
433 myTweet `shouldBe` Right exampleTweet
434
434
435− it "returns document for range filter" $ do
435+ it "returns document for range double filter" $ do
436 _ <- insertData
436 _ <- insertData
437 let filter = RangeFilter (FieldName "age")
437 let filter = RangeFilter (FieldName "age")
438− (Right (RangeLtGt (LessThan 100000.0) (GreaterThan 1000.0)))
438+ (RangeDoubleGtLt 1000.0 100000.0)
439 RangeExecutionIndex False
439 RangeExecutionIndex False
440 let search = mkSearch Nothing (Just filter)
440 let search = mkSearch Nothing (Just filter)
441 myTweet <- searchTweet search
441 myTweet <- searchTweet search
442 myTweet `shouldBe` Right exampleTweet
442 myTweet `shouldBe` Right exampleTweet
443
443
444− it "returns document for range double filter" $ do
444+ it "returns document for range date filter" $ do
445 _ <- insertData
445 _ <- insertData
446− let filter = RangeFilterDouble (FieldName "age")
446+ let filter = RangeFilter (FieldName "age")
447− (RangeDoubleGtLt 1000.0 100000.0)
447+ (RangeDateGteLte
448+ (UTCTime
449+ (ModifiedJulianDay 55000)
450+ (secondsToDiffTime 0))
451+ (UTCTime
452+ (ModifiedJulianDay 55001)
453+ (secondsToDiffTime 0)))
448 RangeExecutionIndex False
454 RangeExecutionIndex False
449 let search = mkSearch Nothing (Just filter)
455 let search = mkSearch Nothing (Just filter)
450 myTweet <- searchTweet search
456 myTweet <- searchTweet search