From 09c57f730f6c79f2c9b67eb965ced16466e2c52f Mon Sep 17 00:00:00 2001 From: Chris Allen Date: Mon, 20 Oct 2014 00:39:27 -0500 Subject: [PATCH] warnings cleanup, partial instances, name overlaps --- Database/Bloodhound/Client.hs | 2 +- Database/Bloodhound/Types.hs | 26 ++++++++++++++------------ bloodhound.cabal | 2 +- tests/tests.hs | 7 ++++--- 4 files changed, 20 insertions(+), 17 deletions(-) diff --git a/Database/Bloodhound/Client.hs b/Database/Bloodhound/Client.hs index 9e10395..b517dd6 100644 --- a/Database/Bloodhound/Client.hs +++ b/Database/Bloodhound/Client.hs @@ -248,7 +248,7 @@ mkSearch :: Maybe Query -> Maybe Filter -> Search mkSearch query filter = Search query filter Nothing Nothing False 0 10 mkAggregateSearch :: Maybe Query -> Aggregations -> Search -mkAggregateSearch query aggregations = Search query Nothing Nothing (Just aggregations) False 0 0 +mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) False 0 0 pageSearch :: Int -> Int -> Search -> Search pageSearch pageFrom pageSize search = search { from = pageFrom, size = pageSize } diff --git a/Database/Bloodhound/Types.hs b/Database/Bloodhound/Types.hs index de89357..3aedeee 100644 --- a/Database/Bloodhound/Types.hs +++ b/Database/Bloodhound/Types.hs @@ -162,8 +162,8 @@ module Database.Bloodhound.Types , BucketAggregation(..) , TermsAggregation(..) , DateHistogramAggregation(..) - , TermsResult - , DateHistogramResult + , TermsResult(..) + , DateHistogramResult(..) ) where import Control.Applicative @@ -1080,7 +1080,7 @@ instance Show TimeInterval where show Seconds = "s" instance ToJSON Aggregation where - toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint aggs)) = + toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) = omitNulls ["terms" .= omitNulls [ toJSON' term, "include" .= toJSON include, "exclude" .= toJSON exclude, @@ -1091,11 +1091,11 @@ instance ToJSON Aggregation where "collect_mode" .= toJSON collectMode, "execution_hint" .= toJSON executionHint ], - "aggs" .= toJSON aggs ] + "aggs" .= toJSON termAggs ] where toJSON' x = case x of { Left y -> "field" .= toJSON y; Right y -> "script" .= toJSON y } - toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset aggs)) = + toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) = omitNulls ["date_histogram" .= omitNulls [ "field" .= toJSON field, "interval" .= toJSON interval, "format" .= toJSON format, @@ -1104,7 +1104,7 @@ instance ToJSON Aggregation where "pre_offset" .= toJSON preOffset, "post_offset" .= toJSON postOffset ], - "aggs" .= toJSON aggs ] + "aggs" .= toJSON dateHistoAggs ] type AggregationResults = M.Map Text Value @@ -1153,6 +1153,7 @@ instance FromJSON TermsResult where v .: "key" <*> v .: "doc_count" <*> v .:? "aggregations" + parseJSON _ = mempty instance FromJSON DateHistogramResult where parseJSON (Object v) = DateHistogramResult <$> @@ -1160,6 +1161,7 @@ instance FromJSON DateHistogramResult where v .:? "key_as_string" <*> v .: "doc_count" <*> v .:? "aggregations" + parseJSON _ = mempty instance Monoid Filter where mempty = IdentityFilter @@ -1244,11 +1246,11 @@ instance ToJSON Filter where toJSON (RangeFilter (FieldName fieldName) (Left halfRange) rangeExecution cache) = object ["range" .= object [fieldName .= - object [key .= val] + object [rqFKey .= rqFVal] , "execution" .= toJSON rangeExecution , "_cache" .= cache]] where - (key, val) = halfRangeToKV halfRange + (rqFKey, rqFVal) = halfRangeToKV halfRange toJSON (RangeFilter (FieldName fieldName) (Right range) rangeExecution cache) = object ["range" .= @@ -1462,8 +1464,8 @@ instance ToJSON RangeQuery where toJSON (RangeQuery (FieldName fieldName) (Left halfRange) boost) = object [ fieldName .= conjoined ] where conjoined = [ "boost" .= toJSON boost - , key .= val ] - (key, val) = halfRangeToKV halfRange + , rqKey .= rqVal ] + (rqKey, rqVal) = halfRangeToKV halfRange instance ToJSON PrefixQuery where @@ -1754,11 +1756,11 @@ instance (FromJSON a) => FromJSON (EsResult a) where instance ToJSON Search where - toJSON (Search query sFilter sort aggs sTrackSortScores sFrom sSize) = + toJSON (Search query sFilter sort searchAggs sTrackSortScores sFrom sSize) = omitNulls [ "query" .= query , "filter" .= sFilter , "sort" .= sort - , "aggregations" .= aggs + , "aggregations" .= searchAggs , "from" .= sFrom , "size" .= sSize , "track_scores" .= sTrackSortScores ] diff --git a/bloodhound.cabal b/bloodhound.cabal index 93a9ca8..6f55158 100644 --- a/bloodhound.cabal +++ b/bloodhound.cabal @@ -17,7 +17,7 @@ source-repository head location: https://github.com/bitemyapp/bloodhound.git library - ghc-options: -Wall + ghc-options: -Wall -Werror default-extensions: OverloadedStrings exposed-modules: Database.Bloodhound Database.Bloodhound.Client diff --git a/tests/tests.hs b/tests/tests.hs index 95bed25..42250ba 100644 --- a/tests/tests.hs +++ b/tests/tests.hs @@ -6,7 +6,6 @@ module Main where import Control.Applicative import Control.Monad import Data.Aeson -import Data.Aeson.Types (parseMaybe) import Data.HashMap.Strict (fromList) import Data.List (nub) import Data.List.NonEmpty (NonEmpty (..)) @@ -60,10 +59,12 @@ es10 :: ServerVersion es10 = ServerVersion 1 0 0 serverBranch :: ServerVersion -> ServerVersion -serverBranch (ServerVersion maj min patch) = ServerVersion maj min 0 +serverBranch (ServerVersion majorVer minorVer patchVer) = + ServerVersion majorVer minorVer patchVer mkServerVersion :: [Int] -> Maybe ServerVersion -mkServerVersion [maj, min, patch] = Just (ServerVersion maj min patch) +mkServerVersion [majorVer, minorVer, patchVer] = + Just (ServerVersion majorVer minorVer patchVer) mkServerVersion _ = Nothing getServerVersion :: Server -> IO (Maybe ServerVersion)