Add Semigroup instances
This commit is contained in:
parent
dc4b4be42e
commit
fdf86b0e15
4 changed files with 24 additions and 4 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 =
|
||||
|
|
Loading…
Reference in a new issue