Merge pull request #679 from phadej/semigroup

Semigroup

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

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
 

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

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 =

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')

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