git.iko.soy/typeable/bloodhound
on master help sign in
refactoring and modularization
2480dcbChris Allen
Database/Bloodhound.hsnew file+81
compare with master
unifiedsplit
@@ -0,0 +1,81 @@
1+module Database.Bloodhound
2+ ( createIndex
3+ , deleteIndex
4+ , defaultIndexSettings
5+ , createMapping
6+ , deleteMapping
7+ , indexDocument
8+ , getDocument
9+ , documentExists
10+ , deleteDocument
11+ , searchAll
12+ , searchByIndex
13+ , searchByType
14+ , refreshIndex
15+ , mkSearch
16+ , bulk
17+ , defaultCache
18+ , halfRangeToKV
19+ , maybeJson
20+ , maybeJsonF
21+ , rangeToKV
22+ , showText
23+ , unpackId
24+ , Version(..)
25+ , Status(..)
26+ , Existence(..)
27+ , NullValue(..)
28+ , IndexSettings(..)
29+ , Server(..)
30+ , Reply(..)
31+ , EsResult(..)
32+ , Query(..)
33+ , Search(..)
34+ , SearchResult(..)
35+ , SearchHits(..)
36+ , ShardResult(..)
37+ , Hit(..)
38+ , Filter(..)
39+ , Seminearring(..)
40+ , BoolMatch(..)
41+ , Term(..)
42+ , GeoPoint(..)
43+ , GeoBoundingBoxConstraint(..)
44+ , GeoBoundingBox(..)
45+ , GeoFilterType(..)
46+ , Distance(..)
47+ , DistanceUnit(..)
48+ , DistanceType(..)
49+ , DistanceRange(..)
50+ , OptimizeBbox(..)
51+ , LatLon(..)
52+ , Range(..)
53+ , HalfRange(..)
54+ , RangeExecution(..)
55+ , LessThan(..)
56+ , LessThanEq(..)
57+ , GreaterThan(..)
58+ , GreaterThanEq(..)
59+ , Regexp(..)
60+ , RegexpFlags(..)
61+ , FieldName(..)
62+ , IndexName(..)
63+ , MappingName(..)
64+ , DocId(..)
65+ , CacheName(..)
66+ , CacheKey(..)
67+ , BulkOperation(..)
68+ , ReplicaCount(..)
69+ , ShardCount(..)
70+ , Sort(..)
71+ , SortMode(..)
72+ , SortOrder(..)
73+ , SortSpec(..)
74+ , DefaultSort(..)
75+ , Missing(..)
76+ , OpenCloseIndex(..)
77+ , Method(..)
78+ ) where
79+
80+import Database.Bloodhound.Client
81+import Database.Bloodhound.Types
Database/Bloodhound/Client.hs+3−691
@@ -1,9 +1,6 @@
1−{-# LANGUAGE DeriveGeneric, ExistentialQuantification, StandaloneDeriving #-}
2−
3module Database.Bloodhound.Client
1module Database.Bloodhound.Client
4 ( createIndex
2 ( createIndex
5 , deleteIndex
3 , deleteIndex
6− , defaultIndexSettings
7 , createMapping
4 , createMapping
8 , deleteMapping
5 , deleteMapping
9 , indexDocument
6 , indexDocument
@@ -16,95 +13,22 @@ module Database.Bloodhound.Client
16 , refreshIndex
13 , refreshIndex
17 , mkSearch
14 , mkSearch
18 , bulk
15 , bulk
19− , IndexSettings(..)
20− , Server(..)
21− , Reply(..)
22− , EsResult(..)
23− , Query(..)
24− , Search(..)
25− , SearchResult(..)
26− , SearchHits(..)
27− , ShardResult(..)
28− , Hit(..)
29− , Filter(..)
30− , Seminearring(..)
31− , BoolMatch(..)
32− , Term(..)
33− , GeoPoint(..)
34− , GeoBoundingBoxConstraint(..)
35− , GeoBoundingBox(..)
36− , GeoFilterType(..)
37− , Distance(..)
38− , DistanceUnit(..)
39− , DistanceType(..)
40− , DistanceRange(..)
41− , OptimizeBbox(..)
42− , LatLon(..)
43− , Range(..)
44− , HalfRange(..)
45− , RangeExecution(..)
46− , LessThan(..)
47− , LessThanEq(..)
48− , GreaterThan(..)
49− , GreaterThanEq(..)
50− , Regexp(..)
51− , RegexpFlags(..)
52− , FieldName(..)
53− , IndexName(..)
54− , MappingName(..)
55− , DocId(..)
56− , CacheName(..)
57− , CacheKey(..)
58− , BulkOperation(..)
59 )
16 )
60 where
17 where
61
18
62−import Control.Applicative
63−import Control.Monad (liftM)
64import Data.Aeson
19import Data.Aeson
65−import Data.Aeson.TH (deriveJSON)
66import qualified Data.ByteString.Lazy.Char8 as L
20import qualified Data.ByteString.Lazy.Char8 as L
67import Data.ByteString.Builder
21import Data.ByteString.Builder
68import Data.List (foldl', intercalate, intersperse)
22import Data.List (foldl', intercalate, intersperse)
69import Data.Maybe (fromMaybe)
23import Data.Maybe (fromMaybe)
70−import Data.Monoid
71import Data.Text (Text)
24import Data.Text (Text)
72−import qualified Data.Text as T
73−import Data.Time.Clock (UTCTime)
74−import GHC.Generics (Generic)
75import Network.HTTP.Conduit
25import Network.HTTP.Conduit
76import qualified Network.HTTP.Types.Method as NHTM
26import qualified Network.HTTP.Types.Method as NHTM
77import qualified Network.HTTP.Types.Status as NHTS
27import qualified Network.HTTP.Types.Status as NHTS
78
28
79−data Version = Version { number :: Text
29+import Database.Bloodhound.Types
80− , build_hash :: Text
30+import Database.Bloodhound.Types.Class
81− , build_timestamp :: UTCTime
31+import Database.Bloodhound.Types.Instances
82− , build_snapshot :: Bool
83− , lucene_version :: Text } deriving (Show, Generic)
84−
85−data (FromJSON a, ToJSON a) => Status a =
86− Status { ok :: Bool
87− , status :: Int
88− , name :: Text
89− , version :: a
90− , tagline :: Text } deriving (Eq, Show)
91−
92−instance ToJSON Version
93−instance FromJSON Version
94−
95−instance (FromJSON a, ToJSON a) => FromJSON (Status a) where
96− parseJSON (Object v) = Status <$>
97− v .: "ok" <*>
98− v .: "status" <*>
99− v .: "name" <*>
100− v .: "version" <*>
101− v .: "tagline"
102− parseJSON _ = empty
103−
104−main = simpleHttp "http://localhost:9200/events/event/_search?q=hostname:localhost&size=1" >>= L.putStrLn
105−
106−newtype ShardCount = ShardCount Int deriving (Eq, Show, Generic)
107−newtype ReplicaCount = ReplicaCount Int deriving (Eq, Show, Generic)
108
32
109mkShardCount :: Int -> Maybe ShardCount
33mkShardCount :: Int -> Maybe ShardCount
110mkShardCount n
34mkShardCount n
@@ -118,25 +42,6 @@ mkReplicaCount n
118 | n > 1000 = Nothing -- ...
42 | n > 1000 = Nothing -- ...
119 | otherwise = Just (ReplicaCount n)
43 | otherwise = Just (ReplicaCount n)
120
44
121−data IndexSettings =
122− IndexSettings { indexShards :: ShardCount
123− , indexReplicas :: ReplicaCount } deriving (Eq, Show)
124−
125−instance ToJSON IndexSettings where
126− toJSON (IndexSettings s r) = object ["settings" .= object ["shards" .= s, "replicas" .= r]]
127−
128−instance ToJSON ReplicaCount
129−instance ToJSON ShardCount
130−
131−defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
132−
133−data Strategy = RoundRobinStrat | RandomStrat | HeadStrat deriving (Eq, Show)
134−
135−newtype Server = Server String deriving (Eq, Show)
136−
137−type Reply = Network.HTTP.Conduit.Response L.ByteString
138−type Method = NHTM.Method
139−
140responseIsError :: Reply -> Bool
45responseIsError :: Reply -> Bool
141responseIsError resp = NHTS.statusCode (responseStatus resp) > 299
46responseIsError resp = NHTS.statusCode (responseStatus resp) > 299
142
47
@@ -194,8 +99,6 @@ refreshIndex (Server server) (IndexName indexName) = dispatch url method body wh
194 method = NHTM.methodPost
99 method = NHTM.methodPost
195 body = Nothing
100 body = Nothing
196
101
197−data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Show)
198−
199stringifyOCIndex oci = case oci of
102stringifyOCIndex oci = case oci of
200 OpenIndex -> "_open"
103 OpenIndex -> "_open"
201 CloseIndex -> "_close"
104 CloseIndex -> "_close"
@@ -214,24 +117,6 @@ openIndex = openOrCloseIndexes OpenIndex
214closeIndex :: Server -> IndexName -> IO Reply
117closeIndex :: Server -> IndexName -> IO Reply
215closeIndex = openOrCloseIndexes CloseIndex
118closeIndex = openOrCloseIndexes CloseIndex
216
119
217−data FieldType = GeoPointType
218− | GeoShapeType
219− | FloatType
220− | IntegerType
221− | LongType
222− | ShortType
223− | ByteType deriving (Eq, Show)
224−
225−data FieldDefinition =
226− FieldDefinition { fieldType :: FieldType } deriving (Eq, Show)
227−
228−data MappingField =
229− MappingField { mappingFieldName :: FieldName
230− , fieldDefinition :: FieldDefinition } deriving (Eq, Show)
231−
232−data Mapping = Mapping { typeName :: Text
233− , fields :: [MappingField] } deriving (Eq, Show)
234−
235createMapping :: ToJSON a => Server -> IndexName
120createMapping :: ToJSON a => Server -> IndexName
236 -> MappingName -> a -> IO Reply
121 -> MappingName -> a -> IO Reply
237createMapping (Server server) (IndexName indexName) (MappingName mappingName) mapping =
122createMapping (Server server) (IndexName indexName) (MappingName mappingName) mapping =
@@ -280,12 +165,6 @@ collapseStream stream = collapsed where
280mash :: Builder -> [L.ByteString] -> Builder
165mash :: Builder -> [L.ByteString] -> Builder
281mash builder xs = foldl' (\b x -> mappend b (lazyByteString x)) builder xs
166mash builder xs = foldl' (\b x -> mappend b (lazyByteString x)) builder xs
282
167
283−data BulkOperation =
284− BulkIndex IndexName MappingName DocId Value
285− | BulkCreate IndexName MappingName DocId Value
286− | BulkDelete IndexName MappingName DocId
287− | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show)
288−
289mkMetadataValue :: Text -> String -> String -> String -> Value
168mkMetadataValue :: Text -> String -> String -> String -> Value
290mkMetadataValue operation indexName mappingName docId =
169mkMetadataValue operation indexName mappingName docId =
291 object [operation .=
170 object [operation .=
@@ -319,23 +198,6 @@ getStreamChunk (BulkUpdate (IndexName indexName)
319 doc = object ["doc" .= value]
198 doc = object ["doc" .= value]
320 blob = [encode metadata, encode doc]
199 blob = [encode metadata, encode doc]
321
200
322−data EsResult a = EsResult { _index :: Text
323− , _type :: Text
324− , _id :: Text
325− , _version :: Int
326− , found :: Maybe Bool
327− , _source :: a } deriving (Eq, Show)
328−
329−instance (FromJSON a, ToJSON a) => FromJSON (EsResult a) where
330− parseJSON (Object v) = EsResult <$>
331− v .: "_index" <*>
332− v .: "_type" <*>
333− v .: "_id" <*>
334− v .: "_version" <*>
335− v .:? "found" <*>
336− v .: "_source"
337− parseJSON _ = empty
338−
339getDocument :: Server -> IndexName -> MappingName
201getDocument :: Server -> IndexName -> MappingName
340 -> DocId -> IO Reply
202 -> DocId -> IO Reply
341getDocument (Server server) (IndexName indexName) (MappingName mappingName) (DocId docId) =
203getDocument (Server server) (IndexName indexName) (MappingName mappingName) (DocId docId) =
@@ -351,7 +213,6 @@ documentExists (Server server) (IndexName indexName) (MappingName mappingName) (
351 return exists where
213 return exists where
352 url = joinPath [server, indexName, mappingName, docId]
214 url = joinPath [server, indexName, mappingName, docId]
353
215
354−
355dispatchSearch :: String -> Search -> IO Reply
216dispatchSearch :: String -> Search -> IO Reply
356dispatchSearch url search = dispatch url NHTM.methodPost (Just (encode search))
217dispatchSearch url search = dispatch url NHTM.methodPost (Just (encode search))
357
218
@@ -368,557 +229,8 @@ searchByType (Server server) (IndexName indexName)
368 (MappingName mappingName) search = dispatchSearch url search where
229 (MappingName mappingName) search = dispatchSearch url search where
369 url = joinPath [server, indexName, mappingName, "_search"]
230 url = joinPath [server, indexName, mappingName, "_search"]
370
231
371−data Search = Search { queryBody :: Maybe Query
372− , filterBody :: Maybe Filter
373− , sortBody :: Maybe Sort
374− -- default False
375− , trackSortScores :: Bool
376− , from :: Int
377− , size :: Int} deriving (Eq, Show)
378−
379mkSearch :: Maybe Query -> Maybe Filter -> Search
232mkSearch :: Maybe Query -> Maybe Filter -> Search
380mkSearch query filter = Search query filter Nothing False 0 10
233mkSearch query filter = Search query filter Nothing False 0 10
381
234
382pageSearch :: Int -> Int -> Search -> Search
235pageSearch :: Int -> Int -> Search -> Search
383pageSearch from size search = search { from = from, size = size }
236pageSearch from size search = search { from = from, size = size }
384−
385−-- defaultFieldMaybeJSON :: Text -> Maybe a ->
386−maybeJson field (Just value) = [field .= toJSON value]
387−maybeJson _ _ = []
388−maybeJsonF field (Just value) = [field .= fmap toJSON value]
389−maybeJsonF _ _ = []
390−
391−instance ToJSON Search where
392− toJSON (Search query filter sort trackSortScores from size) =
393− object merged where
394− lQuery = maybeJson "query" query
395− lFilter = maybeJson "filter" filter
396− lSort = maybeJsonF "sort" sort
397− merged = mconcat [[ "from" .= from
398− , "size" .= size
399− , "track_scores" .= trackSortScores]
400− , lQuery
401− , lFilter
402− , lSort]
403−
404−type Sort = [SortSpec]
405−
406−data SortSpec = DefaultSortSpec DefaultSort
407− | GeoDistanceSortSpec SortOrder GeoPoint deriving (Eq, Show)
408−
409−instance ToJSON SortSpec where
410− toJSON (DefaultSortSpec
411− (DefaultSort (FieldName sortFieldName) sortOrder ignoreUnmapped
412− sortMode missingSort nestedFilter)) =
413− object [sortFieldName .= object merged] where
414− base = ["order" .= toJSON sortOrder
415− , "ignore_unmapped" .= ignoreUnmapped]
416− lSortMode = maybeJson "mode" sortMode
417− lMissingSort = maybeJson "missing" missingSort
418− lNestedFilter = maybeJson "nested_filter" nestedFilter
419− merged = mconcat [base, lSortMode, lMissingSort, lNestedFilter]
420−
421−instance ToJSON SortOrder where
422− toJSON Ascending = String "asc"
423− toJSON Descending = String "desc"
424−
425−instance ToJSON SortMode where
426− toJSON SortMin = String "min"
427− toJSON SortMax = String "max"
428− toJSON SortSum = String "sum"
429− toJSON SortAvg = String "avg"
430−
431−instance ToJSON Missing where
432− toJSON LastMissing = String "_last"
433− toJSON FirstMissing = String "_first"
434− toJSON (CustomMissing txt) = String txt
435−
436−data DefaultSort =
437− DefaultSort { sortFieldName :: FieldName
438− , sortOrder :: SortOrder
439− -- default False
440− , ignoreUnmapped :: Bool
441− , sortMode :: Maybe SortMode
442− , missingSort :: Maybe Missing
443− , nestedFilter :: Maybe Filter } deriving (Eq, Show)
444−
445−data SortOrder = Ascending
446− | Descending deriving (Eq, Show)
447−
448−data Missing = LastMissing
449− | FirstMissing
450− | CustomMissing Text deriving (Eq, Show)
451−
452−data SortMode = SortMin
453− | SortMax
454− | SortSum
455− | SortAvg deriving (Eq, Show)
456−
457−-- status:active
458−-- author:"John Smith"
459−-- for book.title and book.date containing quick OR brown, book.\*:(quick brown)
460−-- field title has no value or doesn't exist, _missing_:title
461−-- field title has any non-null value, _exists:title
462−
463−-- type DisMax = Bool -- "use_dis_max"
464−-- newtype TieBreaker = TieBreaker Int deriving (Eq, Show)
465−-- data QueryField = DefaultField Text
466−-- | Fields [Text] DisMax TieBreaker deriving (Eq, Show)
467−
468−-- -- this is will go away later
469−
470−-- data QueryStringQuery =
471−-- QueryStringQuery { query :: Text
472−-- -- default _all
473−-- , field :: Maybe QueryField
474−-- -- default OR
475−-- , defaultOperator :: Maybe BooleanOperator
476−-- -- analyzer name
477−-- , analyzer :: Maybe Text
478−-- -- default true
479−-- , allowLeadingWildcard :: Maybe Bool
480−-- -- default true
481−-- , lowercaseExpandedTerms :: Maybe Bool
482−-- -- default true
483−-- , enablePositionIncrements :: Maybe Bool
484−-- -- default 50
485−-- , fuzzyMaxExpansions :: Maybe Int
486−-- -- Fuzziness -- default AUTO, add type later
487−-- , fuzziness :: Maybe Text
488−-- , fuzzyPrefixLength :: Maybe Int -- default 0
489−-- -- default 0, 0 means exact phrase matches
490−-- , phraseSlop :: Maybe Int
491−-- -- default 1.0
492−-- , boost :: Maybe Double
493−-- -- default false, true forces wildcard analysis
494−-- , analyzeWildcard :: Maybe Bool
495−-- -- default false
496−-- , autoGeneratePhraseQueries :: Maybe Bool
497−-- -- # "should" clauses in the boolean query should match
498−-- , minimumShouldMatch :: Maybe Text
499−-- -- Text to handle weird % and other cases. Needs type
500−-- -- default false, true shuts off format based failures
501−-- , lenient :: Maybe Bool
502−-- -- default ROOT, locale used for string conversions
503−-- , locale :: Maybe Text
504−-- } deriving (Eq, Show)
505−
506−-- emptyQueryStringQuery = QueryStringQuery "" Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
507−-- queryStringQuery query = emptyQueryStringQuery { query = query }
508−
509−-- type FieldName = Text
510−
511−type Cache = Bool -- caching on/off
512−defaultCache = False
513−
514−type PrefixValue = Text
515−
516−data BooleanOperator = And | Or deriving (Eq, Show)
517−
518−newtype IndexName = IndexName String deriving (Eq, Generic, Show)
519−newtype MappingName = MappingName String deriving (Eq, Generic, Show)
520−newtype DocId = DocId String deriving (Eq, Generic, Show)
521−newtype QueryString = QueryString Text deriving (Eq, Show)
522−newtype FieldName = FieldName Text deriving (Eq, Show)
523−newtype CacheName = CacheName Text deriving (Eq, Show)
524−newtype CacheKey = CacheKey Text deriving (Eq, Show)
525−newtype Existence = Existence Bool deriving (Eq, Show)
526−newtype NullValue = NullValue Bool deriving (Eq, Show)
527−
528−unpackId :: DocId -> String
529−unpackId (DocId docId) = docId
530−
531−instance FromJSON IndexName
532−instance FromJSON MappingName
533−instance FromJSON DocId
534−
535−-- data QueryType = BooleanQueryType
536−-- | PhraseQueryType
537−-- | PhrasePrefixQueryType deriving (Eq, Show)
538−type Boost = Double
539−
540−data Query = TermQuery Term (Maybe Boost)
541− | ConstantScoreFilter Filter Boost
542− | ConstantScoreQuery Query Boost
543− deriving (Eq, Show)
544−
545−instance ToJSON Query where
546− toJSON (TermQuery (Term termField termValue) boost) =
547− object ["term" .=
548− object [termField .= object merged]]
549− where
550− base = ["value" .= termValue]
551− boosted = case boost of
552− (Just boostValue) -> ["boost" .= boostValue]
553− Nothing -> []
554− merged = mappend base boosted
555−
556−data Filter = AndFilter [Filter] Cache
557− | OrFilter [Filter] Cache
558− | NotFilter Filter Cache
559− | IdentityFilter
560− | BoolFilter BoolMatch
561− | ExistsFilter FieldName -- always cached
562− | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType
563− | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache
564− | GeoDistanceRangeFilter GeoPoint DistanceRange
565− | GeoPolygonFilter FieldName [LatLon]
566− | IdsFilter MappingName [DocId]
567− | LimitFilter Int
568− | MissingFilter FieldName Existence NullValue
569− | PrefixFilter FieldName PrefixValue Cache
570− | RangeFilter FieldName (Either HalfRange Range) RangeExecution Cache
571− | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey
572− deriving (Eq, Show)
573−
574−class Monoid a => Seminearring a where
575− -- 0, +, *
576− (<||>) :: a -> a -> a
577− (<&&>) :: a -> a -> a
578− (<&&>) = mappend
579−
580−infixr 5 <||>
581−infixr 5 <&&>
582−
583−instance Monoid Filter where
584− mempty = IdentityFilter
585− mappend a b = AndFilter [a, b] defaultCache
586−
587−instance Seminearring Filter where
588− a <||> b = OrFilter [a, b] defaultCache
589−
590−instance ToJSON Filter where
591− toJSON (AndFilter filters cache) =
592− object ["and" .= fmap toJSON filters
593− , "_cache" .= cache]
594−
595− toJSON (OrFilter filters cache) =
596− object ["or" .= fmap toJSON filters
597− , "_cache" .= cache]
598−
599− toJSON (NotFilter filter cache) =
600− object ["not" .=
601− object ["filter" .= toJSON filter
602− , "_cache" .= cache]]
603−
604− toJSON (IdentityFilter) =
605− object ["match_all" .= object []]
606−
607− toJSON (ExistsFilter (FieldName fieldName)) =
608− object ["exists" .= object
609− ["field" .= fieldName]]
610−
611− toJSON (BoolFilter boolMatch) =
612− object ["bool" .= toJSON boolMatch]
613−
614− toJSON (GeoBoundingBoxFilter bbConstraint filterType) =
615− object ["geo_bounding_box" .= toJSON bbConstraint
616− , "type" .= toJSON filterType]
617−
618− toJSON (GeoDistanceFilter (GeoPoint (FieldName geoField) latLon)
619− distance distanceType optimizeBbox cache) =
620− object ["geo_distance" .=
621− object ["distance" .= toJSON distance
622− , "distance_type" .= toJSON distanceType
623− , "optimize_bbox" .= optimizeBbox
624− , geoField .= toJSON latLon
625− , "_cache" .= cache]]
626−
627− toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName geoField) latLon)
628− (DistanceRange distanceFrom distanceTo)) =
629− object ["geo_distance_range" .=
630− object ["from" .= toJSON distanceFrom
631− , "to" .= toJSON distanceTo
632− , geoField .= toJSON latLon]]
633−
634− toJSON (GeoPolygonFilter (FieldName geoField) latLons) =
635− object ["geo_polygon" .=
636− object [geoField .=
637− object ["points" .= fmap toJSON latLons]]]
638−
639− toJSON (IdsFilter (MappingName mappingName) values) =
640− object ["ids" .=
641− object ["type" .= mappingName
642− , "values" .= fmap (T.pack . unpackId) values]]
643−
644− toJSON (LimitFilter limit) =
645− object ["limit" .= object ["value" .= limit]]
646−
647− toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =
648− object ["missing" .=
649− object ["field" .= fieldName
650− , "existence" .= existence
651− , "null_value" .= nullValue]]
652−
653− toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) =
654− object ["prefix" .=
655− object [fieldName .= fieldValue
656− , "_cache" .= cache]]
657−
658− toJSON (RangeFilter (FieldName fieldName) (Left halfRange) rangeExecution cache) =
659− object ["range" .=
660− object [fieldName .=
661− object [key .= val]
662− , "execution" .= toJSON rangeExecution
663− , "_cache" .= cache]]
664− where
665− (key, val) = halfRangeToKV halfRange
666−
667− toJSON (RangeFilter (FieldName fieldName) (Right range) rangeExecution cache) =
668− object ["range" .=
669− object [fieldName .=
670− object [lessKey .= lessVal
671− , greaterKey .= greaterVal]
672− , "execution" .= toJSON rangeExecution
673− , "_cache" .= cache]]
674− where
675− (lessKey, lessVal, greaterKey, greaterVal) = rangeToKV range
676−
677− toJSON (RegexpFilter (FieldName fieldName)
678− (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =
679− object ["regexp" .=
680− object [fieldName .=
681− object ["value" .= regexText
682− , "flags" .= toJSON flags]
683− , "_name" .= cacheName
684− , "_cache" .= cache
685− , "_cache_key" .= cacheKey]]
686−
687−instance ToJSON GeoPoint where
688− toJSON (GeoPoint (FieldName geoField) latLon) =
689− object [geoField .= toJSON latLon]
690−
691−showText :: Show a => a -> Text
692−showText = T.pack . show
693−
694−instance ToJSON Distance where
695− toJSON (Distance coefficient unit) =
696− String boltedTogether where
697− coefText = showText coefficient
698− (String unitText) = (toJSON unit)
699− boltedTogether = mappend coefText unitText
700−
701−instance ToJSON DistanceUnit where
702− toJSON Miles = String "mi"
703− toJSON Yards = String "yd"
704− toJSON Feet = String "ft"
705− toJSON Inches = String "in"
706− toJSON Kilometers = String "km"
707− toJSON Meters = String "m"
708− toJSON Centimeters = String "cm"
709− toJSON Millimeters = String "mm"
710− toJSON NauticalMiles = String "nmi"
711−
712−instance ToJSON DistanceType where
713− toJSON Arc = String "arc"
714− toJSON SloppyArc = String "sloppy_arc"
715− toJSON Plane = String "plane"
716−
717−instance ToJSON OptimizeBbox where
718− toJSON NoOptimizeBbox = String "none"
719− toJSON (OptimizeGeoFilterType gft) = toJSON gft
720−
721−instance ToJSON GeoBoundingBoxConstraint where
722− toJSON (GeoBoundingBoxConstraint (FieldName geoBBField) constraintBox cache) =
723− object [geoBBField .= toJSON constraintBox
724− , "_cache" .= cache]
725−
726−instance ToJSON GeoFilterType where
727− toJSON GeoFilterMemory = String "memory"
728− toJSON GeoFilterIndexed = String "indexed"
729−
730−instance ToJSON GeoBoundingBox where
731− toJSON (GeoBoundingBox topLeft bottomRight) =
732− object ["top_left" .= toJSON topLeft
733− , "bottom_right" .= toJSON bottomRight]
734−
735−instance ToJSON LatLon where
736− toJSON (LatLon lat lon) =
737− object ["lat" .= lat
738− , "lon" .= lon]
739−
740−-- lt, lte | gt, gte
741−newtype LessThan = LessThan Double deriving (Eq, Show)
742−newtype LessThanEq = LessThanEq Double deriving (Eq, Show)
743−newtype GreaterThan = GreaterThan Double deriving (Eq, Show)
744−newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Show)
745−
746−data HalfRange = HalfRangeLt LessThan
747− | HalfRangeLte LessThanEq
748− | HalfRangeGt GreaterThan
749− | HalfRangeGte GreaterThanEq deriving (Eq, Show)
750−
751−data Range = RangeLtGt LessThan GreaterThan
752− | RangeLtGte LessThan GreaterThanEq
753− | RangeLteGt LessThanEq GreaterThan
754− | RangeLteGte LessThanEq GreaterThanEq deriving (Eq, Show)
755−
756−halfRangeToKV :: HalfRange -> (Text, Double)
757−halfRangeToKV (HalfRangeLt (LessThan n)) = ("lt", n)
758−halfRangeToKV (HalfRangeLte (LessThanEq n)) = ("lte", n)
759−halfRangeToKV (HalfRangeGt (GreaterThan n)) = ("gt", n)
760−halfRangeToKV (HalfRangeGte (GreaterThanEq n)) = ("gte", n)
761−
762−rangeToKV :: Range -> (Text, Double, Text, Double)
763−rangeToKV (RangeLtGt (LessThan m) (GreaterThan n)) = ("lt", m, "gt", n)
764−rangeToKV (RangeLtGte (LessThan m) (GreaterThanEq n)) = ("lt", m, "gte", n)
765−rangeToKV (RangeLteGt (LessThanEq m) (GreaterThan n)) = ("lte", m, "gt", n)
766−rangeToKV (RangeLteGte (LessThanEq m) (GreaterThanEq n)) = ("lte", m, "gte", n)
767−
768−data RangeExecution = RangeExecutionIndex
769− | RangeExecutionFielddata deriving (Eq, Show)
770−
771−-- index for smaller ranges, fielddata for longer ranges
772−instance ToJSON RangeExecution where
773− toJSON RangeExecutionIndex = "index"
774− toJSON RangeExecutionFielddata = "fielddata"
775−
776−newtype Regexp = Regexp Text deriving (Eq, Show)
777−data RegexpFlags = RegexpAll
778− | Complement
779− | Interval
780− | Intersection
781− | AnyString
782− | CompInterval
783− | CompIntersection
784− | CompAnyString
785− | IntervalIntersection
786− | IntervalAnyString
787− | IntersectionAnyString deriving (Eq, Show)
788−
789−instance ToJSON RegexpFlags where
790− toJSON RegexpAll = String "ALL"
791− toJSON Complement = String "COMPLEMENT"
792− toJSON Interval = String "INTERVAL"
793− toJSON Intersection = String "INTERSECTION"
794− toJSON AnyString = String "ANYSTRING"
795− toJSON CompInterval = String "COMPLEMENT|INTERVAL"
796− toJSON CompIntersection = String "COMPLEMENT|INTERSECTION"
797− toJSON CompAnyString = String "COMPLEMENT|ANYSTRING"
798− toJSON IntervalIntersection = String "INTERVAL|INTERSECTION"
799− toJSON IntervalAnyString = String "INTERVAL|ANYSTRING"
800− toJSON IntersectionAnyString = String "INTERSECTION|ANYSTRING"
801−
802−-- phew. Coulda used Agda style case breaking there but, you know, whatever. :)
803−
804−data Term = Term { termField :: Text
805− , termValue :: Text } deriving (Eq, Show)
806−
807−instance ToJSON Term where
808− toJSON (Term field value) = object ["term" .= object
809− [field .= value]]
810−
811−data BoolMatch = MustMatch Term Cache
812− | MustNotMatch Term Cache
813− | ShouldMatch [Term] Cache deriving (Eq, Show)
814−
815−instance ToJSON BoolMatch where
816− toJSON (MustMatch term cache) = object ["must" .= toJSON term,
817− "_cache" .= cache]
818− toJSON (MustNotMatch term cache) = object ["must_not" .= toJSON term,
819− "_cache" .= cache]
820− toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
821− "_cache" .= cache]
822−
823−-- "memory" or "indexed"
824−data GeoFilterType = GeoFilterMemory
825− | GeoFilterIndexed deriving (Eq, Show)
826−
827−
828−data LatLon = LatLon { lat :: Double
829− , lon :: Double } deriving (Eq, Show)
830−
831−data GeoBoundingBox =
832− GeoBoundingBox { topLeft :: LatLon
833− , bottomRight :: LatLon } deriving (Eq, Show)
834−
835−data GeoBoundingBoxConstraint =
836− GeoBoundingBoxConstraint { geoBBField :: FieldName
837− , constraintBox :: GeoBoundingBox
838− , bbConstraintcache :: Cache
839− } deriving (Eq, Show)
840−
841−data GeoPoint =
842− GeoPoint { geoField :: FieldName
843− , latLon :: LatLon} deriving (Eq, Show)
844−
845−data DistanceUnit = Miles
846− | Yards
847− | Feet
848− | Inches
849− | Kilometers
850− | Meters
851− | Centimeters
852− | Millimeters
853− | NauticalMiles deriving (Eq, Show)
854−
855−data DistanceType = Arc
856− | SloppyArc -- doesn't exist <1.0
857− | Plane deriving (Eq, Show)
858−
859−data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
860− | NoOptimizeBbox deriving (Eq, Show)
861−
862−data Distance =
863− Distance { coefficient :: Double
864− , unit :: DistanceUnit } deriving (Eq, Show)
865−
866−data DistanceRange =
867− DistanceRange { distanceFrom :: Distance
868− , distanceTo :: Distance } deriving (Eq, Show)
869−
870−data FromJSON a => SearchResult a =
871− SearchResult { took :: Int
872− , timedOut :: Bool
873− , shards :: ShardResult
874− , searchHits :: SearchHits a } deriving (Eq, Show)
875−
876−type Score = Double
877−
878−data FromJSON a => SearchHits a =
879− SearchHits { hitsTotal :: Int
880− , maxScore :: Score
881− , hits :: [Hit a] } deriving (Eq, Show)
882−
883−data FromJSON a => Hit a =
884− Hit { hitIndex :: IndexName
885− , hitType :: MappingName
886− , hitDocId :: DocId
887− , hitScore :: Score
888− , hitSource :: a } deriving (Eq, Show)
889−
890−data ShardResult =
891− ShardResult { shardTotal :: Int
892− , shardsSuccessful :: Int
893− , shardsFailed :: Int } deriving (Eq, Show, Generic)
894−
895−instance (FromJSON a, ToJSON a) => FromJSON (SearchResult a) where
896− parseJSON (Object v) = SearchResult <$>
897− v .: "took" <*>
898− v .: "timed_out" <*>
899− v .: "_shards" <*>
900− v .: "hits"
901− parseJSON _ = empty
902−
903−instance (FromJSON a, ToJSON a) => FromJSON (SearchHits a) where
904− parseJSON (Object v) = SearchHits <$>
905− v .: "total" <*>
906− v .: "max_score" <*>
907− v .: "hits"
908− parseJSON _ = empty
909−
910−instance (FromJSON a, ToJSON a) => FromJSON (Hit a) where
911− parseJSON (Object v) = Hit <$>
912− v .: "_index" <*>
913− v .: "_type" <*>
914− v .: "_id" <*>
915− v .: "_score" <*>
916− v .: "_source"
917− parseJSON _ = empty
918−
919−instance FromJSON ShardResult where
920− parseJSON (Object v) = ShardResult <$>
921− v .: "total" <*>
922− v .: "successful" <*>
923− v .: "failed"
924− parseJSON _ = empty
Database/Bloodhound/Types.hsnew file+350
@@ -0,0 +1,350 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+
3+module Database.Bloodhound.Types
4+ ( defaultCache
5+ , defaultIndexSettings
6+ , halfRangeToKV
7+ , maybeJson
8+ , maybeJsonF
9+ , rangeToKV
10+ , showText
11+ , unpackId
12+ , Version(..)
13+ , Status(..)
14+ , Existence(..)
15+ , NullValue(..)
16+ , IndexSettings(..)
17+ , Server(..)
18+ , Reply(..)
19+ , EsResult(..)
20+ , Query(..)
21+ , Search(..)
22+ , SearchResult(..)
23+ , SearchHits(..)
24+ , ShardResult(..)
25+ , Hit(..)
26+ , Filter(..)
27+ , Seminearring(..)
28+ , BoolMatch(..)
29+ , Term(..)
30+ , GeoPoint(..)
31+ , GeoBoundingBoxConstraint(..)
32+ , GeoBoundingBox(..)
33+ , GeoFilterType(..)
34+ , Distance(..)
35+ , DistanceUnit(..)
36+ , DistanceType(..)
37+ , DistanceRange(..)
38+ , OptimizeBbox(..)
39+ , LatLon(..)
40+ , Range(..)
41+ , HalfRange(..)
42+ , RangeExecution(..)
43+ , LessThan(..)
44+ , LessThanEq(..)
45+ , GreaterThan(..)
46+ , GreaterThanEq(..)
47+ , Regexp(..)
48+ , RegexpFlags(..)
49+ , FieldName(..)
50+ , IndexName(..)
51+ , MappingName(..)
52+ , DocId(..)
53+ , CacheName(..)
54+ , CacheKey(..)
55+ , BulkOperation(..)
56+ , ReplicaCount(..)
57+ , ShardCount(..)
58+ , Sort(..)
59+ , SortMode(..)
60+ , SortOrder(..)
61+ , SortSpec(..)
62+ , DefaultSort(..)
63+ , Missing(..)
64+ , OpenCloseIndex(..)
65+ , Method(..)
66+ ) where
67+
68+import Data.Aeson
69+import qualified Data.ByteString.Lazy.Char8 as L
70+import Data.Text (Text)
71+import qualified Data.Text as T
72+import Data.Time.Clock (UTCTime)
73+import Database.Bloodhound.Types.Class
74+import GHC.Generics (Generic)
75+import Network.HTTP.Conduit
76+import qualified Network.HTTP.Types.Method as NHTM
77+
78+data Version = Version { number :: Text
79+ , build_hash :: Text
80+ , build_timestamp :: UTCTime
81+ , build_snapshot :: Bool
82+ , lucene_version :: Text } deriving (Show, Generic)
83+
84+data (FromJSON a, ToJSON a) => Status a =
85+ Status { ok :: Bool
86+ , status :: Int
87+ , name :: Text
88+ , version :: a
89+ , tagline :: Text } deriving (Eq, Show)
90+
91+newtype ShardCount = ShardCount Int deriving (Eq, Show, Generic)
92+newtype ReplicaCount = ReplicaCount Int deriving (Eq, Show, Generic)
93+
94+data IndexSettings =
95+ IndexSettings { indexShards :: ShardCount
96+ , indexReplicas :: ReplicaCount } deriving (Eq, Show)
97+
98+defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
99+
100+data Strategy = RoundRobinStrat | RandomStrat | HeadStrat deriving (Eq, Show)
101+
102+newtype Server = Server String deriving (Eq, Show)
103+
104+type Reply = Network.HTTP.Conduit.Response L.ByteString
105+type Method = NHTM.Method
106+
107+data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Show)
108+
109+data FieldType = GeoPointType
110+ | GeoShapeType
111+ | FloatType
112+ | IntegerType
113+ | LongType
114+ | ShortType
115+ | ByteType deriving (Eq, Show)
116+
117+data FieldDefinition =
118+ FieldDefinition { fieldType :: FieldType } deriving (Eq, Show)
119+
120+data MappingField =
121+ MappingField { mappingFieldName :: FieldName
122+ , fieldDefinition :: FieldDefinition } deriving (Eq, Show)
123+
124+data Mapping = Mapping { typeName :: Text
125+ , fields :: [MappingField] } deriving (Eq, Show)
126+
127+data BulkOperation =
128+ BulkIndex IndexName MappingName DocId Value
129+ | BulkCreate IndexName MappingName DocId Value
130+ | BulkDelete IndexName MappingName DocId
131+ | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show)
132+
133+data EsResult a = EsResult { _index :: Text
134+ , _type :: Text
135+ , _id :: Text
136+ , _version :: Int
137+ , found :: Maybe Bool
138+ , _source :: a } deriving (Eq, Show)
139+
140+type Sort = [SortSpec]
141+
142+data SortSpec = DefaultSortSpec DefaultSort
143+ | GeoDistanceSortSpec SortOrder GeoPoint deriving (Eq, Show)
144+
145+data DefaultSort =
146+ DefaultSort { sortFieldName :: FieldName
147+ , sortOrder :: SortOrder
148+ -- default False
149+ , ignoreUnmapped :: Bool
150+ , sortMode :: Maybe SortMode
151+ , missingSort :: Maybe Missing
152+ , nestedFilter :: Maybe Filter } deriving (Eq, Show)
153+
154+data SortOrder = Ascending
155+ | Descending deriving (Eq, Show)
156+
157+data Missing = LastMissing
158+ | FirstMissing
159+ | CustomMissing Text deriving (Eq, Show)
160+
161+data SortMode = SortMin
162+ | SortMax
163+ | SortSum
164+ | SortAvg deriving (Eq, Show)
165+type Cache = Bool -- caching on/off
166+defaultCache = False
167+
168+type PrefixValue = Text
169+
170+data BooleanOperator = And | Or deriving (Eq, Show)
171+
172+newtype IndexName = IndexName String deriving (Eq, Generic, Show)
173+newtype MappingName = MappingName String deriving (Eq, Generic, Show)
174+newtype DocId = DocId String deriving (Eq, Generic, Show)
175+newtype QueryString = QueryString Text deriving (Eq, Show)
176+newtype FieldName = FieldName Text deriving (Eq, Show)
177+newtype CacheName = CacheName Text deriving (Eq, Show)
178+newtype CacheKey = CacheKey Text deriving (Eq, Show)
179+newtype Existence = Existence Bool deriving (Eq, Show)
180+newtype NullValue = NullValue Bool deriving (Eq, Show)
181+
182+unpackId :: DocId -> String
183+unpackId (DocId docId) = docId
184+
185+type Boost = Double
186+
187+data Search = Search { queryBody :: Maybe Query
188+ , filterBody :: Maybe Filter
189+ , sortBody :: Maybe Sort
190+ -- default False
191+ , trackSortScores :: Bool
192+ , from :: Int
193+ , size :: Int} deriving (Eq, Show)
194+
195+data Query = TermQuery Term (Maybe Boost)
196+ | ConstantScoreFilter Filter Boost
197+ | ConstantScoreQuery Query Boost
198+ deriving (Eq, Show)
199+
200+data Filter = AndFilter [Filter] Cache
201+ | OrFilter [Filter] Cache
202+ | NotFilter Filter Cache
203+ | IdentityFilter
204+ | BoolFilter BoolMatch
205+ | ExistsFilter FieldName -- always cached
206+ | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType
207+ | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache
208+ | GeoDistanceRangeFilter GeoPoint DistanceRange
209+ | GeoPolygonFilter FieldName [LatLon]
210+ | IdsFilter MappingName [DocId]
211+ | LimitFilter Int
212+ | MissingFilter FieldName Existence NullValue
213+ | PrefixFilter FieldName PrefixValue Cache
214+ | RangeFilter FieldName (Either HalfRange Range) RangeExecution Cache
215+ | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey
216+ deriving (Eq, Show)
217+
218+-- lt, lte | gt, gte
219+newtype LessThan = LessThan Double deriving (Eq, Show)
220+newtype LessThanEq = LessThanEq Double deriving (Eq, Show)
221+newtype GreaterThan = GreaterThan Double deriving (Eq, Show)
222+newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Show)
223+
224+data HalfRange = HalfRangeLt LessThan
225+ | HalfRangeLte LessThanEq
226+ | HalfRangeGt GreaterThan
227+ | HalfRangeGte GreaterThanEq deriving (Eq, Show)
228+
229+data Range = RangeLtGt LessThan GreaterThan
230+ | RangeLtGte LessThan GreaterThanEq
231+ | RangeLteGt LessThanEq GreaterThan
232+ | RangeLteGte LessThanEq GreaterThanEq deriving (Eq, Show)
233+
234+data RangeExecution = RangeExecutionIndex
235+ | RangeExecutionFielddata deriving (Eq, Show)
236+
237+newtype Regexp = Regexp Text deriving (Eq, Show)
238+data RegexpFlags = RegexpAll
239+ | Complement
240+ | Interval
241+ | Intersection
242+ | AnyString
243+ | CompInterval
244+ | CompIntersection
245+ | CompAnyString
246+ | IntervalIntersection
247+ | IntervalAnyString
248+ | IntersectionAnyString deriving (Eq, Show)
249+
250+halfRangeToKV :: HalfRange -> (Text, Double)
251+halfRangeToKV (HalfRangeLt (LessThan n)) = ("lt", n)
252+halfRangeToKV (HalfRangeLte (LessThanEq n)) = ("lte", n)
253+halfRangeToKV (HalfRangeGt (GreaterThan n)) = ("gt", n)
254+halfRangeToKV (HalfRangeGte (GreaterThanEq n)) = ("gte", n)
255+
256+rangeToKV :: Range -> (Text, Double, Text, Double)
257+rangeToKV (RangeLtGt (LessThan m) (GreaterThan n)) = ("lt", m, "gt", n)
258+rangeToKV (RangeLtGte (LessThan m) (GreaterThanEq n)) = ("lt", m, "gte", n)
259+rangeToKV (RangeLteGt (LessThanEq m) (GreaterThan n)) = ("lte", m, "gt", n)
260+rangeToKV (RangeLteGte (LessThanEq m) (GreaterThanEq n)) = ("lte", m, "gte", n)
261+
262+-- phew. Coulda used Agda style case breaking there but, you know, whatever. :)
263+
264+data Term = Term { termField :: Text
265+ , termValue :: Text } deriving (Eq, Show)
266+
267+data BoolMatch = MustMatch Term Cache
268+ | MustNotMatch Term Cache
269+ | ShouldMatch [Term] Cache deriving (Eq, Show)
270+
271+-- "memory" or "indexed"
272+data GeoFilterType = GeoFilterMemory
273+ | GeoFilterIndexed deriving (Eq, Show)
274+
275+
276+data LatLon = LatLon { lat :: Double
277+ , lon :: Double } deriving (Eq, Show)
278+
279+data GeoBoundingBox =
280+ GeoBoundingBox { topLeft :: LatLon
281+ , bottomRight :: LatLon } deriving (Eq, Show)
282+
283+data GeoBoundingBoxConstraint =
284+ GeoBoundingBoxConstraint { geoBBField :: FieldName
285+ , constraintBox :: GeoBoundingBox
286+ , bbConstraintcache :: Cache
287+ } deriving (Eq, Show)
288+
289+data GeoPoint =
290+ GeoPoint { geoField :: FieldName
291+ , latLon :: LatLon} deriving (Eq, Show)
292+
293+data DistanceUnit = Miles
294+ | Yards
295+ | Feet
296+ | Inches
297+ | Kilometers
298+ | Meters
299+ | Centimeters
300+ | Millimeters
301+ | NauticalMiles deriving (Eq, Show)
302+
303+data DistanceType = Arc
304+ | SloppyArc -- doesn't exist <1.0
305+ | Plane deriving (Eq, Show)
306+
307+data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
308+ | NoOptimizeBbox deriving (Eq, Show)
309+
310+data Distance =
311+ Distance { coefficient :: Double
312+ , unit :: DistanceUnit } deriving (Eq, Show)
313+
314+data DistanceRange =
315+ DistanceRange { distanceFrom :: Distance
316+ , distanceTo :: Distance } deriving (Eq, Show)
317+
318+data FromJSON a => SearchResult a =
319+ SearchResult { took :: Int
320+ , timedOut :: Bool
321+ , shards :: ShardResult
322+ , searchHits :: SearchHits a } deriving (Eq, Show)
323+
324+type Score = Double
325+
326+data FromJSON a => SearchHits a =
327+ SearchHits { hitsTotal :: Int
328+ , maxScore :: Score
329+ , hits :: [Hit a] } deriving (Eq, Show)
330+
331+data FromJSON a => Hit a =
332+ Hit { hitIndex :: IndexName
333+ , hitType :: MappingName
334+ , hitDocId :: DocId
335+ , hitScore :: Score
336+ , hitSource :: a } deriving (Eq, Show)
337+
338+data ShardResult =
339+ ShardResult { shardTotal :: Int
340+ , shardsSuccessful :: Int
341+ , shardsFailed :: Int } deriving (Eq, Show, Generic)
342+
343+-- defaultFieldMaybeJSON :: Text -> Maybe a ->
344+maybeJson field (Just value) = [field .= toJSON value]
345+maybeJson _ _ = []
346+maybeJsonF field (Just value) = [field .= fmap toJSON value]
347+maybeJsonF _ _ = []
348+
349+showText :: Show a => a -> Text
350+showText = T.pack . show
Database/Bloodhound/Types/Class.hsnew file+15
@@ -0,0 +1,15 @@
1+module Database.Bloodhound.Types.Class
2+ ( Seminearring(..) )
3+ where
4+
5+import Data.Aeson
6+import Data.Monoid
7+
8+class Monoid a => Seminearring a where
9+ -- 0, +, *
10+ (<||>) :: a -> a -> a
11+ (<&&>) :: a -> a -> a
12+ (<&&>) = mappend
13+
14+infixr 5 <||>
15+infixr 5 <&&>
Database/Bloodhound/Types/Instances.hsnew file+310
@@ -0,0 +1,310 @@
1+module Database.Bloodhound.Types.Instances
2+ ( Monoid(..)
3+ , Seminearring(..)
4+ , ToJSON(..)
5+ ) where
6+
7+import Control.Applicative
8+import Data.Aeson
9+import Data.Monoid
10+import qualified Data.Text as T
11+import Database.Bloodhound.Types
12+import Database.Bloodhound.Types.Class
13+
14+instance Monoid Filter where
15+ mempty = IdentityFilter
16+ mappend a b = AndFilter [a, b] defaultCache
17+
18+instance Seminearring Filter where
19+ a <||> b = OrFilter [a, b] defaultCache
20+
21+instance ToJSON Filter where
22+ toJSON (AndFilter filters cache) =
23+ object ["and" .= fmap toJSON filters
24+ , "_cache" .= cache]
25+
26+ toJSON (OrFilter filters cache) =
27+ object ["or" .= fmap toJSON filters
28+ , "_cache" .= cache]
29+
30+ toJSON (NotFilter filter cache) =
31+ object ["not" .=
32+ object ["filter" .= toJSON filter
33+ , "_cache" .= cache]]
34+
35+ toJSON (IdentityFilter) =
36+ object ["match_all" .= object []]
37+
38+ toJSON (ExistsFilter (FieldName fieldName)) =
39+ object ["exists" .= object
40+ ["field" .= fieldName]]
41+
42+ toJSON (BoolFilter boolMatch) =
43+ object ["bool" .= toJSON boolMatch]
44+
45+ toJSON (GeoBoundingBoxFilter bbConstraint filterType) =
46+ object ["geo_bounding_box" .= toJSON bbConstraint
47+ , "type" .= toJSON filterType]
48+
49+ toJSON (GeoDistanceFilter (GeoPoint (FieldName geoField) latLon)
50+ distance distanceType optimizeBbox cache) =
51+ object ["geo_distance" .=
52+ object ["distance" .= toJSON distance
53+ , "distance_type" .= toJSON distanceType
54+ , "optimize_bbox" .= optimizeBbox
55+ , geoField .= toJSON latLon
56+ , "_cache" .= cache]]
57+
58+ toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName geoField) latLon)
59+ (DistanceRange distanceFrom distanceTo)) =
60+ object ["geo_distance_range" .=
61+ object ["from" .= toJSON distanceFrom
62+ , "to" .= toJSON distanceTo
63+ , geoField .= toJSON latLon]]
64+
65+ toJSON (GeoPolygonFilter (FieldName geoField) latLons) =
66+ object ["geo_polygon" .=
67+ object [geoField .=
68+ object ["points" .= fmap toJSON latLons]]]
69+
70+ toJSON (IdsFilter (MappingName mappingName) values) =
71+ object ["ids" .=
72+ object ["type" .= mappingName
73+ , "values" .= fmap (T.pack . unpackId) values]]
74+
75+ toJSON (LimitFilter limit) =
76+ object ["limit" .= object ["value" .= limit]]
77+
78+ toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =
79+ object ["missing" .=
80+ object ["field" .= fieldName
81+ , "existence" .= existence
82+ , "null_value" .= nullValue]]
83+
84+ toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) =
85+ object ["prefix" .=
86+ object [fieldName .= fieldValue
87+ , "_cache" .= cache]]
88+
89+ toJSON (RangeFilter (FieldName fieldName) (Left halfRange) rangeExecution cache) =
90+ object ["range" .=
91+ object [fieldName .=
92+ object [key .= val]
93+ , "execution" .= toJSON rangeExecution
94+ , "_cache" .= cache]]
95+ where
96+ (key, val) = halfRangeToKV halfRange
97+
98+ toJSON (RangeFilter (FieldName fieldName) (Right range) rangeExecution cache) =
99+ object ["range" .=
100+ object [fieldName .=
101+ object [lessKey .= lessVal
102+ , greaterKey .= greaterVal]
103+ , "execution" .= toJSON rangeExecution
104+ , "_cache" .= cache]]
105+ where
106+ (lessKey, lessVal, greaterKey, greaterVal) = rangeToKV range
107+
108+ toJSON (RegexpFilter (FieldName fieldName)
109+ (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =
110+ object ["regexp" .=
111+ object [fieldName .=
112+ object ["value" .= regexText
113+ , "flags" .= toJSON flags]
114+ , "_name" .= cacheName
115+ , "_cache" .= cache
116+ , "_cache_key" .= cacheKey]]
117+
118+instance ToJSON GeoPoint where
119+ toJSON (GeoPoint (FieldName geoField) latLon) =
120+ object [geoField .= toJSON latLon]
121+
122+instance ToJSON Query where
123+ toJSON (TermQuery (Term termField termValue) boost) =
124+ object ["term" .=
125+ object [termField .= object merged]]
126+ where
127+ base = ["value" .= termValue]
128+ boosted = case boost of
129+ (Just boostValue) -> ["boost" .= boostValue]
130+ Nothing -> []
131+ merged = mappend base boosted
132+
133+instance ToJSON Version
134+instance FromJSON Version
135+
136+instance (FromJSON a, ToJSON a) => FromJSON (Status a) where
137+ parseJSON (Object v) = Status <$>
138+ v .: "ok" <*>
139+ v .: "status" <*>
140+ v .: "name" <*>
141+ v .: "version" <*>
142+ v .: "tagline"
143+ parseJSON _ = empty
144+
145+instance ToJSON IndexSettings where
146+ toJSON (IndexSettings s r) = object ["settings" .= object ["shards" .= s, "replicas" .= r]]
147+
148+instance ToJSON ReplicaCount
149+instance ToJSON ShardCount
150+
151+instance (FromJSON a, ToJSON a) => FromJSON (EsResult a) where
152+ parseJSON (Object v) = EsResult <$>
153+ v .: "_index" <*>
154+ v .: "_type" <*>
155+ v .: "_id" <*>
156+ v .: "_version" <*>
157+ v .:? "found" <*>
158+ v .: "_source"
159+ parseJSON _ = empty
160+
161+instance ToJSON Search where
162+ toJSON (Search query filter sort trackSortScores from size) =
163+ object merged where
164+ lQuery = maybeJson "query" query
165+ lFilter = maybeJson "filter" filter
166+ lSort = maybeJsonF "sort" sort
167+ merged = mconcat [[ "from" .= from
168+ , "size" .= size
169+ , "track_scores" .= trackSortScores]
170+ , lQuery
171+ , lFilter
172+ , lSort]
173+
174+instance ToJSON SortSpec where
175+ toJSON (DefaultSortSpec
176+ (DefaultSort (FieldName sortFieldName) sortOrder ignoreUnmapped
177+ sortMode missingSort nestedFilter)) =
178+ object [sortFieldName .= object merged] where
179+ base = ["order" .= toJSON sortOrder
180+ , "ignore_unmapped" .= ignoreUnmapped]
181+ lSortMode = maybeJson "mode" sortMode
182+ lMissingSort = maybeJson "missing" missingSort
183+ lNestedFilter = maybeJson "nested_filter" nestedFilter
184+ merged = mconcat [base, lSortMode, lMissingSort, lNestedFilter]
185+
186+instance ToJSON SortOrder where
187+ toJSON Ascending = String "asc"
188+ toJSON Descending = String "desc"
189+
190+instance ToJSON SortMode where
191+ toJSON SortMin = String "min"
192+ toJSON SortMax = String "max"
193+ toJSON SortSum = String "sum"
194+ toJSON SortAvg = String "avg"
195+
196+instance ToJSON Missing where
197+ toJSON LastMissing = String "_last"
198+ toJSON FirstMissing = String "_first"
199+ toJSON (CustomMissing txt) = String txt
200+
201+instance FromJSON IndexName
202+instance FromJSON MappingName
203+instance FromJSON DocId
204+
205+instance ToJSON Distance where
206+ toJSON (Distance coefficient unit) =
207+ String boltedTogether where
208+ coefText = showText coefficient
209+ (String unitText) = (toJSON unit)
210+ boltedTogether = mappend coefText unitText
211+
212+instance ToJSON DistanceUnit where
213+ toJSON Miles = String "mi"
214+ toJSON Yards = String "yd"
215+ toJSON Feet = String "ft"
216+ toJSON Inches = String "in"
217+ toJSON Kilometers = String "km"
218+ toJSON Meters = String "m"
219+ toJSON Centimeters = String "cm"
220+ toJSON Millimeters = String "mm"
221+ toJSON NauticalMiles = String "nmi"
222+
223+instance ToJSON DistanceType where
224+ toJSON Arc = String "arc"
225+ toJSON SloppyArc = String "sloppy_arc"
226+ toJSON Plane = String "plane"
227+
228+instance ToJSON OptimizeBbox where
229+ toJSON NoOptimizeBbox = String "none"
230+ toJSON (OptimizeGeoFilterType gft) = toJSON gft
231+
232+instance ToJSON GeoBoundingBoxConstraint where
233+ toJSON (GeoBoundingBoxConstraint (FieldName geoBBField) constraintBox cache) =
234+ object [geoBBField .= toJSON constraintBox
235+ , "_cache" .= cache]
236+
237+instance ToJSON GeoFilterType where
238+ toJSON GeoFilterMemory = String "memory"
239+ toJSON GeoFilterIndexed = String "indexed"
240+
241+instance ToJSON GeoBoundingBox where
242+ toJSON (GeoBoundingBox topLeft bottomRight) =
243+ object ["top_left" .= toJSON topLeft
244+ , "bottom_right" .= toJSON bottomRight]
245+
246+instance ToJSON LatLon where
247+ toJSON (LatLon lat lon) =
248+ object ["lat" .= lat
249+ , "lon" .= lon]
250+
251+-- index for smaller ranges, fielddata for longer ranges
252+instance ToJSON RangeExecution where
253+ toJSON RangeExecutionIndex = "index"
254+ toJSON RangeExecutionFielddata = "fielddata"
255+
256+instance ToJSON RegexpFlags where
257+ toJSON RegexpAll = String "ALL"
258+ toJSON Complement = String "COMPLEMENT"
259+ toJSON Interval = String "INTERVAL"
260+ toJSON Intersection = String "INTERSECTION"
261+ toJSON AnyString = String "ANYSTRING"
262+ toJSON CompInterval = String "COMPLEMENT|INTERVAL"
263+ toJSON CompIntersection = String "COMPLEMENT|INTERSECTION"
264+ toJSON CompAnyString = String "COMPLEMENT|ANYSTRING"
265+ toJSON IntervalIntersection = String "INTERVAL|INTERSECTION"
266+ toJSON IntervalAnyString = String "INTERVAL|ANYSTRING"
267+ toJSON IntersectionAnyString = String "INTERSECTION|ANYSTRING"
268+
269+instance ToJSON Term where
270+ toJSON (Term field value) = object ["term" .= object
271+ [field .= value]]
272+
273+instance ToJSON BoolMatch where
274+ toJSON (MustMatch term cache) = object ["must" .= toJSON term,
275+ "_cache" .= cache]
276+ toJSON (MustNotMatch term cache) = object ["must_not" .= toJSON term,
277+ "_cache" .= cache]
278+ toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
279+ "_cache" .= cache]
280+
281+instance (FromJSON a, ToJSON a) => FromJSON (SearchResult a) where
282+ parseJSON (Object v) = SearchResult <$>
283+ v .: "took" <*>
284+ v .: "timed_out" <*>
285+ v .: "_shards" <*>
286+ v .: "hits"
287+ parseJSON _ = empty
288+
289+instance (FromJSON a, ToJSON a) => FromJSON (SearchHits a) where
290+ parseJSON (Object v) = SearchHits <$>
291+ v .: "total" <*>
292+ v .: "max_score" <*>
293+ v .: "hits"
294+ parseJSON _ = empty
295+
296+instance (FromJSON a, ToJSON a) => FromJSON (Hit a) where
297+ parseJSON (Object v) = Hit <$>
298+ v .: "_index" <*>
299+ v .: "_type" <*>
300+ v .: "_id" <*>
301+ v .: "_score" <*>
302+ v .: "_source"
303+ parseJSON _ = empty
304+
305+instance FromJSON ShardResult where
306+ parseJSON (Object v) = ShardResult <$>
307+ v .: "total" <*>
308+ v .: "successful" <*>
309+ v .: "failed"
310+ parseJSON _ = empty
bloodhound.cabal+5−1
@@ -17,7 +17,11 @@ cabal-version: >=1.10
17
17
18library
18library
19 default-extensions: OverloadedStrings
19 default-extensions: OverloadedStrings
20− exposed-modules: Database.Bloodhound.Client
20+ exposed-modules: Database.Bloodhound
21+ Database.Bloodhound.Client
22+ Database.Bloodhound.Types
23+ Database.Bloodhound.Types.Class
24+ Database.Bloodhound.Types.Instances
21 build-depends: base >=4.3 && <5,
25 build-depends: base >=4.3 && <5,
22 bytestring >= 0.10,
26 bytestring >= 0.10,
23 transformers >= 0.3,
27 transformers >= 0.3,
tests/tests.hs+1−1
@@ -2,7 +2,7 @@
2
2
3module Main where
3module Main where
4
4
5−import Database.Bloodhound.Client
5+import Database.Bloodhound
6import Data.Aeson
6import Data.Aeson
7import Data.Either (Either(..))
7import Data.Either (Either(..))
8import Data.Maybe (fromJust)
8import Data.Maybe (fromJust)