Skip to content

Commit fdf86b0

Browse files
committed
Add Semigroup instances
1 parent dc4b4be commit fdf86b0

File tree

4 files changed

+24
-4
lines changed

4 files changed

+24
-4
lines changed

servant-client/servant-client.cabal

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,9 @@ library
5959
, transformers-base >= 0.4.4 && < 0.5
6060
, transformers-compat >= 0.4 && < 0.6
6161
, mtl
62+
if !impl(ghc >= 8.0)
63+
build-depends:
64+
semigroups >=0.16.2.2 && <0.19
6265
hs-source-dirs: src
6366
default-language: Haskell2010
6467
ghc-options: -Wall

servant-client/src/Servant/Common/Req.hs

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ import Control.Exception
1616
import Control.Monad
1717
import Control.Monad.Catch (MonadThrow, MonadCatch)
1818
import Data.Foldable (toList)
19+
import Data.Semigroup (Semigroup (..))
1920

2021
import Control.Monad.Error.Class (MonadError(..))
2122
import Control.Monad.Trans.Except
@@ -27,7 +28,7 @@ import Control.Monad.Reader
2728
import Control.Monad.Trans.Control (MonadBaseControl (..))
2829
import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)
2930
import Data.String
30-
import Data.String.Conversions
31+
import Data.String.Conversions (cs)
3132
import Data.Proxy
3233
import Data.Text (Text)
3334
import Data.Text.Encoding
@@ -214,6 +215,10 @@ instance MonadBaseControl IO ClientM where
214215
-- restoreM :: StM ClientM a -> ClientM a
215216
restoreM st = ClientM (restoreM st)
216217

218+
-- | Try clients in order, last error is preserved.
219+
instance Semigroup (ClientM a) where
220+
a <> b = a `catchError` \_ -> b
221+
217222
runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
218223
runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
219224

servant-docs/servant-docs.cabal

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,7 @@ library
3333
, Servant.Docs.Internal.Pretty
3434
build-depends:
3535
base >=4.7 && <5
36+
, base-compat >= 0.9.1 && <0.10
3637
, aeson
3738
, aeson-pretty
3839
, bytestring
@@ -46,6 +47,9 @@ library
4647
, text
4748
, unordered-containers
4849
, control-monad-omega == 0.3.*
50+
if !impl(ghc >= 8.0)
51+
build-depends:
52+
semigroups >=0.16.2.2 && <0.19
4953
hs-source-dirs: src
5054
default-language: Haskell2010
5155
ghc-options: -Wall

servant-docs/src/Servant/Docs/Internal.hs

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,8 @@
2020
#include "overlapping-compat.h"
2121
module Servant.Docs.Internal where
2222

23+
import Prelude ()
24+
import Prelude.Compat
2325
import Control.Applicative
2426
import Control.Arrow (second)
2527
import Control.Lens (makeLenses, mapped, over, traversed, view, (%~),
@@ -30,9 +32,10 @@ import qualified Data.ByteString.Char8 as BSC
3032
import qualified Data.CaseInsensitive as CI
3133
import Data.Hashable (Hashable)
3234
import Data.HashMap.Strict (HashMap)
33-
import Data.List
35+
import Data.List.Compat (intercalate, intersperse, sort)
3436
import Data.Maybe
35-
import Data.Monoid
37+
import Data.Monoid (All (..), Any (..), Sum (..), Product (..), First (..), Last (..), Dual (..))
38+
import Data.Semigroup (Semigroup (..))
3639
import Data.Ord (comparing)
3740
import Data.Proxy (Proxy(Proxy))
3841
import Data.String.Conversions (cs)
@@ -102,8 +105,11 @@ data API = API
102105
, _apiEndpoints :: HashMap Endpoint Action
103106
} deriving (Eq, Show)
104107

108+
instance Semigroup API where
109+
(<>) = mappend
110+
105111
instance Monoid API where
106-
API a1 b1 `mappend` API a2 b2 = API (a1 <> a2) (b1 <> b2)
112+
API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2) (b1 `mappend` b2)
107113
mempty = API mempty mempty
108114

109115
-- | An empty 'API'
@@ -162,6 +168,8 @@ data DocNote = DocNote
162168
-- These are intended to be built using extraInfo.
163169
-- Multiple ExtraInfo may be combined with the monoid instance.
164170
newtype ExtraInfo api = ExtraInfo (HashMap Endpoint Action)
171+
instance Semigroup (ExtraInfo a) where
172+
(<>) = mappend
165173
instance Monoid (ExtraInfo a) where
166174
mempty = ExtraInfo mempty
167175
ExtraInfo a `mappend` ExtraInfo b =

0 commit comments

Comments
 (0)