Add Semigroup instances

This commit is contained in:
Oleg Grenrus 2017-01-19 19:05:01 +02:00
parent dc4b4be42e
commit fdf86b0e15
4 changed files with 24 additions and 4 deletions

View file

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

View file

@ -16,6 +16,7 @@ import Control.Exception
import Control.Monad
import Control.Monad.Catch (MonadThrow, MonadCatch)
import Data.Foldable (toList)
import Data.Semigroup (Semigroup (..))
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Trans.Except
@ -27,7 +28,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 +215,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 Semigroup (ClientM a) where
a <> b = a `catchError` \_ -> b
runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm

View file

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

View file

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