048dc0b · typeable/bloodhound

git.iko.soy/typeable/bloodhound

Refactor stringly typed regexp flags to sum type

commit048dc0be776c3c83fa635ea6a0951eb19a2db9f3 authorMichael Xavier <michael@michaelxavier.net> dateSun 15 Jun 2014, 10:56 (12 years ago) parente40bd93

4 files changed+81−9

compare with master

unifiedsplit

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

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 #-}

34module Main where

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 ]

371+

372+ prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->

373+ let String str = toJSON flags

374+ flagStrs = T.splitOn "|" str

375+ in noDuplicates flagStrs