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-base >= 0.4.4 && < 0.5
|
||||||
, transformers-compat >= 0.4 && < 0.6
|
, transformers-compat >= 0.4 && < 0.6
|
||||||
, mtl
|
, mtl
|
||||||
|
if !impl(ghc >= 8.0)
|
||||||
|
build-depends:
|
||||||
|
semigroups >=0.16.2.2 && <0.19
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
|
|
@ -16,6 +16,7 @@ import Control.Exception
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.Catch (MonadThrow, MonadCatch)
|
import Control.Monad.Catch (MonadThrow, MonadCatch)
|
||||||
import Data.Foldable (toList)
|
import Data.Foldable (toList)
|
||||||
|
import Data.Semigroup (Semigroup (..))
|
||||||
|
|
||||||
import Control.Monad.Error.Class (MonadError(..))
|
import Control.Monad.Error.Class (MonadError(..))
|
||||||
import Control.Monad.Trans.Except
|
import Control.Monad.Trans.Except
|
||||||
|
@ -27,7 +28,7 @@ import Control.Monad.Reader
|
||||||
import Control.Monad.Trans.Control (MonadBaseControl (..))
|
import Control.Monad.Trans.Control (MonadBaseControl (..))
|
||||||
import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)
|
import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)
|
||||||
import Data.String
|
import Data.String
|
||||||
import Data.String.Conversions
|
import Data.String.Conversions (cs)
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Text.Encoding
|
import Data.Text.Encoding
|
||||||
|
@ -214,6 +215,10 @@ instance MonadBaseControl IO ClientM where
|
||||||
-- restoreM :: StM ClientM a -> ClientM a
|
-- restoreM :: StM ClientM a -> ClientM a
|
||||||
restoreM st = ClientM (restoreM st)
|
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 :: ClientM a -> ClientEnv -> IO (Either ServantError a)
|
||||||
runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
|
runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
|
||||||
|
|
||||||
|
|
|
@ -33,6 +33,7 @@ library
|
||||||
, Servant.Docs.Internal.Pretty
|
, Servant.Docs.Internal.Pretty
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.7 && <5
|
base >=4.7 && <5
|
||||||
|
, base-compat >= 0.9.1 && <0.10
|
||||||
, aeson
|
, aeson
|
||||||
, aeson-pretty
|
, aeson-pretty
|
||||||
, bytestring
|
, bytestring
|
||||||
|
@ -46,6 +47,9 @@ library
|
||||||
, text
|
, text
|
||||||
, unordered-containers
|
, unordered-containers
|
||||||
, control-monad-omega == 0.3.*
|
, control-monad-omega == 0.3.*
|
||||||
|
if !impl(ghc >= 8.0)
|
||||||
|
build-depends:
|
||||||
|
semigroups >=0.16.2.2 && <0.19
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
|
|
@ -20,6 +20,8 @@
|
||||||
#include "overlapping-compat.h"
|
#include "overlapping-compat.h"
|
||||||
module Servant.Docs.Internal where
|
module Servant.Docs.Internal where
|
||||||
|
|
||||||
|
import Prelude ()
|
||||||
|
import Prelude.Compat
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Arrow (second)
|
import Control.Arrow (second)
|
||||||
import Control.Lens (makeLenses, mapped, over, traversed, view, (%~),
|
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 qualified Data.CaseInsensitive as CI
|
||||||
import Data.Hashable (Hashable)
|
import Data.Hashable (Hashable)
|
||||||
import Data.HashMap.Strict (HashMap)
|
import Data.HashMap.Strict (HashMap)
|
||||||
import Data.List
|
import Data.List.Compat (intercalate, intersperse, sort)
|
||||||
import Data.Maybe
|
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.Ord (comparing)
|
||||||
import Data.Proxy (Proxy(Proxy))
|
import Data.Proxy (Proxy(Proxy))
|
||||||
import Data.String.Conversions (cs)
|
import Data.String.Conversions (cs)
|
||||||
|
@ -102,8 +105,11 @@ data API = API
|
||||||
, _apiEndpoints :: HashMap Endpoint Action
|
, _apiEndpoints :: HashMap Endpoint Action
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
instance Semigroup API where
|
||||||
|
(<>) = mappend
|
||||||
|
|
||||||
instance Monoid API where
|
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
|
mempty = API mempty mempty
|
||||||
|
|
||||||
-- | An empty 'API'
|
-- | An empty 'API'
|
||||||
|
@ -162,6 +168,8 @@ data DocNote = DocNote
|
||||||
-- These are intended to be built using extraInfo.
|
-- These are intended to be built using extraInfo.
|
||||||
-- Multiple ExtraInfo may be combined with the monoid instance.
|
-- Multiple ExtraInfo may be combined with the monoid instance.
|
||||||
newtype ExtraInfo api = ExtraInfo (HashMap Endpoint Action)
|
newtype ExtraInfo api = ExtraInfo (HashMap Endpoint Action)
|
||||||
|
instance Semigroup (ExtraInfo a) where
|
||||||
|
(<>) = mappend
|
||||||
instance Monoid (ExtraInfo a) where
|
instance Monoid (ExtraInfo a) where
|
||||||
mempty = ExtraInfo mempty
|
mempty = ExtraInfo mempty
|
||||||
ExtraInfo a `mappend` ExtraInfo b =
|
ExtraInfo a `mappend` ExtraInfo b =
|
||||||
|
|
Loading…
Reference in a new issue