diff --git a/servant-client/servant-client.cabal b/servant-client/servant-client.cabal index 81069740..f48d69a0 100644 --- a/servant-client/servant-client.cabal +++ b/servant-client/servant-client.cabal @@ -52,6 +52,7 @@ library , monad-control >= 1.0.0.4 && < 1.1 , network-uri >= 2.6 && < 2.7 , safe >= 0.3.9 && < 0.4 + , semigroupoids >= 4.3 && < 5.2 , servant == 0.9.* , string-conversions >= 0.3 && < 0.5 , text >= 1.2 && < 1.3 @@ -59,6 +60,9 @@ library , transformers-base >= 0.4.4 && < 0.5 , transformers-compat >= 0.4 && < 0.6 , mtl + if !impl(ghc >= 8.0) + build-depends: + semigroups >=0.16.2.2 && <0.19 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall diff --git a/servant-client/src/Servant/Common/Req.hs b/servant-client/src/Servant/Common/Req.hs index 3fb8c5aa..f3de9687 100644 --- a/servant-client/src/Servant/Common/Req.hs +++ b/servant-client/src/Servant/Common/Req.hs @@ -16,6 +16,8 @@ import Control.Exception import Control.Monad import Control.Monad.Catch (MonadThrow, MonadCatch) import Data.Foldable (toList) +import Data.Functor.Alt (Alt (..)) +import Data.Semigroup ((<>)) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Trans.Except @@ -27,7 +29,7 @@ import Control.Monad.Reader import Control.Monad.Trans.Control (MonadBaseControl (..)) import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any) import Data.String -import Data.String.Conversions +import Data.String.Conversions (cs) import Data.Proxy import Data.Text (Text) import Data.Text.Encoding @@ -214,6 +216,10 @@ instance MonadBaseControl IO ClientM where -- restoreM :: StM ClientM a -> ClientM a restoreM st = ClientM (restoreM st) +-- | Try clients in order, last error is preserved. +instance Alt ClientM where + a b = a `catchError` \_ -> b + runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a) runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm diff --git a/servant-docs/servant-docs.cabal b/servant-docs/servant-docs.cabal index 5981fbe9..719ea038 100644 --- a/servant-docs/servant-docs.cabal +++ b/servant-docs/servant-docs.cabal @@ -33,6 +33,7 @@ library , Servant.Docs.Internal.Pretty build-depends: base >=4.7 && <5 + , base-compat >= 0.9.1 && <0.10 , aeson , aeson-pretty , bytestring @@ -46,6 +47,9 @@ library , text , unordered-containers , control-monad-omega == 0.3.* + if !impl(ghc >= 8.0) + build-depends: + semigroups >=0.16.2.2 && <0.19 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index 502c540f..2884473c 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -20,6 +20,8 @@ #include "overlapping-compat.h" module Servant.Docs.Internal where +import Prelude () +import Prelude.Compat import Control.Applicative import Control.Arrow (second) import Control.Lens (makeLenses, mapped, over, traversed, view, (%~), @@ -30,9 +32,10 @@ import qualified Data.ByteString.Char8 as BSC import qualified Data.CaseInsensitive as CI import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) -import Data.List +import Data.List.Compat (intercalate, intersperse, sort) import Data.Maybe -import Data.Monoid +import Data.Monoid (All (..), Any (..), Sum (..), Product (..), First (..), Last (..), Dual (..)) +import Data.Semigroup (Semigroup (..)) import Data.Ord (comparing) import Data.Proxy (Proxy(Proxy)) import Data.String.Conversions (cs) @@ -102,8 +105,11 @@ data API = API , _apiEndpoints :: HashMap Endpoint Action } deriving (Eq, Show) +instance Semigroup API where + (<>) = mappend + instance Monoid API where - API a1 b1 `mappend` API a2 b2 = API (a1 <> a2) (b1 <> b2) + API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2) (b1 `mappend` b2) mempty = API mempty mempty -- | An empty 'API' @@ -162,6 +168,8 @@ data DocNote = DocNote -- These are intended to be built using extraInfo. -- Multiple ExtraInfo may be combined with the monoid instance. newtype ExtraInfo api = ExtraInfo (HashMap Endpoint Action) +instance Semigroup (ExtraInfo a) where + (<>) = mappend instance Monoid (ExtraInfo a) where mempty = ExtraInfo mempty ExtraInfo a `mappend` ExtraInfo b = diff --git a/servant/src/Servant/API/Alternative.hs b/servant/src/Servant/API/Alternative.hs index 8a8a693f..130f7529 100644 --- a/servant/src/Servant/API/Alternative.hs +++ b/servant/src/Servant/API/Alternative.hs @@ -7,6 +7,7 @@ {-# OPTIONS_HADDOCK not-home #-} module Servant.API.Alternative ((:<|>)(..)) where +import Data.Semigroup (Semigroup (..)) import Data.Typeable (Typeable) import Prelude () import Prelude.Compat @@ -23,6 +24,9 @@ data a :<|> b = a :<|> b deriving (Typeable, Eq, Show, Functor, Traversable, Foldable, Bounded) infixr 8 :<|> +instance (Semigroup a, Semigroup b) => Semigroup (a :<|> b) where + (a :<|> b) <> (a' :<|> b') = (a <> a') :<|> (b <> b') + instance (Monoid a, Monoid b) => Monoid (a :<|> b) where mempty = mempty :<|> mempty (a :<|> b) `mappend` (a' :<|> b') = (a `mappend` a') :<|> (b `mappend` b') diff --git a/servant/src/Servant/Utils/Links.hs b/servant/src/Servant/Utils/Links.hs index 618bb2aa..ee7090e1 100644 --- a/servant/src/Servant/Utils/Links.hs +++ b/servant/src/Servant/Utils/Links.hs @@ -82,7 +82,7 @@ module Servant.Utils.Links ( -- * Building and using safe links -- - -- | Note that 'URI' is Network.URI.URI from the network-uri package. + -- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package. safeLink , URI(..) -- * Adding custom types