bloodhound (empty) → 0.1.0.0
raw patch · 9 files changed
+2214/−0 lines, 9 filesdep +HTTPdep +QuickCheckdep +aesonsetup-changed
Dependencies added: HTTP, QuickCheck, aeson, aeson-pretty, base, blaze-builder, bloodhound, bytestring, conduit, containers, derive, failure, free, hspec, http-conduit, http-streams, http-types, io-streams, lens, quickcheck-instances, random, scientific, semigroups, text, time, transformers
Files
- Database/Bloodhound.hs +7/−0
- Database/Bloodhound/Client.hs +234/−0
- Database/Bloodhound/Types.hs +698/−0
- Database/Bloodhound/Types/Class.hs +15/−0
- Database/Bloodhound/Types/Instances.hs +657/−0
- LICENSE +202/−0
- Setup.hs +2/−0
- bloodhound.cabal +69/−0
- tests/tests.hs +330/−0
+ Database/Bloodhound.hs view
@@ -0,0 +1,7 @@+module Database.Bloodhound+ ( module Database.Bloodhound.Client+ , module Database.Bloodhound.Types+ ) where++import Database.Bloodhound.Client+import Database.Bloodhound.Types
+ Database/Bloodhound/Client.hs view
@@ -0,0 +1,234 @@+module Database.Bloodhound.Client+ ( createIndex+ , deleteIndex+ , createMapping+ , deleteMapping+ , indexDocument+ , getDocument+ , documentExists+ , deleteDocument+ , searchAll+ , searchByIndex+ , searchByType+ , refreshIndex+ , mkSearch+ , bulk+ )+ where++import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as L+import Data.ByteString.Builder+import Data.List (foldl', intercalate, intersperse)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Network.HTTP.Conduit+import qualified Network.HTTP.Types.Method as NHTM+import qualified Network.HTTP.Types.Status as NHTS+import Prelude hiding (head)++import Database.Bloodhound.Types+import Database.Bloodhound.Types.Class+import Database.Bloodhound.Types.Instances++-- find way to avoid destructuring Servers and Indexes?+-- make get, post, put, delete helpers.+-- make dispatch take URL last for better variance and+-- utilization of partial application++mkShardCount :: Int -> Maybe ShardCount+mkShardCount n+ | n < 1 = Nothing+ | n > 1000 = Nothing -- seriously, what the fuck?+ | otherwise = Just (ShardCount n)++mkReplicaCount :: Int -> Maybe ReplicaCount+mkReplicaCount n+ | n < 1 = Nothing+ | n > 1000 = Nothing -- ...+ | otherwise = Just (ReplicaCount n)++responseIsError :: Reply -> Bool+responseIsError resp = NHTS.statusCode (responseStatus resp) > 299++emptyBody = L.pack ""++dispatch :: Method -> String -> Maybe L.ByteString+ -> IO Reply+dispatch method url body = do+ initReq <- parseUrl url+ let reqBody = RequestBodyLBS $ fromMaybe emptyBody body+ let req = initReq { method = method+ , requestBody = reqBody+ , checkStatus = \_ _ _ -> Nothing}+ withManager $ httpLbs req++joinPath :: [String] -> String+joinPath = intercalate "/"++delete = flip (dispatch NHTM.methodDelete) $ Nothing+get = flip (dispatch NHTM.methodGet) $ Nothing+head = flip (dispatch NHTM.methodHead) $ Nothing+put = dispatch NHTM.methodPost+post = dispatch NHTM.methodPost++-- indexDocument s ix name doc = put (root </> s </> ix </> name </> doc) (Just encode doc)+-- http://hackage.haskell.org/package/http-client-lens-0.1.0/docs/Network-HTTP-Client-Lens.html+-- https://github.com/supki/libjenkins/blob/master/src/Jenkins/Rest/Internal.hs++getStatus :: Server -> IO (Maybe (Status Version))+getStatus (Server server) = do+ request <- parseUrl $ joinPath [server]+ response <- withManager $ httpLbs request+ return $ decode (responseBody response)++createIndex :: Server -> IndexSettings -> IndexName -> IO Reply+createIndex (Server server) indexSettings (IndexName indexName) =+ put url body+ where url = joinPath [server, indexName]+ body = Just $ encode indexSettings++deleteIndex :: Server -> IndexName -> IO Reply+deleteIndex (Server server) (IndexName indexName) =+ delete $ joinPath [server, indexName]++respIsTwoHunna :: Reply -> Bool+respIsTwoHunna resp = NHTS.statusCode (responseStatus resp) == 200++existentialQuery url = do+ reply <- head url+ return (reply, respIsTwoHunna reply)++indexExists :: Server -> IndexName -> IO Bool+indexExists (Server server) (IndexName indexName) = do+ (reply, exists) <- existentialQuery url+ return exists+ where url = joinPath [server, indexName]++refreshIndex :: Server -> IndexName -> IO Reply+refreshIndex (Server server) (IndexName indexName) =+ post url Nothing+ where url = joinPath [server, indexName, "_refresh"]++stringifyOCIndex oci = case oci of+ OpenIndex -> "_open"+ CloseIndex -> "_close"++openOrCloseIndexes :: OpenCloseIndex -> Server -> IndexName -> IO Reply+openOrCloseIndexes oci (Server server) (IndexName indexName) =+ post url Nothing+ where ociString = stringifyOCIndex oci+ url = joinPath [server, indexName, ociString]++openIndex :: Server -> IndexName -> IO Reply+openIndex = openOrCloseIndexes OpenIndex++closeIndex :: Server -> IndexName -> IO Reply+closeIndex = openOrCloseIndexes CloseIndex++createMapping :: ToJSON a => Server -> IndexName+ -> MappingName -> a -> IO Reply+createMapping (Server server) (IndexName indexName) (MappingName mappingName) mapping =+ put url body+ where url = joinPath [server, indexName, mappingName, "_mapping"]+ body = Just $ encode mapping++deleteMapping :: Server -> IndexName -> MappingName -> IO Reply+deleteMapping (Server server) (IndexName indexName) (MappingName mappingName) =+ delete $ joinPath [server, indexName, mappingName, "_mapping"]++indexDocument :: ToJSON doc => Server -> IndexName -> MappingName+ -> doc -> DocId -> IO Reply+indexDocument (Server server) (IndexName indexName)+ (MappingName mappingName) document (DocId docId) =+ put url body+ where url = joinPath [server, indexName, mappingName, docId]+ body = Just (encode document)++deleteDocument :: Server -> IndexName -> MappingName+ -> DocId -> IO Reply+deleteDocument (Server server) (IndexName indexName)+ (MappingName mappingName) (DocId docId) =+ delete $ joinPath [server, indexName, mappingName, docId]++bulk :: Server -> [BulkOperation] -> IO Reply+bulk (Server server) bulkOps = post url body where+ url = joinPath [server, "_bulk"]+ body = Just $ collapseStream bulkOps++collapseStream :: [BulkOperation] -> L.ByteString+collapseStream stream = collapsed where+ blobs = intersperse "\n" $ concat $ fmap getStreamChunk stream+ mashedTaters = mash (mempty :: Builder) blobs+ collapsed = toLazyByteString $ mappend mashedTaters "\n"++mash :: Builder -> [L.ByteString] -> Builder+mash builder xs = foldl' (\b x -> mappend b (lazyByteString x)) builder xs++mkMetadataValue :: Text -> String -> String -> String -> Value+mkMetadataValue operation indexName mappingName docId =+ object [operation .=+ object ["_index" .= indexName+ , "_type" .= mappingName+ , "_id" .= docId]]++getStreamChunk :: BulkOperation -> [L.ByteString]+getStreamChunk (BulkIndex (IndexName indexName)+ (MappingName mappingName)+ (DocId docId) value) = blob where+ metadata = mkMetadataValue "index" indexName mappingName docId+ blob = [encode metadata, encode value]++getStreamChunk (BulkCreate (IndexName indexName)+ (MappingName mappingName)+ (DocId docId) value) = blob where+ metadata = mkMetadataValue "create" indexName mappingName docId+ blob = [encode metadata, encode value]++getStreamChunk (BulkDelete (IndexName indexName)+ (MappingName mappingName)+ (DocId docId)) = blob where+ metadata = mkMetadataValue "delete" indexName mappingName docId+ blob = [encode metadata]++getStreamChunk (BulkUpdate (IndexName indexName)+ (MappingName mappingName)+ (DocId docId) value) = blob where+ metadata = mkMetadataValue "update" indexName mappingName docId+ doc = object ["doc" .= value]+ blob = [encode metadata, encode doc]++getDocument :: Server -> IndexName -> MappingName+ -> DocId -> IO Reply+getDocument (Server server) (IndexName indexName) (MappingName mappingName) (DocId docId) =+ get $ joinPath [server, indexName, mappingName, docId]++documentExists :: Server -> IndexName -> MappingName+ -> DocId -> IO Bool+documentExists (Server server) (IndexName indexName)+ (MappingName mappingName) (DocId docId) = do+ (reply, exists) <- existentialQuery url+ return exists where+ url = joinPath [server, indexName, mappingName, docId]++dispatchSearch :: String -> Search -> IO Reply+dispatchSearch url search = post url (Just (encode search))++searchAll :: Server -> Search -> IO Reply+searchAll (Server server) search = dispatchSearch url search where+ url = joinPath [server, "_search"]++searchByIndex :: Server -> IndexName -> Search -> IO Reply+searchByIndex (Server server) (IndexName indexName) search = dispatchSearch url search where+ url = joinPath [server, indexName, "_search"]++searchByType :: Server -> IndexName -> MappingName -> Search -> IO Reply+searchByType (Server server) (IndexName indexName)+ (MappingName mappingName) search = dispatchSearch url search where+ url = joinPath [server, indexName, mappingName, "_search"]++mkSearch :: Maybe Query -> Maybe Filter -> Search+mkSearch query filter = Search query filter Nothing False 0 10++pageSearch :: Int -> Int -> Search -> Search+pageSearch from size search = search { from = from, size = size }
+ Database/Bloodhound/Types.hs view
@@ -0,0 +1,698 @@+{-# LANGUAGE DeriveGeneric #-}++module Database.Bloodhound.Types+ ( defaultCache+ , defaultIndexSettings+ , halfRangeToKV+ , maybeJson+ , maybeJsonF+ , mkSort+ , rangeToKV+ , showText+ , unpackId+ , mkMatchQuery+ , mkMultiMatchQuery+ , mkBoolQuery+ , Version(..)+ , Status(..)+ , Existence(..)+ , NullValue(..)+ , IndexSettings(..)+ , Server(..)+ , Reply(..)+ , EsResult(..)+ , Query(..)+ , Search(..)+ , SearchResult(..)+ , SearchHits(..)+ , ShardResult(..)+ , Hit(..)+ , Filter(..)+ , Seminearring(..)+ , BoolMatch(..)+ , Term(..)+ , GeoPoint(..)+ , GeoBoundingBoxConstraint(..)+ , GeoBoundingBox(..)+ , GeoFilterType(..)+ , Distance(..)+ , DistanceUnit(..)+ , DistanceType(..)+ , DistanceRange(..)+ , OptimizeBbox(..)+ , LatLon(..)+ , Range(..)+ , HalfRange(..)+ , RangeExecution(..)+ , LessThan(..)+ , LessThanEq(..)+ , GreaterThan(..)+ , GreaterThanEq(..)+ , Regexp(..)+ , RegexpFlags(..)+ , FieldName(..)+ , IndexName(..)+ , MappingName(..)+ , DocId(..)+ , CacheName(..)+ , CacheKey(..)+ , BulkOperation(..)+ , ReplicaCount(..)+ , ShardCount(..)+ , Sort(..)+ , SortMode(..)+ , SortOrder(..)+ , SortSpec(..)+ , DefaultSort(..)+ , Missing(..)+ , OpenCloseIndex(..)+ , Method(..)+ , Boost(..)+ , MatchQuery(..)+ , MultiMatchQuery(..)+ , BoolQuery(..)+ , BoostingQuery(..)+ , CommonTermsQuery(..)+ , DisMaxQuery(..)+ , FilteredQuery(..)+ , FuzzyLikeThisQuery(..)+ , FuzzyLikeFieldQuery(..)+ , FuzzyQuery(..)+ , HasChildQuery(..)+ , HasParentQuery(..)+ , IndicesQuery(..)+ , MoreLikeThisQuery(..)+ , MoreLikeThisFieldQuery(..)+ , NestedQuery(..)+ , PrefixQuery(..)+ , QueryStringQuery(..)+ , SimpleQueryStringQuery(..)+ , RangeQuery(..)+ , RegexpQuery(..)+ , QueryString(..)+ , BooleanOperator(..)+ , ZeroTermsQuery(..)+ , CutoffFrequency(..)+ , Analyzer(..)+ , MaxExpansions(..)+ , Lenient(..)+ , MatchQueryType(..)+ , MultiMatchQueryType(..)+ , Tiebreaker(..)+ , MinimumMatch(..)+ , DisableCoord(..)+ , CommonMinimumMatch(..)+ , MinimumMatchHighLow(..)+ , PrefixLength(..)+ , Fuzziness(..)+ , IgnoreTermFrequency(..)+ , MaxQueryTerms(..)+ , ScoreType(..)+ , TypeName(..)+ , BoostTerms(..)+ , MaxWordLength(..)+ , MinWordLength(..)+ , MaxDocFrequency(..)+ , MinDocFrequency(..)+ , PhraseSlop(..)+ , StopWord(..)+ , QueryPath(..)+ , MinimumTermFrequency(..)+ , PercentMatch(..)+ ) where++import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as L+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock (UTCTime)+import Database.Bloodhound.Types.Class+import GHC.Generics (Generic)+import Network.HTTP.Conduit+import qualified Network.HTTP.Types.Method as NHTM++data Version = Version { number :: Text+ , build_hash :: Text+ , build_timestamp :: UTCTime+ , build_snapshot :: Bool+ , lucene_version :: Text } deriving (Show, Generic)++data Status a = Status { ok :: Bool+ , status :: Int+ , name :: Text+ , version :: a+ , tagline :: Text } deriving (Eq, Show)++data IndexSettings =+ IndexSettings { indexShards :: ShardCount+ , indexReplicas :: ReplicaCount } deriving (Eq, Show)++defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)++data Strategy = RoundRobinStrat | RandomStrat | HeadStrat deriving (Eq, Show)+++type Reply = Network.HTTP.Conduit.Response L.ByteString+type Method = NHTM.Method++data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Show)++data FieldType = GeoPointType+ | GeoShapeType+ | FloatType+ | IntegerType+ | LongType+ | ShortType+ | ByteType deriving (Eq, Show)++data FieldDefinition =+ FieldDefinition { fieldType :: FieldType } deriving (Eq, Show)++data MappingField =+ MappingField { mappingFieldName :: FieldName+ , fieldDefinition :: FieldDefinition } deriving (Eq, Show)++data Mapping = Mapping { typeName :: TypeName+ , fields :: [MappingField] } deriving (Eq, Show)++data BulkOperation =+ BulkIndex IndexName MappingName DocId Value+ | BulkCreate IndexName MappingName DocId Value+ | BulkDelete IndexName MappingName DocId+ | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show)++data EsResult a = EsResult { _index :: Text+ , _type :: Text+ , _id :: Text+ , _version :: Int+ , found :: Maybe Bool+ , _source :: a } deriving (Eq, Show)++type Sort = [SortSpec]++data SortSpec = DefaultSortSpec DefaultSort+ | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Show)++data DefaultSort =+ DefaultSort { sortFieldName :: FieldName+ , sortOrder :: SortOrder+ -- default False+ , ignoreUnmapped :: Bool+ , sortMode :: Maybe SortMode+ , missingSort :: Maybe Missing+ , nestedFilter :: Maybe Filter } deriving (Eq, Show)++data SortOrder = Ascending+ | Descending deriving (Eq, Show)++data Missing = LastMissing+ | FirstMissing+ | CustomMissing Text deriving (Eq, Show)++data SortMode = SortMin+ | SortMax+ | SortSum+ | SortAvg deriving (Eq, Show)++mkSort :: FieldName -> SortOrder -> DefaultSort+mkSort fieldName sortOrder = DefaultSort fieldName sortOrder False Nothing Nothing Nothing++type Cache = Bool -- caching on/off+defaultCache = False++type PrefixValue = Text++data BooleanOperator = And | Or deriving (Eq, Show)++newtype ShardCount = ShardCount Int deriving (Eq, Show, Generic)+newtype ReplicaCount = ReplicaCount Int deriving (Eq, Show, Generic)+newtype Server = Server String deriving (Eq, Show)+newtype IndexName = IndexName String deriving (Eq, Generic, Show)+newtype MappingName = MappingName String deriving (Eq, Generic, Show)+newtype DocId = DocId String deriving (Eq, Generic, Show)+newtype QueryString = QueryString Text deriving (Eq, Show)+newtype FieldName = FieldName Text deriving (Eq, Show)+newtype CacheName = CacheName Text deriving (Eq, Show)+newtype CacheKey = CacheKey Text deriving (Eq, Show)+newtype Existence = Existence Bool deriving (Eq, Show)+newtype NullValue = NullValue Bool deriving (Eq, Show)+newtype CutoffFrequency = CutoffFrequency Double deriving (Eq, Show, Generic)+newtype Analyzer = Analyzer Text deriving (Eq, Show, Generic)+newtype MaxExpansions = MaxExpansions Int deriving (Eq, Show, Generic)+newtype Lenient = Lenient Bool deriving (Eq, Show, Generic)+newtype Tiebreaker = Tiebreaker Double deriving (Eq, Show, Generic)+newtype Boost = Boost Double deriving (Eq, Show, Generic)+newtype BoostTerms = BoostTerms Double deriving (Eq, Show, Generic)+newtype MinimumMatch = MinimumMatch Int deriving (Eq, Show, Generic)+newtype MinimumMatchText = MinimumMatchText Text deriving (Eq, Show)+newtype DisableCoord = DisableCoord Bool deriving (Eq, Show, Generic)+newtype IgnoreTermFrequency = IgnoreTermFrequency Bool deriving (Eq, Show, Generic)+newtype MinimumTermFrequency = MinimumTermFrequency Int deriving (Eq, Show, Generic)+newtype MaxQueryTerms = MaxQueryTerms Int deriving (Eq, Show, Generic)+newtype Fuzziness = Fuzziness Double deriving (Eq, Show, Generic)+newtype PrefixLength = PrefixLength Int deriving (Eq, Show, Generic)+newtype TypeName = TypeName Text deriving (Eq, Show, Generic)+newtype PercentMatch = PercentMatch Double deriving (Eq, Show, Generic)+newtype StopWord = StopWord Text deriving (Eq, Show, Generic)+newtype QueryPath = QueryPath Text deriving (Eq, Show, Generic)+newtype AllowLeadingWildcard = AllowLeadingWildcard Bool deriving (Eq, Show)+newtype LowercaseExpanded = LowercaseExpanded Bool deriving (Eq, Show)+newtype EnablePositionIncrements = EnablePositionIncrements Bool deriving (Eq, Show)+newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Show)+newtype GeneratePhraseQueries = GeneratePhraseQueries Bool deriving (Eq, Show)+newtype Locale = Locale Text deriving (Eq, Show)+newtype MaxWordLength = MaxWordLength Int deriving (Eq, Show, Generic)+newtype MinWordLength = MinWordLength Int deriving (Eq, Show, Generic)+newtype PhraseSlop = PhraseSlop Int deriving (Eq, Show, Generic)+newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Show, Generic)+newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, Generic)++unpackId :: DocId -> String+unpackId (DocId docId) = docId++type TrackSortScores = Bool+type From = Int+type Size = Int++data Search = Search { queryBody :: Maybe Query+ , filterBody :: Maybe Filter+ , sortBody :: Maybe Sort+ -- default False+ , trackSortScores :: TrackSortScores+ , from :: From+ , size :: Size } deriving (Eq, Show)++data Query = TermQuery Term (Maybe Boost)+ | TermsQuery [Term] MinimumMatch+ | QueryMatchQuery MatchQuery+ | QueryMultiMatchQuery MultiMatchQuery+ | QueryBoolQuery BoolQuery+ | QueryBoostingQuery BoostingQuery+ | QueryCommonTermsQuery CommonTermsQuery+ | ConstantScoreFilter Filter Boost+ | ConstantScoreQuery Query Boost+ | QueryDisMaxQuery DisMaxQuery+ | QueryFilteredQuery FilteredQuery+ | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery+ | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery+ | QueryFuzzyQuery FuzzyQuery+ | QueryHasChildQuery HasChildQuery+ | QueryHasParentQuery HasParentQuery+ | IdsQuery MappingName [DocId]+ | QueryIndicesQuery IndicesQuery+ | MatchAllQuery (Maybe Boost)+ | QueryMoreLikeThisQuery MoreLikeThisQuery+ | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery+ | QueryNestedQuery NestedQuery+ | QueryPrefixQuery PrefixQuery+ | QueryQueryStringQuery QueryStringQuery+ | QuerySimpleQueryStringQuery SimpleQueryStringQuery+ | QueryRangeQuery RangeQuery+ | QueryRegexpQuery RegexpQuery+ deriving (Eq, Show)++data RegexpQuery =+ RegexpQuery { regexpQueryField :: FieldName+ , regexpQuery :: Regexp+ , regexpQueryFlags :: RegexpFlags+ , regexpQueryCacheName :: CacheName+ , regexpQueryCache :: Cache+ , regexpQueryCacheKey :: CacheKey } deriving (Eq, Show)++data RangeQuery =+ RangeQuery { rangeQueryField :: FieldName+ , rangeQueryRange :: Either HalfRange Range+ , rangeQueryBoost :: Boost } deriving (Eq, Show)++data SimpleQueryStringQuery =+ SimpleQueryStringQuery { simpleQueryStringQuery :: QueryString+ , simpleQueryStringField :: Maybe FieldOrFields+ , simpleQueryStringOperator :: Maybe BooleanOperator+ , simpleQueryStringAnalyzer :: Maybe Analyzer+ , simpleQueryStringFlags :: Maybe [SimpleQueryFlag]+ , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded+ , simpleQueryStringLocale :: Maybe Locale+ } deriving (Eq, Show)++data SimpleQueryFlag = SimpleQueryAll+ | SimpleQueryNone+ | SimpleQueryAnd+ | SimpleQueryOr+ | SimpleQueryPrefix+ | SimpleQueryPhrase+ | SimpleQueryPrecedence+ | SimpleQueryEscape+ | SimpleQueryWhitespace+ | SimpleQueryFuzzy+ | SimpleQueryNear+ | SimpleQuerySlop deriving (Eq, Show)++-- use_dis_max and tie_breaker when fields are plural?+data QueryStringQuery =+ QueryStringQuery { queryStringQuery :: QueryString+ , queryStringDefaultField :: Maybe FieldOrFields+ , queryStringOperator :: Maybe BooleanOperator+ , queryStringAnalyzer :: Maybe Analyzer+ , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard+ , queryStringLowercaseExpanded :: Maybe LowercaseExpanded+ , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements+ , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions+ , queryStringFuzziness :: Maybe Fuzziness+ , queryStringFuzzyPrefixLength :: Maybe PrefixLength+ , queryStringPhraseSlop :: Maybe PhraseSlop+ , queryStringBoost :: Maybe Boost+ , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard+ , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries+ , queryStringMinimumShouldMatch :: Maybe MinimumMatch+ , queryStringLenient :: Maybe Lenient+ , queryStringLocale :: Maybe Locale+ } deriving (Eq, Show)++data FieldOrFields = FofField FieldName+ | FofFields [FieldName] deriving (Eq, Show)++data PrefixQuery =+ PrefixQuery { prefixQueryField :: FieldName+ , prefixQueryPrefixValue :: Text+ , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show)++data NestedQuery =+ NestedQuery { nestedQueryPath :: QueryPath+ , nestedQueryScoreType :: ScoreType+ , nestedQuery :: Query } deriving (Eq, Show)++data MoreLikeThisFieldQuery =+ MoreLikeThisFieldQuery { moreLikeThisFieldText :: Text+ , moreLikeThisFieldFields :: FieldName+ -- default 0.3 (30%)+ , moreLikeThisFieldPercentMatch :: Maybe PercentMatch+ , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency+ , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms+ , moreLikeThisFieldStopWords :: Maybe [StopWord]+ , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency+ , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency+ , moreLikeThisFieldMinWordLength :: Maybe MinWordLength+ , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength+ , moreLikeThisFieldBoostTerms :: Maybe BoostTerms+ , moreLikeThisFieldBoost :: Maybe Boost+ , moreLikeThisFieldAnalyzer :: Maybe Analyzer+ } deriving (Eq, Show)++data MoreLikeThisQuery =+ MoreLikeThisQuery { moreLikeThisText :: Text+ , moreLikeThisFields :: Maybe [FieldName]+ -- default 0.3 (30%)+ , moreLikeThisPercentMatch :: Maybe PercentMatch+ , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency+ , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms+ , moreLikeThisStopWords :: Maybe [StopWord]+ , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency+ , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency+ , moreLikeThisMinWordLength :: Maybe MinWordLength+ , moreLikeThisMaxWordLength :: Maybe MaxWordLength+ , moreLikeThisBoostTerms :: Maybe BoostTerms+ , moreLikeThisBoost :: Maybe Boost+ , moreLikeThisAnalyzer :: Maybe Analyzer+ } deriving (Eq, Show)+++data IndicesQuery =+ IndicesQuery { indicesQueryIndices :: [IndexName]+ , indicesQuery :: Query+ -- default "all"+ , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show)++data HasParentQuery =+ HasParentQuery { hasParentQueryType :: TypeName+ , hasParentQuery :: Query+ , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)++data HasChildQuery =+ HasChildQuery { hasChildQueryType :: TypeName+ , hasChildQuery :: Query+ , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)++data ScoreType = ScoreTypeMax+ | ScoreTypeSum+ | ScoreTypeAvg+ | ScoreTypeNone deriving (Eq, Show)++data FuzzyQuery = FuzzyQuery { fuzzyQueryField :: FieldName+ , fuzzyQueryValue :: Text+ , fuzzyQueryPrefixLength :: PrefixLength+ , fuzzyQueryMaxExpansions :: MaxExpansions+ , fuzzyQueryFuzziness :: Fuzziness+ , fuzzyQueryBoost :: Maybe Boost+ } deriving (Eq, Show)++data FuzzyLikeFieldQuery =+ FuzzyLikeFieldQuery { fuzzyLikeField :: FieldName+ -- anaphora is good for the soul.+ , fuzzyLikeFieldText :: Text+ , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms+ , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency+ , fuzzyLikeFieldFuzziness :: Fuzziness+ , fuzzyLikeFieldPrefixLength :: PrefixLength+ , fuzzyLikeFieldBoost :: Boost+ , fuzzyLikeFieldAnalyzer :: Maybe Analyzer+ } deriving (Eq, Show)++data FuzzyLikeThisQuery =+ FuzzyLikeThisQuery { fuzzyLikeFields :: [FieldName]+ , fuzzyLikeText :: Text+ , fuzzyLikeMaxQueryTerms :: MaxQueryTerms+ , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency+ , fuzzyLikeFuzziness :: Fuzziness+ , fuzzyLikePrefixLength :: PrefixLength+ , fuzzyLikeBoost :: Boost+ , fuzzyLikeAnalyzer :: Maybe Analyzer+ } deriving (Eq, Show)++data FilteredQuery =+ FilteredQuery { filteredQuery :: Query+ , filteredFilter :: Filter } deriving (Eq, Show)++data DisMaxQuery = DisMaxQuery { disMaxQueries :: [Query]+ -- default 0.0+ , disMaxTiebreaker :: Tiebreaker+ , disMaxBoost :: Maybe Boost+ } deriving (Eq, Show)+data MatchQuery =+ MatchQuery { matchQueryField :: FieldName+ , matchQueryQueryString :: QueryString+ , matchQueryOperator :: BooleanOperator+ , matchQueryZeroTerms :: ZeroTermsQuery+ , matchQueryCutoffFrequency :: Maybe CutoffFrequency+ , matchQueryMatchType :: Maybe MatchQueryType+ , matchQueryAnalyzer :: Maybe Analyzer+ , matchQueryMaxExpansions :: Maybe MaxExpansions+ , matchQueryLenient :: Maybe Lenient } deriving (Eq, Show)++mkMatchQuery :: FieldName -> QueryString -> MatchQuery+mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing++data MatchQueryType = MatchPhrase+ | MatchPhrasePrefix deriving (Eq, Show)++data MultiMatchQuery =+ MultiMatchQuery { multiMatchQueryFields :: [FieldName]+ , multiMatchQueryString :: QueryString+ , multiMatchQueryOperator :: BooleanOperator+ , multiMatchQueryZeroTerms :: ZeroTermsQuery+ , multiMatchQueryTiebreaker :: Maybe Tiebreaker+ , multiMatchQueryType :: Maybe MultiMatchQueryType+ , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency+ , multiMatchQueryAnalyzer :: Maybe Analyzer+ , multiMatchQueryMaxExpansions :: Maybe MaxExpansions+ , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Show)++mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery+mkMultiMatchQuery fields query =+ MultiMatchQuery fields query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing++data MultiMatchQueryType = MultiMatchBestFields+ | MultiMatchMostFields+ | MultiMatchCrossFields+ | MultiMatchPhrase+ | MultiMatchPhrasePrefix deriving (Eq, Show)++data BoolQuery = BoolQuery { boolQueryMustMatch :: Maybe Query+ , boolQueryMustNotMatch :: Maybe Query+ , boolQueryShouldMatch :: Maybe [Query]+ , boolQueryMinimumShouldMatch :: Maybe MinimumMatch+ , boolQueryBoost :: Maybe Boost+ , boolQueryDisableCoord :: Maybe DisableCoord+ } deriving (Eq, Show)++mkBoolQuery :: Maybe Query -> Maybe Query -> Maybe [Query] -> BoolQuery+mkBoolQuery must mustNot should = BoolQuery must mustNot should Nothing Nothing Nothing++data BoostingQuery = BoostingQuery { positiveQuery :: Query+ , negativeQuery :: Query+ , negativeBoost :: Boost } deriving (Eq, Show)++data CommonTermsQuery =+ CommonTermsQuery { commonField :: FieldName+ , commonQuery :: QueryString+ , commonCutoffFrequency :: CutoffFrequency+ , commonLowFreqOperator :: BooleanOperator+ , commonHighFreqOperator :: BooleanOperator+ , commonMinimumShouldMatch :: Maybe CommonMinimumMatch+ , commonBoost :: Maybe Boost+ , commonAnalyzer :: Maybe Analyzer+ , commonDisableCoord :: Maybe DisableCoord+ } deriving (Eq, Show)++data CommonMinimumMatch = CommonMinimumMatchHighLow MinimumMatchHighLow+ | CommonMinimumMatch MinimumMatch deriving (Eq, Show)++data MinimumMatchHighLow =+ MinimumMatchHighLow { lowFreq :: MinimumMatch+ , highFreq :: MinimumMatch } deriving (Eq, Show)++data Filter = AndFilter [Filter] Cache+ | OrFilter [Filter] Cache+ | NotFilter Filter Cache+ | IdentityFilter+ | BoolFilter BoolMatch+ | ExistsFilter FieldName -- always cached+ | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType+ | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache+ | GeoDistanceRangeFilter GeoPoint DistanceRange+ | GeoPolygonFilter FieldName [LatLon]+ | IdsFilter MappingName [DocId]+ | LimitFilter Int+ | MissingFilter FieldName Existence NullValue+ | PrefixFilter FieldName PrefixValue Cache+ | RangeFilter FieldName (Either HalfRange Range) RangeExecution Cache+ | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey+ deriving (Eq, Show)++data ZeroTermsQuery = ZeroTermsNone | ZeroTermsAll deriving (Eq, Show)++-- lt, lte | gt, gte+newtype LessThan = LessThan Double deriving (Eq, Show)+newtype LessThanEq = LessThanEq Double deriving (Eq, Show)+newtype GreaterThan = GreaterThan Double deriving (Eq, Show)+newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Show)++data HalfRange = HalfRangeLt LessThan+ | HalfRangeLte LessThanEq+ | HalfRangeGt GreaterThan+ | HalfRangeGte GreaterThanEq deriving (Eq, Show)++data Range = RangeLtGt LessThan GreaterThan+ | RangeLtGte LessThan GreaterThanEq+ | RangeLteGt LessThanEq GreaterThan+ | RangeLteGte LessThanEq GreaterThanEq deriving (Eq, Show)++data RangeExecution = RangeExecutionIndex+ | RangeExecutionFielddata deriving (Eq, Show)++newtype Regexp = Regexp Text deriving (Eq, Show)+newtype RegexpFlags = RegexpFlags Text deriving (Eq, Show)++halfRangeToKV :: HalfRange -> (Text, Double)+halfRangeToKV (HalfRangeLt (LessThan n)) = ("lt", n)+halfRangeToKV (HalfRangeLte (LessThanEq n)) = ("lte", n)+halfRangeToKV (HalfRangeGt (GreaterThan n)) = ("gt", n)+halfRangeToKV (HalfRangeGte (GreaterThanEq n)) = ("gte", n)++rangeToKV :: Range -> (Text, Double, Text, Double)+rangeToKV (RangeLtGt (LessThan m) (GreaterThan n)) = ("lt", m, "gt", n)+rangeToKV (RangeLtGte (LessThan m) (GreaterThanEq n)) = ("lt", m, "gte", n)+rangeToKV (RangeLteGt (LessThanEq m) (GreaterThan n)) = ("lte", m, "gt", n)+rangeToKV (RangeLteGte (LessThanEq m) (GreaterThanEq n)) = ("lte", m, "gte", n)++-- phew. Coulda used Agda style case breaking there but, you know, whatever. :)++data Term = Term { termField :: Text+ , termValue :: Text } deriving (Eq, Show)++data BoolMatch = MustMatch Term Cache+ | MustNotMatch Term Cache+ | ShouldMatch [Term] Cache deriving (Eq, Show)++-- "memory" or "indexed"+data GeoFilterType = GeoFilterMemory+ | GeoFilterIndexed deriving (Eq, Show)+++data LatLon = LatLon { lat :: Double+ , lon :: Double } deriving (Eq, Show)++data GeoBoundingBox =+ GeoBoundingBox { topLeft :: LatLon+ , bottomRight :: LatLon } deriving (Eq, Show)++data GeoBoundingBoxConstraint =+ GeoBoundingBoxConstraint { geoBBField :: FieldName+ , constraintBox :: GeoBoundingBox+ , bbConstraintcache :: Cache+ } deriving (Eq, Show)++data GeoPoint =+ GeoPoint { geoField :: FieldName+ , latLon :: LatLon} deriving (Eq, Show)++data DistanceUnit = Miles+ | Yards+ | Feet+ | Inches+ | Kilometers+ | Meters+ | Centimeters+ | Millimeters+ | NauticalMiles deriving (Eq, Show)++data DistanceType = Arc+ | SloppyArc -- doesn't exist <1.0+ | Plane deriving (Eq, Show)++data OptimizeBbox = OptimizeGeoFilterType GeoFilterType+ | NoOptimizeBbox deriving (Eq, Show)++data Distance =+ Distance { coefficient :: Double+ , unit :: DistanceUnit } deriving (Eq, Show)++data DistanceRange =+ DistanceRange { distanceFrom :: Distance+ , distanceTo :: Distance } deriving (Eq, Show)++data FromJSON a => SearchResult a =+ SearchResult { took :: Int+ , timedOut :: Bool+ , shards :: ShardResult+ , searchHits :: SearchHits a } deriving (Eq, Show)++type Score = Double++data FromJSON a => SearchHits a =+ SearchHits { hitsTotal :: Int+ , maxScore :: Score+ , hits :: [Hit a] } deriving (Eq, Show)++data FromJSON a => Hit a =+ Hit { hitIndex :: IndexName+ , hitType :: MappingName+ , hitDocId :: DocId+ , hitScore :: Score+ , hitSource :: a } deriving (Eq, Show)++data ShardResult =+ ShardResult { shardTotal :: Int+ , shardsSuccessful :: Int+ , shardsFailed :: Int } deriving (Eq, Show, Generic)++maybeJson :: ToJSON a => Text -> Maybe a -> [(Text, Value)]+maybeJson field (Just value) = [field .= toJSON value]+maybeJson _ _ = []++-- maybeJsonF :: (ToJSON (f Value), ToJSON a, Functor f) =>+-- Text -> Maybe (f a) -> [(Text, Value)]+maybeJsonF field (Just value) = [field .= fmap toJSON value]+maybeJsonF _ _ = []++showText :: Show a => a -> Text+showText = T.pack . show
+ Database/Bloodhound/Types/Class.hs view
@@ -0,0 +1,15 @@+module Database.Bloodhound.Types.Class+ ( Seminearring(..) )+ where++import Data.Aeson+import Data.Monoid++class Monoid a => Seminearring a where+ -- 0, +, *+ (<||>) :: a -> a -> a+ (<&&>) :: a -> a -> a+ (<&&>) = mappend++infixr 5 <||>+infixr 5 <&&>
+ Database/Bloodhound/Types/Instances.hs view
@@ -0,0 +1,657 @@+{-# LANGUAGE DeriveGeneric #-}++module Database.Bloodhound.Types.Instances+ ( Monoid(..)+ , Seminearring(..)+ , ToJSON(..)+ ) where++import Control.Applicative+import Data.Aeson+import Data.Maybe (catMaybes)+import Data.Monoid+import qualified Data.Text as T+import Database.Bloodhound.Types+import Database.Bloodhound.Types.Class+import Data.Scientific++instance Monoid Filter where+ mempty = IdentityFilter+ mappend a b = AndFilter [a, b] defaultCache++instance Seminearring Filter where+ a <||> b = OrFilter [a, b] defaultCache++instance ToJSON Filter where+ toJSON (AndFilter filters cache) =+ object ["and" .= fmap toJSON filters+ , "_cache" .= cache]++ toJSON (OrFilter filters cache) =+ object ["or" .= fmap toJSON filters+ , "_cache" .= cache]++ toJSON (NotFilter filter cache) =+ object ["not" .=+ object ["filter" .= toJSON filter+ , "_cache" .= cache]]++ toJSON (IdentityFilter) =+ object ["match_all" .= object []]++ toJSON (ExistsFilter (FieldName fieldName)) =+ object ["exists" .= object+ ["field" .= fieldName]]++ toJSON (BoolFilter boolMatch) =+ object ["bool" .= toJSON boolMatch]++ toJSON (GeoBoundingBoxFilter bbConstraint filterType) =+ object ["geo_bounding_box" .= toJSON bbConstraint+ , "type" .= toJSON filterType]++ toJSON (GeoDistanceFilter (GeoPoint (FieldName geoField) latLon)+ distance distanceType optimizeBbox cache) =+ object ["geo_distance" .=+ object ["distance" .= toJSON distance+ , "distance_type" .= toJSON distanceType+ , "optimize_bbox" .= optimizeBbox+ , geoField .= toJSON latLon+ , "_cache" .= cache]] ++ toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName geoField) latLon)+ (DistanceRange distanceFrom distanceTo)) =+ object ["geo_distance_range" .=+ object ["from" .= toJSON distanceFrom+ , "to" .= toJSON distanceTo+ , geoField .= toJSON latLon]]++ toJSON (GeoPolygonFilter (FieldName geoField) latLons) =+ object ["geo_polygon" .=+ object [geoField .=+ object ["points" .= fmap toJSON latLons]]]++ toJSON (IdsFilter (MappingName mappingName) values) =+ object ["ids" .=+ object ["type" .= mappingName+ , "values" .= fmap (T.pack . unpackId) values]]++ toJSON (LimitFilter limit) =+ object ["limit" .= object ["value" .= limit]]++ toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =+ object ["missing" .=+ object ["field" .= fieldName+ , "existence" .= existence+ , "null_value" .= nullValue]]++ toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) =+ object ["prefix" .=+ object [fieldName .= fieldValue+ , "_cache" .= cache]]++ toJSON (RangeFilter (FieldName fieldName) (Left halfRange) rangeExecution cache) =+ object ["range" .=+ object [fieldName .=+ object [key .= val]+ , "execution" .= toJSON rangeExecution+ , "_cache" .= cache]]+ where+ (key, val) = halfRangeToKV halfRange++ toJSON (RangeFilter (FieldName fieldName) (Right range) rangeExecution cache) =+ object ["range" .=+ object [fieldName .=+ object [lessKey .= lessVal+ , greaterKey .= greaterVal]+ , "execution" .= toJSON rangeExecution+ , "_cache" .= cache]]+ where+ (lessKey, lessVal, greaterKey, greaterVal) = rangeToKV range++ toJSON (RegexpFilter (FieldName fieldName)+ (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =+ object ["regexp" .=+ object [fieldName .=+ object ["value" .= regexText+ , "flags" .= toJSON flags]+ , "_name" .= cacheName+ , "_cache" .= cache+ , "_cache_key" .= cacheKey]]++instance ToJSON GeoPoint where+ toJSON (GeoPoint (FieldName geoField) latLon) =+ object [ geoField .= toJSON latLon ]+++instance ToJSON Query where+ toJSON (TermQuery (Term termField termValue) boost) =+ object [ "term" .=+ object [termField .= object merged]]+ where+ base = [ "value" .= termValue ]+ boosted = maybe [] (return . ("boost" .=)) boost+ merged = mappend base boosted++ toJSON (QueryMatchQuery matchQuery) =+ object [ "match" .= toJSON matchQuery ]++ toJSON (QueryMultiMatchQuery multiMatchQuery) =+ object [ "multi_match" .= toJSON multiMatchQuery ]++ toJSON (QueryBoolQuery boolQuery) =+ object [ "bool" .= toJSON boolQuery ]++ toJSON (QueryBoostingQuery boostingQuery) =+ object [ "boosting" .= toJSON boostingQuery ]++ toJSON (QueryCommonTermsQuery commonTermsQuery) =+ object [ "common" .= toJSON commonTermsQuery ]++ toJSON (ConstantScoreFilter filter boost) =+ object [ "constant_score" .= toJSON filter+ , "boost" .= toJSON boost]++ toJSON (ConstantScoreQuery query boost) =+ object [ "constant_score" .= toJSON query+ , "boost" .= toJSON boost]++ toJSON (QueryDisMaxQuery disMaxQuery) =+ object [ "dis_max" .= toJSON disMaxQuery ]++ toJSON (QueryFilteredQuery filteredQuery) =+ object [ "filtered" .= toJSON filteredQuery ]++ toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =+ object [ "fuzzy_like_this" .= toJSON fuzzyQuery ]++ toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =+ object [ "fuzzy_like_this_field" .= toJSON fuzzyFieldQuery ]++ toJSON (QueryFuzzyQuery fuzzyQuery) =+ object [ "fuzzy" .= toJSON fuzzyQuery ]++ toJSON (QueryHasChildQuery childQuery) =+ object [ "has_child" .= toJSON childQuery ]++ toJSON (QueryHasParentQuery parentQuery) =+ object [ "has_parent" .= toJSON parentQuery ]++ toJSON (QueryIndicesQuery indicesQuery) =+ object [ "indices" .= toJSON indicesQuery ]++ toJSON (MatchAllQuery boost) =+ object [ "match_all" .= object maybeAdd ]+ where maybeAdd = catMaybes [ mField "boost" boost ]++ toJSON (QueryMoreLikeThisQuery query) =+ object [ "more_like_this" .= toJSON query ]++ toJSON (QueryMoreLikeThisFieldQuery query) =+ object [ "more_like_this_field" .= toJSON query ]++ toJSON (QueryNestedQuery query) =+ object [ "nested" .= toJSON query ]++ toJSON (QueryPrefixQuery query) =+ object [ "prefix" .= toJSON query ]+++mField :: (ToJSON a, Functor f) => T.Text -> f a -> f (T.Text, Value)+mField field = fmap ((field .=) . toJSON)+++instance ToJSON PrefixQuery where+ toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =+ object [ fieldName .= object conjoined ]+ where base = [ "value" .= toJSON queryValue ]+ maybeAdd = catMaybes [ mField "boost" boost ]+ conjoined = base ++ maybeAdd+++instance ToJSON NestedQuery where+ toJSON (NestedQuery path scoreType query) =+ object [ "path" .= toJSON path+ , "score_mode" .= toJSON scoreType+ , "query" .= toJSON query ]+++instance ToJSON MoreLikeThisFieldQuery where+ toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)+ percent mtf mqt stopwords mindf maxdf+ minwl maxwl boostTerms boost analyzer) =+ object [ fieldName .= object conjoined ]+ where base = [ "like_text" .= toJSON text ]+ maybeAdd = catMaybes [ mField "percent_terms_to_match" percent+ , mField "min_term_freq" mtf+ , mField "max_query_terms" mqt+ , mField "stop_words" stopwords+ , mField "min_doc_freq" mindf+ , mField "max_doc_freq" maxdf+ , mField "min_word_length" minwl+ , mField "max_word_length" maxwl+ , mField "boost_terms" boostTerms+ , mField "boost" boost+ , mField "analyzer" analyzer ]+ conjoined = base ++ maybeAdd+++instance ToJSON MoreLikeThisQuery where+ toJSON (MoreLikeThisQuery text fields percent+ mtf mqt stopwords mindf maxdf+ minwl maxwl boostTerms boost analyzer) =+ object conjoined+ where base = [ "like_text" .= toJSON text ]+ maybeAdd = catMaybes [ mField "fields" fields+ , mField "percent_terms_to_match" percent+ , mField "min_term_freq" mtf+ , mField "max_query_terms" mqt+ , mField "stop_words" stopwords+ , mField "min_doc_freq" mindf+ , mField "max_doc_freq" maxdf+ , mField "min_word_length" minwl+ , mField "max_word_length" maxwl+ , mField "boost_terms" boostTerms+ , mField "boost" boost+ , mField "analyzer" analyzer ]+ conjoined = base ++ maybeAdd+++instance ToJSON IndicesQuery where+ toJSON (IndicesQuery indices query noMatch) =+ object $ [ "indices" .= toJSON indices+ , "query" .= toJSON query ] ++ maybeAdd+ where maybeAdd = catMaybes [ mField "no_match_query" noMatch ]+++instance ToJSON HasParentQuery where+ toJSON (HasParentQuery queryType query scoreType) =+ object $ [ "parent_type" .= toJSON queryType+ , "query" .= toJSON query ] ++ maybeAdd+ where maybeAdd = catMaybes [ mField "score_type" scoreType ]+++instance ToJSON HasChildQuery where+ toJSON (HasChildQuery queryType query scoreType) =+ object $ [ "query" .= toJSON query+ , "type" .= toJSON queryType ] ++ maybeAdd+ where maybeAdd = catMaybes [ mField "score_type" scoreType ]+++instance ToJSON FuzzyQuery where+ toJSON (FuzzyQuery (FieldName fieldName) queryText+ prefixLength maxEx fuzziness boost) =+ object [ fieldName .= object conjoined ]+ where base = [ "value" .= toJSON queryText+ , "fuzziness" .= toJSON fuzziness+ , "prefix_length" .= toJSON prefixLength+ , "max_expansions" .= toJSON maxEx ]+ maybeAdd = catMaybes [ mField "boost" boost ]+ conjoined = base ++ maybeAdd+++instance ToJSON FuzzyLikeFieldQuery where+ toJSON (FuzzyLikeFieldQuery (FieldName fieldName)+ fieldText maxTerms ignoreFreq fuzziness prefixLength+ boost analyzer) =+ object $ [ fieldName .=+ object [ "like_text" .= toJSON fieldText+ , "max_query_terms" .= toJSON maxTerms+ , "ignore_tf" .= toJSON ignoreFreq+ , "fuzziness" .= toJSON fuzziness+ , "prefix_length" .= toJSON prefixLength+ , "boost" .= toJSON boost ]] ++ maybeAdd+ where maybeAdd = catMaybes [ mField "analyzer" analyzer ]+++instance ToJSON FuzzyLikeThisQuery where+ toJSON (FuzzyLikeThisQuery fields text maxTerms+ ignoreFreq fuzziness prefixLength boost analyzer) =+ object conjoined+ where base = [ "fields" .= toJSON fields+ , "like_text" .= toJSON text+ , "max_query_terms" .= toJSON maxTerms+ , "ignore_tf" .= toJSON ignoreFreq+ , "fuzziness" .= toJSON fuzziness+ , "prefix_length" .= toJSON prefixLength+ , "boost" .= toJSON boost ]+ maybeAdd = catMaybes [ mField "analyzer" analyzer ]+ conjoined = base ++ maybeAdd+++instance ToJSON FilteredQuery where+ toJSON (FilteredQuery query filter) =+ object [ "query" .= toJSON query+ , "filter" .= toJSON filter ]+++instance ToJSON DisMaxQuery where+ toJSON (DisMaxQuery queries tiebreaker boost) =+ object conjoined+ where maybeAdd = catMaybes [mField "boost" boost]+ base = [ "queries" .= toJSON queries+ , "tie_breaker" .= toJSON tiebreaker ]+ conjoined = base ++ maybeAdd+++instance ToJSON CommonTermsQuery where+ toJSON (CommonTermsQuery (FieldName fieldName)+ (QueryString query) cf lfo hfo msm+ boost analyzer disableCoord) =+ object [fieldName .= object conjoined]+ where base = [ "query" .= query+ , "cutoff_frequency" .= toJSON cf+ , "low_freq_operator" .= toJSON lfo+ , "high_freq_operator" .= toJSON hfo ]+ extension = catMaybes+ [ mField "minimum_should_match" msm+ , mField "boost" boost+ , mField "analyzer" analyzer+ , mField "disable_coord" disableCoord ]+ conjoined = base ++ extension+++instance ToJSON CommonMinimumMatch where+ toJSON (CommonMinimumMatch mm) = toJSON mm+ toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =+ object [ "low_freq" .= toJSON lowF+ , "high_freq" .= toJSON highF ]++instance ToJSON BoostingQuery where+ toJSON (BoostingQuery positiveQuery negativeQuery negativeBoost) =+ object [ "positive" .= toJSON positiveQuery+ , "negative" .= toJSON negativeQuery+ , "negative_boost" .= toJSON negativeBoost ]+++instance ToJSON BoolQuery where+ toJSON (BoolQuery mustM notM shouldM min boost disableCoord) =+ object filtered+ where filtered = catMaybes+ [ mField "must" mustM+ , mField "must_not" notM+ , mField "should" shouldM+ , mField "minimum_should_match" min+ , mField "boost" boost+ , mField "disable_coord" disableCoord ]+++instance ToJSON MatchQuery where+ toJSON (MatchQuery (FieldName fieldName)+ (QueryString queryString) booleanOperator+ zeroTermsQuery cutoffFrequency matchQueryType+ analyzer maxExpansions lenient) =+ object [ fieldName .= object conjoined ]+ where conjoined = [ "query" .= queryString+ , "operator" .= toJSON booleanOperator+ , "zero_terms_query" .= toJSON zeroTermsQuery]+ ++ maybeAdd+ maybeAdd = catMaybes [ mField "cutoff_frequency" cutoffFrequency+ , mField "type" matchQueryType+ , mField "analyzer" analyzer+ , mField "max_expansions" maxExpansions+ , mField "lenient" lenient ]+++instance ToJSON MultiMatchQuery where+ toJSON (MultiMatchQuery fields (QueryString query) boolOp+ ztQ tb mmqt cf analyzer maxEx lenient) =+ object ["multi_match" .= object conjoined]+ where baseQuery = [ "fields" .= fmap toJSON fields+ , "query" .= query+ , "operator" .= toJSON boolOp+ , "zero_terms_query" .= toJSON ztQ ]+ maybeAdd = catMaybes [ mField "tiebreaker" tb+ , mField "type" mmqt+ , mField "cutoff_frequency" cf+ , mField "analyzer" analyzer+ , mField "max_expansions" maxEx+ , mField "lenient" lenient ]+ conjoined = baseQuery ++ maybeAdd+++instance ToJSON MultiMatchQueryType where+ toJSON MultiMatchBestFields = "best_fields"+ toJSON MultiMatchMostFields = "most_fields"+ toJSON MultiMatchCrossFields = "cross_fields"+ toJSON MultiMatchPhrase = "phrase"+ toJSON MultiMatchPhrasePrefix = "phrase_prefix"++instance ToJSON BooleanOperator where+ toJSON And = String "and"+ toJSON Or = String "or"++instance ToJSON ZeroTermsQuery where+ toJSON ZeroTermsNone = String "none"+ toJSON ZeroTermsAll = String "all"++instance ToJSON MatchQueryType where+ toJSON MatchPhrase = "phrase"+ toJSON MatchPhrasePrefix = "phrase_prefix"++instance ToJSON FieldName where+ toJSON (FieldName fieldName) = String fieldName++instance ToJSON ReplicaCount+instance ToJSON ShardCount+instance ToJSON CutoffFrequency+instance ToJSON Analyzer+instance ToJSON MaxExpansions+instance ToJSON Lenient+instance ToJSON Boost+instance ToJSON Version+instance ToJSON Tiebreaker+instance ToJSON MinimumMatch+instance ToJSON DisableCoord+instance ToJSON PrefixLength+instance ToJSON Fuzziness+instance ToJSON IgnoreTermFrequency+instance ToJSON MaxQueryTerms+instance ToJSON TypeName+instance ToJSON IndexName+instance ToJSON BoostTerms+instance ToJSON MaxWordLength+instance ToJSON MinWordLength+instance ToJSON MaxDocFrequency+instance ToJSON MinDocFrequency+instance ToJSON PhraseSlop+instance ToJSON StopWord+instance ToJSON QueryPath+instance ToJSON MinimumTermFrequency+instance ToJSON PercentMatch+instance FromJSON Version+instance FromJSON IndexName+instance FromJSON MappingName+instance FromJSON DocId+++instance (FromJSON a) => FromJSON (Status a) where+ parseJSON (Object v) = Status <$>+ v .: "ok" <*>+ v .: "status" <*>+ v .: "name" <*>+ v .: "version" <*>+ v .: "tagline"+ parseJSON _ = empty+++instance ToJSON IndexSettings where+ toJSON (IndexSettings s r) = object ["settings" .= object ["shards" .= s, "replicas" .= r]]+++instance (FromJSON a) => FromJSON (EsResult a) where+ parseJSON (Object v) = EsResult <$>+ v .: "_index" <*>+ v .: "_type" <*>+ v .: "_id" <*>+ v .: "_version" <*>+ v .:? "found" <*>+ v .: "_source"+ parseJSON _ = empty+++instance ToJSON Search where+ toJSON (Search query filter sort trackSortScores from size) =+ object merged where+ lQuery = maybeJson "query" query+ lFilter = maybeJson "filter" filter+ lSort = maybeJsonF "sort" sort+ merged = mconcat [[ "from" .= from+ , "size" .= size+ , "track_scores" .= trackSortScores]+ , lQuery+ , lFilter+ , lSort]+++instance ToJSON SortSpec where+ toJSON (DefaultSortSpec+ (DefaultSort (FieldName sortFieldName) sortOrder ignoreUnmapped+ sortMode missingSort nestedFilter)) =+ object [sortFieldName .= object merged] where+ base = ["order" .= toJSON sortOrder+ , "ignore_unmapped" .= ignoreUnmapped]+ lSortMode = maybeJson "mode" sortMode+ lMissingSort = maybeJson "missing" missingSort+ lNestedFilter = maybeJson "nested_filter" nestedFilter+ merged = mconcat [base, lSortMode, lMissingSort, lNestedFilter]++ toJSON (GeoDistanceSortSpec sortOrder (GeoPoint (FieldName field) latLon) units) =+ object [ "unit" .= toJSON units+ , field .= toJSON latLon+ , "order" .= toJSON sortOrder ]+++instance ToJSON SortOrder where+ toJSON Ascending = String "asc" + toJSON Descending = String "desc"+++instance ToJSON SortMode where+ toJSON SortMin = String "min"+ toJSON SortMax = String "max"+ toJSON SortSum = String "sum"+ toJSON SortAvg = String "avg"+++instance ToJSON Missing where+ toJSON LastMissing = String "_last"+ toJSON FirstMissing = String "_first"+ toJSON (CustomMissing txt) = String txt+++instance ToJSON ScoreType where+ toJSON ScoreTypeMax = "max"+ toJSON ScoreTypeAvg = "avg"+ toJSON ScoreTypeSum = "sum"+ toJSON ScoreTypeNone = "none"+++instance ToJSON Distance where+ toJSON (Distance coefficient unit) =+ String boltedTogether where+ coefText = showText coefficient+ (String unitText) = (toJSON unit)+ boltedTogether = mappend coefText unitText+++instance ToJSON DistanceUnit where+ toJSON Miles = String "mi"+ toJSON Yards = String "yd"+ toJSON Feet = String "ft"+ toJSON Inches = String "in"+ toJSON Kilometers = String "km"+ toJSON Meters = String "m"+ toJSON Centimeters = String "cm"+ toJSON Millimeters = String "mm"+ toJSON NauticalMiles = String "nmi"+++instance ToJSON DistanceType where+ toJSON Arc = String "arc"+ toJSON SloppyArc = String "sloppy_arc"+ toJSON Plane = String "plane"+++instance ToJSON OptimizeBbox where+ toJSON NoOptimizeBbox = String "none"+ toJSON (OptimizeGeoFilterType gft) = toJSON gft+++instance ToJSON GeoBoundingBoxConstraint where+ toJSON (GeoBoundingBoxConstraint (FieldName geoBBField) constraintBox cache) =+ object [geoBBField .= toJSON constraintBox+ , "_cache" .= cache]+++instance ToJSON GeoFilterType where+ toJSON GeoFilterMemory = String "memory"+ toJSON GeoFilterIndexed = String "indexed"+++instance ToJSON GeoBoundingBox where+ toJSON (GeoBoundingBox topLeft bottomRight) =+ object ["top_left" .= toJSON topLeft+ , "bottom_right" .= toJSON bottomRight]+++instance ToJSON LatLon where+ toJSON (LatLon lat lon) =+ object ["lat" .= lat+ , "lon" .= lon]+++-- index for smaller ranges, fielddata for longer ranges+instance ToJSON RangeExecution where+ toJSON RangeExecutionIndex = "index"+ toJSON RangeExecutionFielddata = "fielddata"+++instance ToJSON RegexpFlags where+ toJSON (RegexpFlags txt) = String txt+++instance ToJSON Term where+ toJSON (Term field value) = object ["term" .= object+ [field .= value]]+++instance ToJSON BoolMatch where+ toJSON (MustMatch term cache) = object ["must" .= toJSON term,+ "_cache" .= cache]+ toJSON (MustNotMatch term cache) = object ["must_not" .= toJSON term,+ "_cache" .= cache]+ toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,+ "_cache" .= cache]+++instance (FromJSON a) => FromJSON (SearchResult a) where+ parseJSON (Object v) = SearchResult <$>+ v .: "took" <*>+ v .: "timed_out" <*>+ v .: "_shards" <*>+ v .: "hits"+ parseJSON _ = empty++instance (FromJSON a) => FromJSON (SearchHits a) where+ parseJSON (Object v) = SearchHits <$>+ v .: "total" <*>+ v .: "max_score" <*>+ v .: "hits"+ parseJSON _ = empty++instance (FromJSON a) => FromJSON (Hit a) where+ parseJSON (Object v) = Hit <$>+ v .: "_index" <*>+ v .: "_type" <*>+ v .: "_id" <*>+ v .: "_score" <*>+ v .: "_source"+ parseJSON _ = empty++instance FromJSON ShardResult where+ parseJSON (Object v) = ShardResult <$>+ v .: "total" <*>+ v .: "successful" <*>+ v .: "failed"+ parseJSON _ = empty
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bloodhound.cabal view
@@ -0,0 +1,69 @@+-- Initial bloodhound.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: bloodhound+version: 0.1.0.0+synopsis: ElasticSearch client library for Haskell+description: ElasticSearch made awesome for Haskell hackers+homepage: github.com/bitemyapp/bloodhound+license: Apache-2.0+license-file: LICENSE+author: Chris Allen+maintainer: cma@bitemyapp.com+copyright: 2014, Chris Allen+category: Database, Search+build-type: Simple+cabal-version: >=1.10++library+ ghc-options: -Wall+ default-extensions: OverloadedStrings+ exposed-modules: Database.Bloodhound+ Database.Bloodhound.Client+ Database.Bloodhound.Types+ Database.Bloodhound.Types.Class+ Database.Bloodhound.Types.Instances+ build-depends: base >=4.3 && <5,+ bytestring >= 0.10,+ transformers >= 0.3,+ free >= 4.5,+ lens >= 4,+ aeson >= 0.7,+ aeson-pretty >= 0.7,+ conduit >= 1.0,+ http-conduit >= 2.0,+ io-streams >= 1.1,+ http-streams >= 0.7,+ HTTP >= 4000.2,+ time >= 1.4,+ text >= 0.11,+ http-types >= 0.8,+ blaze-builder >= 0.3,+ failure >= 0.2,+ semigroups >= 0.12,+ containers ,+ scientific+ default-language: Haskell2010++test-suite tests+ ghc-options: -Wall+ default-extensions: OverloadedStrings+ type: exitcode-stdio-1.0+ main-is: tests.hs+ -- ghc-options: -w -threaded -rtsopts -with-rtsopts=-N+ hs-source-dirs: tests+ build-depends: base,+ bloodhound,+ http-conduit,+ http-types,+ bytestring >= 0.10,+ hspec >= 1.8,+ QuickCheck >= 2.5,+ derive >= 2.5,+ text >= 0.11,+ time >= 1.4,+ aeson >= 0.7,+ aeson-pretty >= 0.7,+ random >= 1.0,+ quickcheck-instances >= 0.3+ default-language: Haskell2010
+ tests/tests.hs view
@@ -0,0 +1,330 @@+{-# LANGUAGE DeriveGeneric #-}++module Main where++import Database.Bloodhound+import Data.Aeson+-- import Data.Aeson.Encode.Pretty+-- import Data.ByteString.Lazy.Char8 (putStrLn)+import Data.Time.Calendar (Day(..))+import Data.Time.Clock (secondsToDiffTime, UTCTime(..))+import Data.Text (Text)+import GHC.Generics (Generic)+import Network.HTTP.Conduit+import qualified Network.HTTP.Types.Status as NHTS+import Prelude hiding (filter, putStrLn)+import Test.Hspec++testServer :: Server+testServer = Server "http://localhost:9200"+testIndex :: IndexName+testIndex = IndexName "twitter"+testMapping :: MappingName+testMapping = MappingName "tweet"++validateStatus :: Response body -> Int -> Expectation+validateStatus resp expected =+ (NHTS.statusCode $ responseStatus resp)+ `shouldBe` (expected :: Int)++createExampleIndex :: IO Reply+createExampleIndex = createIndex testServer defaultIndexSettings testIndex+deleteExampleIndex :: IO Reply+deleteExampleIndex = deleteIndex testServer testIndex++data Location = Location { lat :: Double+ , lon :: Double } deriving (Eq, Generic, Show)++data Tweet = Tweet { user :: Text+ , postDate :: UTCTime+ , message :: Text+ , age :: Int+ , location :: Location }+ deriving (Eq, Generic, Show)++instance ToJSON Tweet+instance FromJSON Tweet+instance ToJSON Location+instance FromJSON Location++data TweetMapping = TweetMapping deriving (Eq, Show)++instance ToJSON TweetMapping where+ toJSON TweetMapping =+ object ["tweet" .=+ object ["properties" .=+ object ["location" .= object ["type" .= ("geo_point" :: Text)]]]]++exampleTweet :: Tweet+exampleTweet = Tweet { user = "bitemyapp"+ , postDate = UTCTime+ (ModifiedJulianDay 55000)+ (secondsToDiffTime 10)+ , message = "Use haskell!"+ , age = 10000+ , location = Location 40.12 (-71.34) }++otherTweet :: Tweet+otherTweet = Tweet { user = "notmyapp"+ , postDate = UTCTime+ (ModifiedJulianDay 55000)+ (secondsToDiffTime 11)+ , message = "Use haskell!"+ , age = 1000+ , location = Location 40.12 (-71.34) }++insertData :: IO ()+insertData = do+ _ <- deleteExampleIndex+ _ <- createExampleIndex+ _ <- createMapping testServer testIndex testMapping TweetMapping+ _ <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")+ _ <- refreshIndex testServer testIndex+ return ()++insertOther :: IO ()+insertOther = do+ _ <- indexDocument testServer testIndex testMapping otherTweet (DocId "2")+ _ <- refreshIndex testServer testIndex+ return ()++searchTweet :: Search -> IO (Either String Tweet)+searchTweet search = do+ reply <- searchByIndex testServer testIndex search+ let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)+ let myTweet = fmap (hitSource . head . hits . searchHits) result+ return myTweet++searchExpectNoResults :: Search -> IO ()+searchExpectNoResults search = do+ reply <- searchByIndex testServer testIndex search+ let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)+ let emptyHits = fmap (hits . searchHits) result+ emptyHits `shouldBe` Right []++data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)+instance FromJSON BulkTest+instance ToJSON BulkTest++main :: IO ()+main = hspec $ do++ describe "index create/delete API" $ do+ it "creates and then deletes the requested index" $ do+ -- priming state.+ _ <- deleteExampleIndex+ resp <- createExampleIndex+ deleteResp <- deleteExampleIndex+ validateStatus resp 200+ validateStatus deleteResp 200+++ describe "document API" $ do+ it "indexes, gets, and then deletes the generated document" $ do+ _ <- insertData+ docInserted <- getDocument testServer testIndex testMapping (DocId "1")+ let newTweet = eitherDecode+ (responseBody docInserted) :: Either String (EsResult Tweet)+ fmap _source newTweet `shouldBe` Right exampleTweet+++ describe "bulk API" $ do+ it "inserts all documents we request" $ do+ _ <- insertData+ let firstTest = BulkTest "blah"+ let secondTest = BulkTest "bloo"+ let firstDoc = BulkIndex (IndexName "twitter")+ (MappingName "tweet") (DocId "2") (object ["name" .= String "blah"])+ let secondDoc = BulkCreate (IndexName "twitter")+ (MappingName "tweet") (DocId "3") (object ["name" .= String "bloo"])+ let stream = [firstDoc, secondDoc]+ _ <- bulk testServer stream+ _ <- refreshIndex testServer testIndex+ fDoc <- getDocument testServer testIndex testMapping (DocId "2")+ sDoc <- getDocument testServer testIndex testMapping (DocId "3")+ let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)+ let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)+ fmap _source maybeFirst `shouldBe` Right firstTest+ fmap _source maybeSecond `shouldBe` Right secondTest+++ describe "query API" $ do+ it "returns document for term query and identity filter" $ do+ _ <- insertData+ let query = TermQuery (Term "user" "bitemyapp") Nothing+ let filter = IdentityFilter <&&> IdentityFilter+ let search = mkSearch (Just query) (Just filter)+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "returns document for match query" $ do+ _ <- insertData+ let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")+ let search = mkSearch (Just query) Nothing+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "returns document for multi-match query" $ do+ _ <- insertData+ let fields = [FieldName "user", FieldName "message"]+ let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")+ let search = mkSearch (Just query) Nothing+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "returns document for bool query" $ do+ _ <- insertData+ let innerQuery = QueryMatchQuery $+ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")+ let query = QueryBoolQuery $+ mkBoolQuery (Just innerQuery) Nothing Nothing+ let search = mkSearch (Just query) Nothing+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "returns document for boosting query" $ do+ _ <- insertData+ let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")+ let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")+ let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)+ let search = mkSearch (Just query) Nothing+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "returns document for common terms query" $ do+ _ <- insertData+ let query = QueryCommonTermsQuery $+ CommonTermsQuery (FieldName "user")+ (QueryString "bitemyapp")+ (CutoffFrequency 0.0001)+ Or Or Nothing Nothing Nothing Nothing+ let search = mkSearch (Just query) Nothing+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet+++ describe "sorting" $ do+ it "returns documents in the right order" $ do+ _ <- insertData+ _ <- insertOther+ let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending+ let search = Search Nothing+ (Just IdentityFilter) (Just [sortSpec])+ False 0 10+ reply <- searchByIndex testServer testIndex search+ let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)+ let myTweet = fmap (hitSource . head . hits . searchHits) result+ myTweet `shouldBe` Right otherTweet+++ describe "filtering API" $ do+ it "returns document for composed boolmatch and identity" $ do+ _ <- insertData+ let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)+ <&&> IdentityFilter+ let search = mkSearch Nothing (Just queryFilter)+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "returns document for existential filter" $ do+ _ <- insertData+ let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "returns document for geo boundingbox filter" $ do+ _ <- insertData+ let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))+ let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False+ let geoFilter = GeoBoundingBoxFilter bbConstraint GeoFilterMemory+ let search = mkSearch Nothing (Just geoFilter)+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "doesn't return document for nonsensical boundingbox filter" $ do+ _ <- insertData+ let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))+ let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False+ let geoFilter = GeoBoundingBoxFilter bbConstraint GeoFilterMemory+ let search = mkSearch Nothing (Just geoFilter)+ searchExpectNoResults search++ it "returns document for geo distance filter" $ do+ _ <- insertData+ let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))+ let distance = Distance 10.0 Miles+ let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory+ let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False+ let search = mkSearch Nothing (Just geoFilter)+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "returns document for geo distance range filter" $ do+ _ <- insertData+ let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))+ let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)+ let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange+ let search = mkSearch Nothing (Just geoFilter)+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "doesn't return document for wild geo distance range filter" $ do+ _ <- insertData+ let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))+ let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)+ let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange+ let search = mkSearch Nothing (Just geoFilter)+ searchExpectNoResults search++ it "returns document for geo polygon filter" $ do+ _ <- insertData+ let points = [LatLon 40.0 (-70.00),+ LatLon 40.0 (-72.00),+ LatLon 41.0 (-70.00),+ LatLon 41.0 (-72.00)]+ let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points+ let search = mkSearch Nothing (Just geoFilter)+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "doesn't return document for bad geo polygon filter" $ do+ _ <- insertData+ let points = [LatLon 40.0 (-70.00),+ LatLon 40.0 (-71.00),+ LatLon 41.0 (-70.00),+ LatLon 41.0 (-71.00)]+ let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points+ let search = mkSearch Nothing (Just geoFilter)+ searchExpectNoResults search++ it "returns document for ids filter" $ do+ _ <- insertData+ let filter = IdsFilter (MappingName "tweet") [DocId "1"]+ let search = mkSearch Nothing (Just filter)+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "returns document for range filter" $ do+ _ <- insertData+ let filter = RangeFilter (FieldName "age")+ (Right (RangeLtGt (LessThan 100000.0) (GreaterThan 1000.0)))+ RangeExecutionIndex False+ let search = mkSearch Nothing (Just filter)+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "returns document for regexp filter" $ do+ _ <- insertData+ let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")+ (RegexpFlags "ALL") (CacheName "test") False (CacheKey "key")+ let search = mkSearch Nothing (Just filter)+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet++ it "doesn't return document for non-matching regexp filter" $ do+ _ <- insertData+ let filter = RegexpFilter (FieldName "user")+ (Regexp "boy") (RegexpFlags "ALL")+ (CacheName "test") False (CacheKey "key")+ let search = mkSearch Nothing (Just filter)+ searchExpectNoResults search