git.iko.soy/typeable/bloodhound
on master help sign in
Refactor stringly typed regexp flags to sum type
048dc0bMichael Xavier
Database/Bloodhound/Types.hs+13−1
compare with master
unifiedsplit
@@ -60,6 +60,7 @@ module Database.Bloodhound.Types
60 , GreaterThanEq(..)
60 , GreaterThanEq(..)
61 , Regexp(..)
61 , Regexp(..)
62 , RegexpFlags(..)
62 , RegexpFlags(..)
63+ , RegexpFlag(..)
63 , FieldName(..)
64 , FieldName(..)
64 , IndexName(..)
65 , IndexName(..)
65 , MappingName(..)
66 , MappingName(..)
@@ -144,6 +145,7 @@ module Database.Bloodhound.Types
144
145
145import Data.Aeson
146import Data.Aeson
146import qualified Data.ByteString.Lazy.Char8 as L
147import qualified Data.ByteString.Lazy.Char8 as L
148+import Data.List.NonEmpty (NonEmpty)
147import Data.Text (Text)
149import Data.Text (Text)
148import qualified Data.Text as T
150import qualified Data.Text as T
149import Data.Time.Clock (UTCTime)
151import Data.Time.Clock (UTCTime)
@@ -824,7 +826,17 @@ data RangeExecution = RangeExecutionIndex
824 | RangeExecutionFielddata deriving (Eq, Show)
826 | RangeExecutionFielddata deriving (Eq, Show)
825
827
826newtype Regexp = Regexp Text deriving (Eq, Show)
828newtype Regexp = Regexp 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
827−newtype RegexpFlags = RegexpFlags Text deriving (Eq, Show)
839+ | Interval deriving (Eq, Show)
828
840
829halfRangeToKV :: HalfRange -> (Text, Double)
841halfRangeToKV :: HalfRange -> (Text, Double)
830halfRangeToKV (HalfRangeLt (LessThan n)) = ("lt", n)
842halfRangeToKV (HalfRangeLt (LessThan n)) = ("lt", n)
Database/Bloodhound/Types/Instances.hs+15−5
@@ -8,6 +8,8 @@ module Database.Bloodhound.Types.Instances
8
8
9import Control.Applicative
9import Control.Applicative
10import Data.Aeson
10import Data.Aeson
11+import Data.List (nub)
12+import Data.List.NonEmpty (NonEmpty(..))
11import Data.Maybe (catMaybes)
13import Data.Maybe (catMaybes)
12import Data.Monoid
14import Data.Monoid
13import qualified Data.Text as T
15import qualified Data.Text as T
@@ -57,7 +59,7 @@ instance ToJSON Filter where
57 , "distance_type" .= toJSON distanceType
59 , "distance_type" .= toJSON distanceType
58 , "optimize_bbox" .= optimizeBbox
60 , "optimize_bbox" .= optimizeBbox
59 , distanceGeoField .= toJSON geoDistLatLon
61 , distanceGeoField .= toJSON geoDistLatLon
60− , "_cache" .= cache]]
62+ , "_cache" .= cache]]
61
63
62 toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
64 toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
63 (DistanceRange geoDistRangeDistFrom drDistanceTo)) =
65 (DistanceRange geoDistRangeDistFrom drDistanceTo)) =
@@ -213,7 +215,7 @@ instance ToJSON Query where
213 toJSON (QueryRangeQuery query) =
215 toJSON (QueryRangeQuery query) =
214 object [ "range" .= toJSON query ]
216 object [ "range" .= toJSON query ]
215
217
216− toJSON (QueryRegexpQuery query) =
218+ toJSON (QueryRegexpQuery query) =
217 object [ "regexp" .= toJSON query ]
219 object [ "regexp" .= toJSON query ]
218
220
219 toJSON (QuerySimpleQueryStringQuery query) =
221 toJSON (QuerySimpleQueryStringQuery query) =
@@ -645,7 +647,7 @@ instance ToJSON SortSpec where
645
647
646
648
647instance ToJSON SortOrder where
649instance ToJSON SortOrder where
648− toJSON Ascending = String "asc"
650+ toJSON Ascending = String "asc"
649 toJSON Descending = String "desc"
651 toJSON Descending = String "desc"
650
652
651
653
@@ -731,8 +733,16 @@ instance ToJSON RangeExecution where
731
733
732
734
733instance ToJSON RegexpFlags where
735instance ToJSON RegexpFlags where
734− toJSON (RegexpFlags txt) = String txt
736+ toJSON AllRegexpFlags = String "ALL"
735−
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"
736
746
737instance ToJSON Term where
747instance ToJSON Term where
738 toJSON (Term field value) = object ["term" .= object
748 toJSON (Term field value) = object ["term" .= object
bloodhound.cabal+4−1
@@ -29,6 +29,7 @@ library
29 aeson >= 0.7,
29 aeson >= 0.7,
30 conduit >= 1.0,
30 conduit >= 1.0,
31 http-client >= 0.3,
31 http-client >= 0.3,
32+ semigroups >= 0.15,
32 time >= 1.4,
33 time >= 1.4,
33 text >= 0.11,
34 text >= 0.11,
34 http-types >= 0.8
35 http-types >= 0.8
@@ -47,5 +48,7 @@ test-suite tests
47 hspec >= 1.8,
48 hspec >= 1.8,
48 text >= 0.11,
49 text >= 0.11,
49 time >= 1.4,
50 time >= 1.4,
50− aeson >= 0.7
51+ aeson >= 0.7,
52+ semigroups >= 0.15,
53+ QuickCheck
51 default-language: Haskell2010
54 default-language: Haskell2010
tests/tests.hs+49−2
@@ -1,17 +1,24 @@
1{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
2
3
3module Main where
4module Main where
4
5
6+import Control.Applicative
5import Database.Bloodhound
7import Database.Bloodhound
6import Data.Aeson
8import Data.Aeson
9+import Data.List (nub)
10+import Data.List.NonEmpty (NonEmpty(..))
7import Data.Time.Calendar (Day(..))
11import Data.Time.Calendar (Day(..))
8import Data.Time.Clock (secondsToDiffTime, UTCTime(..))
12import Data.Time.Clock (secondsToDiffTime, UTCTime(..))
9import Data.Text (Text)
13import Data.Text (Text)
14+import qualified Data.Text as T
10import GHC.Generics (Generic)
15import GHC.Generics (Generic)
11import Network.HTTP.Client
16import Network.HTTP.Client
12import qualified Network.HTTP.Types.Status as NHTS
17import qualified Network.HTTP.Types.Status as NHTS
13import Prelude hiding (filter, putStrLn)
18import Prelude hiding (filter, putStrLn)
14import Test.Hspec
19import Test.Hspec
20+import Test.Hspec.QuickCheck (prop)
21+import Test.QuickCheck
15
22
16testServer :: Server
23testServer :: Server
17testServer = Server "http://localhost:9200"
24testServer = Server "http://localhost:9200"
@@ -104,6 +111,27 @@ data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
104instance FromJSON BulkTest
111instance FromJSON BulkTest
105instance ToJSON BulkTest
112instance ToJSON BulkTest
106
113
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+
107main :: IO ()
135main :: IO ()
108main = hspec $ do
136main = hspec $ do
109
137
@@ -314,7 +342,7 @@ main = hspec $ do
314 it "returns document for regexp filter" $ do
342 it "returns document for regexp filter" $ do
315 _ <- insertData
343 _ <- insertData
316 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
344 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
317− (RegexpFlags "ALL") (CacheName "test") False (CacheKey "key")
345+ AllRegexpFlags (CacheName "test") False (CacheKey "key")
318 let search = mkSearch Nothing (Just filter)
346 let search = mkSearch Nothing (Just filter)
319 myTweet <- searchTweet search
347 myTweet <- searchTweet search
320 myTweet `shouldBe` Right exampleTweet
348 myTweet `shouldBe` Right exampleTweet
@@ -322,7 +350,26 @@ main = hspec $ do
322 it "doesn't return document for non-matching regexp filter" $ do
350 it "doesn't return document for non-matching regexp filter" $ do
323 _ <- insertData
351 _ <- insertData
324 let filter = RegexpFilter (FieldName "user")
352 let filter = RegexpFilter (FieldName "user")
325− (Regexp "boy") (RegexpFlags "ALL")
353+ (Regexp "boy") AllRegexpFlags
326 (CacheName "test") False (CacheKey "key")
354 (CacheName "test") False (CacheKey "key")
327 let search = mkSearch Nothing (Just filter)
355 let search = mkSearch Nothing (Just filter)
328 searchExpectNoResults search
356 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