git.iko.soy/typeable/bloodhound
on master help sign in
Add semigroups instances
commit0f6becf27a68386aaf1eeb8b89a0302eaed1a643 authorMichael Xavier <michael@michaelxavier.net> dateWed 1 Feb 2017, 11:45 (10 years ago) parent1ea188e
1 file changed+93−86
src/Database/V1/Bloodhound/Types.hs+93−86
src/Database/V1/Bloodhound/Types.hs+93−86
@@ -365,40 +365,44 @@ module Database.V1.Bloodhound.Types
365365 , EsPassword(..)
366366 ) where
367367
368−import Control.Applicative as A
369−import Control.Arrow (first)
368+import Control.Applicative as A
369+import Control.Arrow (first)
370370import Control.Monad.Catch
371371import Control.Monad.Except
372372import Control.Monad.Reader
373373import Control.Monad.State
374−import Control.Monad.Writer
374+import Control.Monad.Writer (MonadWriter)
375375import Data.Aeson
376−import Data.Aeson.Types (Pair, Parser, emptyObject,
377− parseEither, parseMaybe)
378−import qualified Data.ByteString.Lazy.Char8 as L
376+import Data.Aeson.Types (Pair, Parser,
377+ emptyObject,
378+ parseEither, parseMaybe)
379+import qualified Data.ByteString.Lazy.Char8 as L
379380import Data.Char
380−import Data.Hashable (Hashable)
381−import qualified Data.HashMap.Strict as HM
382−import Data.List (foldl', intercalate, nub)
383−import Data.List.NonEmpty (NonEmpty (..), toList)
384−import qualified Data.Map.Strict as M
381+import Data.Hashable (Hashable)
382+import qualified Data.HashMap.Strict as HM
383+import Data.List (foldl', intercalate,
384+ nub)
385+import Data.List.NonEmpty (NonEmpty (..), toList)
386+import qualified Data.Map.Strict as M
385387import Data.Maybe
386−import Data.Scientific (Scientific)
387−import Data.Text (Text)
388−import qualified Data.Text as T
388+import Data.Scientific (Scientific)
389+import Data.Semigroup
390+import Data.Text (Text)
391+import qualified Data.Text as T
389392import Data.Time.Calendar
390−import Data.Time.Clock (NominalDiffTime, UTCTime)
393+import Data.Time.Clock (NominalDiffTime,
394+ UTCTime)
391395import Data.Time.Clock.POSIX
392−import qualified Data.Traversable as DT
393−import Data.Typeable (Typeable)
394−import qualified Data.Vector as V
395−import qualified Data.Version as Vers
396+import qualified Data.Traversable as DT
397+import Data.Typeable (Typeable)
398+import qualified Data.Vector as V
399+import qualified Data.Version as Vers
396400import GHC.Enum
397−import GHC.Generics (Generic)
401+import GHC.Generics (Generic)
398402import Network.HTTP.Client
399−import qualified Network.HTTP.Types.Method as NHTM
400−import qualified Text.ParserCombinators.ReadP as RP
401−import qualified Text.Read as TR
403+import qualified Network.HTTP.Types.Method as NHTM
404+import qualified Text.ParserCombinators.ReadP as RP
405+import qualified Text.Read as TR
402406
403407import Database.V1.Bloodhound.Types.Class
404408import Database.V1.Bloodhound.Types.Internal
@@ -1647,12 +1651,12 @@ data SearchHits a =
16471651 , maxScore :: Score
16481652 , hits :: [Hit a] } deriving (Eq, Read, Show, Generic, Typeable)
16491653
1654+instance Semigroup (SearchHits a) where
1655+ (SearchHits ta ma ha) <> (SearchHits tb mb hb) = SearchHits (ta + tb) (max ma mb) (ha <> hb)
16501656
16511657instance Monoid (SearchHits a) where
16521658 mempty = SearchHits 0 Nothing mempty
1653− mappend (SearchHits ta ma ha) (SearchHits tb mb hb) =
1654− SearchHits (ta + tb) (max ma mb) (ha <> hb)
1655−
1659+ mappend = (<>)
16561660
16571661data Hit a =
16581662 Hit { hitIndex :: IndexName
@@ -1675,7 +1679,7 @@ showText = T.pack . show
16751679readMay :: Read a => String -> Maybe a
16761680readMay s = case reads s of
16771681 (a, ""):_ -> Just a
1678− _ -> Nothing
1682+ _ -> Nothing
16791683
16801684parseReadText :: Read a => Text -> Parser a
16811685parseReadText = maybe mzero return . readMay . T.unpack
@@ -1725,8 +1729,8 @@ data Aggregation = TermsAgg TermsAggregation
17251729 | ValueCountAgg ValueCountAggregation
17261730 | FilterAgg FilterAggregation
17271731 | DateRangeAgg DateRangeAggregation
1728− | MissingAgg MissingAggregation
1729− | TopHitsAgg TopHitsAggregation
1732+ | MissingAgg MissingAggregation
1733+ | TopHitsAgg TopHitsAggregation
17301734 deriving (Eq, Read, Show, Generic, Typeable)
17311735
17321736data TopHitsAggregation = TopHitsAggregation
@@ -1874,11 +1878,11 @@ instance ToJSON Interval where
18741878 toJSON (FractionalInterval fraction interval) = toJSON $ show fraction ++ show interval
18751879
18761880instance Show TimeInterval where
1877− show Weeks = "w"
1878− show Days = "d"
1879− show Hours = "h"
1880− show Minutes = "m"
1881− show Seconds = "s"
1881+ show Weeks = "w"
1882+ show Days = "d"
1883+ show Hours = "h"
1884+ show Minutes = "m"
1885+ show Seconds = "s"
18821886
18831887instance Read TimeInterval where
18841888 readPrec = f =<< TR.get
@@ -1934,7 +1938,7 @@ instance ToJSON Aggregation where
19341938 toJSON (MissingAgg (MissingAggregation{..})) =
19351939 object ["missing" .= object ["field" .= maField]]
19361940
1937− toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
1941+ toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
19381942 omitNulls ["top_hits" .= omitNulls [ "size" .= msize
19391943 , "from" .= mfrom
19401944 , "sort" .= msort
@@ -1949,22 +1953,22 @@ instance ToJSON DateRangeAggregation where
19491953 ]
19501954
19511955instance ToJSON DateRangeAggRange where
1952− toJSON (DateRangeFrom e) = object [ "from" .= e ]
1953− toJSON (DateRangeTo e) = object [ "to" .= e ]
1956+ toJSON (DateRangeFrom e) = object [ "from" .= e ]
1957+ toJSON (DateRangeTo e) = object [ "to" .= e ]
19541958 toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
19551959
19561960instance ToJSON DateMathExpr where
19571961 toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
1958− where fmtA DMNow = "now"
1962+ where fmtA DMNow = "now"
19591963 fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
1960− fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
1964+ fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
19611965 fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
1962− fmtMod (RoundDownTo u) = "/" <> fmtU u
1963− fmtU DMYear = "y"
1964− fmtU DMMonth = "M"
1965− fmtU DMWeek = "w"
1966− fmtU DMDay = "d"
1967− fmtU DMHour = "h"
1966+ fmtMod (RoundDownTo u) = "/" <> fmtU u
1967+ fmtU DMYear = "y"
1968+ fmtU DMMonth = "M"
1969+ fmtU DMWeek = "w"
1970+ fmtU DMDay = "d"
1971+ fmtU DMHour = "h"
19681972 fmtU DMMinute = "m"
19691973 fmtU DMSecond = "s"
19701974
@@ -2044,8 +2048,8 @@ instance (FromJSON a) => FromJSON (Bucket a) where
20442048instance FromJSON BucketValue where
20452049 parseJSON (String t) = return $ TextValue t
20462050 parseJSON (Number s) = return $ ScientificValue s
2047− parseJSON (Bool b) = return $ BoolValue b
2048− parseJSON _ = mempty
2051+ parseJSON (Bool b) = return $ BoolValue b
2052+ parseJSON _ = mempty
20492053
20502054instance FromJSON MissingResult where
20512055 parseJSON = withObject "MissingResult" parse
@@ -2098,9 +2102,12 @@ instance (FromJSON a) => FromJSON (TopHitResult a) where
20982102 v .: "hits"
20992103 parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
21002104
2105+instance Semigroup Filter where
2106+ a <> b = AndFilter [a, b] defaultCache
2107+
21012108instance Monoid Filter where
21022109 mempty = IdentityFilter
2103− mappend a b = AndFilter [a, b] defaultCache
2110+ mappend = (<>)
21042111
21052112instance Seminearring Filter where
21062113 a <||> b = OrFilter [a, b] defaultCache
@@ -2291,11 +2298,11 @@ fieldTagged f o = case HM.toList o of
22912298 _ -> fail "Expected object with 1 field-named key"
22922299
22932300-- Try to get an AggregationResults when we don't know the
2294−-- field name. We filter out the known keys to try to minimize the noise.
2301+-- field name. We filter out the known keys to try to minimize the noise.
22952302getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
22962303getNamedSubAgg o knownKeys = maggRes
22972304 where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
2298− maggRes
2305+ maggRes
22992306 | HM.null unknownKeys = Nothing
23002307 | otherwise = Just . M.fromList $ HM.toList unknownKeys
23012308
@@ -2470,9 +2477,9 @@ instance FromJSON Query where
24702477
24712478omitNulls :: [(Text, Value)] -> Value
24722479omitNulls = object . filter notNull where
2473− notNull (_, Null) = False
2480+ notNull (_, Null) = False
24742481 notNull (_, Array a) = (not . V.null) a
2475− notNull _ = True
2482+ notNull _ = True
24762483
24772484
24782485instance ToJSON SimpleQueryStringQuery where
@@ -3025,10 +3032,10 @@ instance FromJSON MultiMatchQuery where
30253032 <*> o .:? "lenient"
30263033
30273034instance ToJSON MultiMatchQueryType where
3028− toJSON MultiMatchBestFields = "best_fields"
3029− toJSON MultiMatchMostFields = "most_fields"
3030− toJSON MultiMatchCrossFields = "cross_fields"
3031− toJSON MultiMatchPhrase = "phrase"
3035+ toJSON MultiMatchBestFields = "best_fields"
3036+ toJSON MultiMatchMostFields = "most_fields"
3037+ toJSON MultiMatchCrossFields = "cross_fields"
3038+ toJSON MultiMatchPhrase = "phrase"
30323039 toJSON MultiMatchPhrasePrefix = "phrase_prefix"
30333040
30343041instance FromJSON MultiMatchQueryType where
@@ -3042,7 +3049,7 @@ instance FromJSON MultiMatchQueryType where
30423049
30433050instance ToJSON BooleanOperator where
30443051 toJSON And = String "and"
3045− toJSON Or = String "or"
3052+ toJSON Or = String "or"
30463053
30473054instance FromJSON BooleanOperator where
30483055 parseJSON = withText "BooleanOperator" parse
@@ -3061,7 +3068,7 @@ instance FromJSON ZeroTermsQuery where
30613068 parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
30623069
30633070instance ToJSON MatchQueryType where
3064− toJSON MatchPhrase = "phrase"
3071+ toJSON MatchPhrase = "phrase"
30653072 toJSON MatchPhrasePrefix = "phrase_prefix"
30663073
30673074instance FromJSON MatchQueryType where
@@ -3195,7 +3202,7 @@ instance FromJSON IndexSettingsSummary where
31953202 <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
31963203 _ -> fail "Expected single-key object with index name"
31973204 redundant (NumberOfReplicas _) = True
3198− redundant _ = False
3205+ redundant _ = False
31993206
32003207-- | For some reason in several settings APIs, all leaf values get returned
32013208-- as strings. This function attepmts to recover from this for all
@@ -3205,7 +3212,7 @@ unStringlyTypeJSON (String "true") = Bool True
32053212unStringlyTypeJSON (String "false") = Bool False
32063213unStringlyTypeJSON (String "null") = Null
32073214unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of
3208− Just n -> Number n
3215+ Just n -> Number n
32093216 Nothing -> v
32103217unStringlyTypeJSON v = v
32113218
@@ -3222,7 +3229,7 @@ parseSettings o = do
32223229 return (catMaybes parses)
32233230
32243231oPath :: ToJSON a => NonEmpty Text -> a -> Value
3225−oPath (k :| []) v = object [k .= v]
3232+oPath (k :| []) v = object [k .= v]
32263233oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
32273234
32283235attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
@@ -3232,12 +3239,12 @@ attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
32323239parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
32333240parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
32343241 where parse o = case HM.toList o of
3235− [] -> fail "Expected non-empty list of NodeAttrFilters"
3242+ [] -> fail "Expected non-empty list of NodeAttrFilters"
32363243 x:xs -> DT.mapM (uncurry parse') (x :| xs)
32373244 parse' n = withText "Text" $ \t ->
32383245 case T.splitOn "," t of
32393246 fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
3240− [] -> fail "Expected non-empty list of filter values"
3247+ [] -> fail "Expected non-empty list of filter values"
32413248
32423249instance ToJSON ReplicaBounds where
32433250 toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
@@ -3291,12 +3298,12 @@ instance ToJSON FSType where
32913298
32923299instance FromJSON FSType where
32933300 parseJSON = withText "FSType" parse
3294− where parse "simple" = pure FSSimple
3301+ where parse "simple" = pure FSSimple
32953302 parse "buffered" = pure FSBuffered
3296− parse t = fail ("Invalid FSType: " <> show t)
3303+ parse t = fail ("Invalid FSType: " <> show t)
32973304
32983305instance ToJSON CompoundFormat where
3299− toJSON (CompoundFileFormat x) = Bool x
3306+ toJSON (CompoundFileFormat x) = Bool x
33003307 toJSON (MergeSegmentVsTotalIndex x) = toJSON x
33013308
33023309instance FromJSON CompoundFormat where
@@ -3553,8 +3560,8 @@ instance ToJSON SortMode where
35533560
35543561
35553562instance ToJSON Missing where
3556− toJSON LastMissing = String "_last"
3557− toJSON FirstMissing = String "_first"
3563+ toJSON LastMissing = String "_last"
3564+ toJSON FirstMissing = String "_first"
35583565 toJSON (CustomMissing txt) = String txt
35593566
35603567
@@ -3570,7 +3577,7 @@ instance FromJSON ScoreType where
35703577 parse "avg" = pure ScoreTypeAvg
35713578 parse "sum" = pure ScoreTypeSum
35723579 parse "none" = pure ScoreTypeNone
3573− parse t = fail ("Unexpected ScoreType: " <> show t)
3580+ parse t = fail ("Unexpected ScoreType: " <> show t)
35743581
35753582instance ToJSON Distance where
35763583 toJSON (Distance dCoefficient dUnit) =
@@ -3588,7 +3595,7 @@ instance FromJSON Distance where
35883595 validForNumber '-' = True
35893596 validForNumber '.' = True
35903597 validForNumber 'e' = True
3591− validForNumber c = isNumber c
3598+ validForNumber c = isNumber c
35923599 parseCoeff "" = fail "Empty string cannot be parsed as number"
35933600 parseCoeff s = return (read (T.unpack s))
35943601
@@ -3615,7 +3622,7 @@ instance FromJSON DistanceUnit where
36153622 parse "cm" = pure Centimeters
36163623 parse "mm" = pure Millimeters
36173624 parse "nmi" = pure NauticalMiles
3618− parse u = fail ("Unrecognized DistanceUnit: " <> show u)
3625+ parse u = fail ("Unrecognized DistanceUnit: " <> show u)
36193626
36203627instance ToJSON DistanceType where
36213628 toJSON Arc = String "arc"
@@ -3624,21 +3631,21 @@ instance ToJSON DistanceType where
36243631
36253632instance FromJSON DistanceType where
36263633 parseJSON = withText "DistanceType" parse
3627− where parse "arc" = pure Arc
3634+ where parse "arc" = pure Arc
36283635 parse "sloppy_arc" = pure SloppyArc
3629− parse "plane" = pure Plane
3630− parse t = fail ("Unrecognized DistanceType: " <> show t)
3636+ parse "plane" = pure Plane
3637+ parse t = fail ("Unrecognized DistanceType: " <> show t)
36313638
36323639
36333640instance ToJSON OptimizeBbox where
3634− toJSON NoOptimizeBbox = String "none"
3641+ toJSON NoOptimizeBbox = String "none"
36353642 toJSON (OptimizeGeoFilterType gft) = toJSON gft
36363643
36373644instance FromJSON OptimizeBbox where
36383645 parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
36393646 <|> parseOptimize v
36403647 where parseNoOptimize "none" = pure NoOptimizeBbox
3641− parseNoOptimize _ = mzero
3648+ parseNoOptimize _ = mzero
36423649 parseOptimize = fmap OptimizeGeoFilterType . parseJSON
36433650
36443651instance ToJSON GeoBoundingBoxConstraint where
@@ -4431,7 +4438,7 @@ instance SnapshotRepo FsSnapshotRepo where
44314438
44324439parseRepo :: Parser a -> Either SnapshotRepoConversionError a
44334440parseRepo parser = case parseEither (const parser) () of
4434− Left e -> Left (OtherRepoConversionError (T.pack e))
4441+ Left e -> Left (OtherRepoConversionError (T.pack e))
44354442 Right a -> Right a
44364443
44374444
@@ -4957,7 +4964,7 @@ instance FromJSON NodeIndicesStats where
49574964 where
49584965 parse o = do
49594966 let (.::) mv k = case mv of
4960− Just v -> Just <$> v .: k
4967+ Just v -> Just <$> v .: k
49614968 Nothing -> pure Nothing
49624969 mRecovery <- o .:? "recovery"
49634970 mQueryCache <- o .:? "query_cache"
@@ -5208,8 +5215,8 @@ parseStringInterval s = case span isNumber s of
52085215 ("", _) -> fail "Invalid interval"
52095216 (nS, unitS) -> case (readMay nS, readMay unitS) of
52105217 (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
5211− (Nothing, _) -> fail "Invalid interval number"
5212− (_, Nothing) -> fail "Invalid interval unit"
5218+ (Nothing, _) -> fail "Invalid interval number"
5219+ (_, Nothing) -> fail "Invalid interval unit"
52135220 where
52145221 unitNDT Seconds = 1
52155222 unitNDT Minutes = 60
@@ -5228,8 +5235,8 @@ instance FromJSON ThreadPoolSize where
52285235 parseAsString = withText "ThreadPoolSize" $ \t ->
52295236 case first (readMay . T.unpack) (T.span isNumber t) of
52305237 (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
5231− (Just n, "") -> return (ThreadPoolBounded n)
5232− _ -> fail ("Invalid thread pool size " <> T.unpack t)
5238+ (Just n, "") -> return (ThreadPoolBounded n)
5239+ _ -> fail ("Invalid thread pool size " <> T.unpack t)
52335240
52345241instance FromJSON ThreadPoolType where
52355242 parseJSON = withText "ThreadPoolType" parse
@@ -5244,10 +5251,10 @@ instance FromJSON NodeTransportInfo where
52445251 where
52455252 parse o = NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
52465253 <*> parseJSON (Object o)
5247− parseProfiles (Object o) | HM.null o = return []
5254+ parseProfiles (Object o) | HM.null o = return []
52485255 parseProfiles v@(Array _) = parseJSON v
5249− parseProfiles Null = return []
5250− parseProfiles _ = fail "Could not parse profiles"
5256+ parseProfiles Null = return []
5257+ parseProfiles _ = fail "Could not parse profiles"
52515258
52525259instance FromJSON NodeNetworkInfo where
52535260 parseJSON = withObject "NodeNetworkInfo" parse
@@ -5268,4 +5275,4 @@ newtype MaybeNA a = MaybeNA { unMaybeNA :: Maybe a }
52685275
52695276instance FromJSON a => FromJSON (MaybeNA a) where
52705277 parseJSON (String "NA") = pure $ MaybeNA Nothing
5271− parseJSON o = MaybeNA . Just <$> parseJSON o
5278+ parseJSON o = MaybeNA . Just <$> parseJSON o