Skip to content

Commit 25110fe

Browse files
authored
Merge pull request #679 from phadej/semigroup
Semigroup
2 parents 22b4d13 + 6fafaec commit 25110fe

File tree

6 files changed

+31
-5
lines changed

6 files changed

+31
-5
lines changed

servant-client/servant-client.cabal

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -52,13 +52,17 @@ library
5252
, monad-control >= 1.0.0.4 && < 1.1
5353
, network-uri >= 2.6 && < 2.7
5454
, safe >= 0.3.9 && < 0.4
55+
, semigroupoids >= 4.3 && < 5.2
5556
, servant == 0.9.*
5657
, string-conversions >= 0.3 && < 0.5
5758
, text >= 1.2 && < 1.3
5859
, transformers >= 0.3 && < 0.6
5960
, transformers-base >= 0.4.4 && < 0.5
6061
, transformers-compat >= 0.4 && < 0.6
6162
, mtl
63+
if !impl(ghc >= 8.0)
64+
build-depends:
65+
semigroups >=0.16.2.2 && <0.19
6266
hs-source-dirs: src
6367
default-language: Haskell2010
6468
ghc-options: -Wall

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

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

2022
import Control.Monad.Error.Class (MonadError(..))
2123
import Control.Monad.Trans.Except
@@ -27,7 +29,7 @@ import Control.Monad.Reader
2729
import Control.Monad.Trans.Control (MonadBaseControl (..))
2830
import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)
2931
import Data.String
30-
import Data.String.Conversions
32+
import Data.String.Conversions (cs)
3133
import Data.Proxy
3234
import Data.Text (Text)
3335
import Data.Text.Encoding
@@ -214,6 +216,10 @@ instance MonadBaseControl IO ClientM where
214216
-- restoreM :: StM ClientM a -> ClientM a
215217
restoreM st = ClientM (restoreM st)
216218

219+
-- | Try clients in order, last error is preserved.
220+
instance Alt ClientM where
221+
a <!> b = a `catchError` \_ -> b
222+
217223
runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
218224
runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
219225

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 =

servant/src/Servant/API/Alternative.hs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@
77
{-# OPTIONS_HADDOCK not-home #-}
88
module Servant.API.Alternative ((:<|>)(..)) where
99

10+
import Data.Semigroup (Semigroup (..))
1011
import Data.Typeable (Typeable)
1112
import Prelude ()
1213
import Prelude.Compat
@@ -23,6 +24,9 @@ data a :<|> b = a :<|> b
2324
deriving (Typeable, Eq, Show, Functor, Traversable, Foldable, Bounded)
2425
infixr 8 :<|>
2526

27+
instance (Semigroup a, Semigroup b) => Semigroup (a :<|> b) where
28+
(a :<|> b) <> (a' :<|> b') = (a <> a') :<|> (b <> b')
29+
2630
instance (Monoid a, Monoid b) => Monoid (a :<|> b) where
2731
mempty = mempty :<|> mempty
2832
(a :<|> b) `mappend` (a' :<|> b') = (a `mappend` a') :<|> (b `mappend` b')

servant/src/Servant/Utils/Links.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,7 @@ module Servant.Utils.Links (
8282

8383
-- * Building and using safe links
8484
--
85-
-- | Note that 'URI' is Network.URI.URI from the network-uri package.
85+
-- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
8686
safeLink
8787
, URI(..)
8888
-- * Adding custom types

0 commit comments

Comments
 (0)