25110fe · typeable/servant

git.iko.soy/typeable/servant

Merge pull request #679 from phadej/semigroup

Semigroup

commit25110fefe430fb7767835700252c5e07fed080ff authorOleg Grenrus <oleg.grenrus@iki.fi> dateFri 20 Jan 2017, 15:00 (10 years ago) parent22b4d13 6fafaec

6 files changed+31−5

compare with master

unifiedsplit

servant-client/servant-client.cabal+4 servant-client/src/Servant/Common/Req.hs+7−1 servant-docs/servant-docs.cabal+4 servant-docs/src/Servant/Docs/Internal.hs+11−3 servant/src/Servant/API/Alternative.hs+4 servant/src/Servant/Utils/Links.hs+1−1

servant-client/servant-client.cabal+4

@@ -52,6 +52,7 @@ 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

@@ -59,6 +60,9 @@ library

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+7−1

@@ -16,6 +16,8 @@ import Control.Exception

1616import Control.Monad

1717import Control.Monad.Catch (MonadThrow, MonadCatch)

1818import Data.Foldable (toList)

19+import Data.Functor.Alt (Alt (..))

20+import Data.Semigroup ((<>))

1921

2022import Control.Monad.Error.Class (MonadError(..))

2123import Control.Monad.Trans.Except

@@ -27,7 +29,7 @@ import Control.Monad.Reader

2729import Control.Monad.Trans.Control (MonadBaseControl (..))

2830import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)

2931import Data.String

30−import Data.String.Conversions

32+import Data.String.Conversions (cs)

3133import Data.Proxy

3234import Data.Text (Text)

3335import 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+

217223runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)

218224runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm

219225

servant-docs/servant-docs.cabal+4

@@ -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+11−3

@@ -20,6 +20,8 @@

2020#include "overlapping-compat.h"

2121module Servant.Docs.Internal where

2222

23+import Prelude ()

24+import Prelude.Compat

2325import Control.Applicative

2426import Control.Arrow (second)

2527import Control.Lens (makeLenses, mapped, over, traversed, view, (%~),

@@ -30,9 +32,10 @@ import qualified Data.ByteString.Char8 as BSC

3032import qualified Data.CaseInsensitive as CI

3133import Data.Hashable (Hashable)

3234import Data.HashMap.Strict (HashMap)

33−import Data.List

35+import Data.List.Compat (intercalate, intersperse, sort)

3436import Data.Maybe

35−import Data.Monoid

37+import Data.Monoid (All (..), Any (..), Sum (..), Product (..), First (..), Last (..), Dual (..))

38+import Data.Semigroup (Semigroup (..))

3639import Data.Ord (comparing)

3740import Data.Proxy (Proxy(Proxy))

3841import 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+

105111instance 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.

164170newtype ExtraInfo api = ExtraInfo (HashMap Endpoint Action)

171+instance Semigroup (ExtraInfo a) where

172+ (<>) = mappend

165173instance Monoid (ExtraInfo a) where

166174 mempty = ExtraInfo mempty

167175 ExtraInfo a `mappend` ExtraInfo b =

servant/src/Servant/API/Alternative.hs+4

@@ -7,6 +7,7 @@

77{-# OPTIONS_HADDOCK not-home #-}

88module Servant.API.Alternative ((:<|>)(..)) where

10+import Data.Semigroup (Semigroup (..))

1011import Data.Typeable (Typeable)

1112import Prelude ()

1213import Prelude.Compat

@@ -23,6 +24,9 @@ data a :<|> b = a :<|> b

2324 deriving (Typeable, Eq, Show, Functor, Traversable, Foldable, Bounded)

2425infixr 8 :<|>

2526

27+instance (Semigroup a, Semigroup b) => Semigroup (a :<|> b) where

28+ (a :<|> b) <> (a' :<|> b') = (a <> a') :<|> (b <> b')

29+

2630instance (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+1−1

@@ -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