typeable/bloodhound
1
0
Fork 0
mirror of https://github.com/typeable/bloodhound.git synced 2024-12-02 14:34:23 +03:00
Code Issues Projects Releases Wiki Activity

Refactor stringly typed regexp flags to sum type

Browse Source
This commit is contained in:
Michael Xavier 2014-06-15 10:56:47 -07:00
parent e40bd933e6
commit 048dc0be77
4 changed files with 81 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Database/Bloodhound/Types.hs
View File

@ -60,6 +60,7 @@ module Database.Bloodhound.Types
, GreaterThanEq(..)
, Regexp(..)
, RegexpFlags(..)
, RegexpFlag(..)
, FieldName(..)
, IndexName(..)
, MappingName(..)
@ -144,6 +145,7 @@ module Database.Bloodhound.Types
import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as L
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
@ -824,7 +826,17 @@ data RangeExecution = RangeExecutionIndex
| RangeExecutionFielddata deriving (Eq, Show)
newtype Regexp = Regexp Text deriving (Eq, Show)
newtype RegexpFlags = RegexpFlags Text deriving (Eq, Show)
data RegexpFlags = AllRegexpFlags
| NoRegexpFlags
| SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show)
data RegexpFlag = AnyString
| Automaton
| Complement
| Empty
| Intersection
| Interval deriving (Eq, Show)
halfRangeToKV :: HalfRange -> (Text, Double)
halfRangeToKV (HalfRangeLt (LessThan n)) = ("lt", n)

20
Database/Bloodhound/Types/Instances.hs
View File

@ -8,6 +8,8 @@ module Database.Bloodhound.Types.Instances
import Control.Applicative
import Data.Aeson
import Data.List (nub)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (catMaybes)
import Data.Monoid
import qualified Data.Text as T
@ -57,7 +59,7 @@ instance ToJSON Filter where
, "distance_type" .= toJSON distanceType
, "optimize_bbox" .= optimizeBbox
, distanceGeoField .= toJSON geoDistLatLon
, "_cache" .= cache]]
, "_cache" .= cache]]
toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
(DistanceRange geoDistRangeDistFrom drDistanceTo)) =
@ -213,7 +215,7 @@ instance ToJSON Query where
toJSON (QueryRangeQuery query) =
object [ "range" .= toJSON query ]
toJSON (QueryRegexpQuery query) =
toJSON (QueryRegexpQuery query) =
object [ "regexp" .= toJSON query ]
toJSON (QuerySimpleQueryStringQuery query) =
@ -645,7 +647,7 @@ instance ToJSON SortSpec where
instance ToJSON SortOrder where
toJSON Ascending = String "asc"
toJSON Ascending = String "asc"
toJSON Descending = String "desc"
@ -731,8 +733,16 @@ instance ToJSON RangeExecution where
instance ToJSON RegexpFlags where
toJSON (RegexpFlags txt) = String txt
toJSON AllRegexpFlags = String "ALL"
toJSON NoRegexpFlags = String "NONE"
toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
where flagStrs = map flagStr . nub $ h:fs
flagStr AnyString = "ANYSTRING"
flagStr Automaton = "AUTOMATON"
flagStr Complement = "COMPLEMENT"
flagStr Empty = "EMPTY"
flagStr Intersection = "INTERSECTION"
flagStr Interval = "INTERVAL"
instance ToJSON Term where
toJSON (Term field value) = object ["term" .= object

5
bloodhound.cabal
View File

@ -29,6 +29,7 @@ library
aeson >= 0.7,
conduit >= 1.0,
http-client >= 0.3,
semigroups >= 0.15,
time >= 1.4,
text >= 0.11,
http-types >= 0.8
@ -47,5 +48,7 @@ test-suite tests
hspec >= 1.8,
text >= 0.11,
time >= 1.4,
aeson >= 0.7
aeson >= 0.7,
semigroups >= 0.15,
QuickCheck
default-language: Haskell2010

51
tests/tests.hs
View File

@ -1,17 +1,24 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Control.Applicative
import Database.Bloodhound
import Data.Aeson
import Data.List (nub)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Time.Calendar (Day(..))
import Data.Time.Clock (secondsToDiffTime, UTCTime(..))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Network.HTTP.Client
import qualified Network.HTTP.Types.Status as NHTS
import Prelude hiding (filter, putStrLn)
import Test.Hspec
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck
testServer :: Server
testServer = Server "http://localhost:9200"
@ -104,6 +111,27 @@ data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
instance FromJSON BulkTest
instance ToJSON BulkTest
noDuplicates :: Eq a => [a] -> Bool
noDuplicates xs = nub xs == xs
instance Arbitrary RegexpFlags where
arbitrary = oneof [ pure AllRegexpFlags
, pure NoRegexpFlags
, SomeRegexpFlags <$> arbitrary
]
instance Arbitrary a => Arbitrary (NonEmpty a) where
arbitrary = liftA2 (:|) arbitrary arbitrary
instance Arbitrary RegexpFlag where
arbitrary = oneof [ pure AnyString
, pure Automaton
, pure Complement
, pure Empty
, pure Intersection
, pure Interval
]
main :: IO ()
main = hspec $ do
@ -314,7 +342,7 @@ main = hspec $ do
it "returns document for regexp filter" $ do
_ <- insertData
let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
(RegexpFlags "ALL") (CacheName "test") False (CacheKey "key")
AllRegexpFlags (CacheName "test") False (CacheKey "key")
let search = mkSearch Nothing (Just filter)
myTweet <- searchTweet search
myTweet `shouldBe` Right exampleTweet
@ -322,7 +350,26 @@ main = hspec $ do
it "doesn't return document for non-matching regexp filter" $ do
_ <- insertData
let filter = RegexpFilter (FieldName "user")
(Regexp "boy") (RegexpFlags "ALL")
(Regexp "boy") AllRegexpFlags
(CacheName "test") False (CacheKey "key")
let search = mkSearch Nothing (Just filter)
searchExpectNoResults search
describe "ToJSON RegexpFlags" $ do
it "generates the correct JSON for AllRegexpFlags" $
toJSON AllRegexpFlags `shouldBe` String "ALL"
it "generates the correct JSON for NoRegexpFlags" $
toJSON NoRegexpFlags `shouldBe` String "NONE"
it "generates the correct JSON for SomeRegexpFlags" $
let flags = AnyString :| [ Automaton
, Complement
, Empty
, Intersection
, Interval ]
in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
let String str = toJSON flags
flagStrs = T.splitOn "|" str
in noDuplicates flagStrs