Add bifunctors instances for Servant.API.Alt
These mirror the corresponding instances for (,)
This commit is contained in:
parent
b8f7eb4452
commit
7133e9dad2
2 changed files with 23 additions and 0 deletions
|
@ -84,6 +84,7 @@ library
|
|||
-- Here can be exceptions if we really need features from the newer versions.
|
||||
build-depends:
|
||||
base-compat >= 0.10.4 && < 0.11
|
||||
, bifunctors >= 5.4 && < 5.6
|
||||
, aeson >= 1.3.1.1 && < 1.5
|
||||
, attoparsec >= 0.13.2.2 && < 0.14
|
||||
, case-insensitive >= 1.2.0.11 && < 1.3
|
||||
|
|
|
@ -7,6 +7,15 @@
|
|||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
module Servant.API.Alternative ((:<|>)(..)) where
|
||||
|
||||
import Control.Applicative (liftA2)
|
||||
import Data.Biapplicative
|
||||
(Biapplicative (..))
|
||||
import Data.Bifoldable
|
||||
(Bifoldable (..))
|
||||
import Data.Bifunctor
|
||||
(Bifunctor (..))
|
||||
import Data.Bitraversable
|
||||
(Bitraversable (..))
|
||||
import Data.Semigroup
|
||||
(Semigroup (..))
|
||||
import Data.Typeable
|
||||
|
@ -33,6 +42,19 @@ instance (Monoid a, Monoid b) => Monoid (a :<|> b) where
|
|||
mempty = mempty :<|> mempty
|
||||
(a :<|> b) `mappend` (a' :<|> b') = (a `mappend` a') :<|> (b `mappend` b')
|
||||
|
||||
instance Bifoldable (:<|>) where
|
||||
bifoldMap f g ~(a :<|> b) = f a `mappend` g b
|
||||
|
||||
instance Bifunctor (:<|>) where
|
||||
bimap f g ~(a :<|> b) = f a :<|> g b
|
||||
|
||||
instance Biapplicative (:<|>) where
|
||||
bipure = (:<|>)
|
||||
(f :<|> g) <<*>> (a :<|> b) = f a :<|> g b
|
||||
|
||||
instance Bitraversable (:<|>) where
|
||||
bitraverse f g ~(a :<|> b) = liftA2 (:<|>) (f a) (g b)
|
||||
|
||||
-- $setup
|
||||
-- >>> import Servant.API
|
||||
-- >>> import Data.Aeson
|
||||
|
|
Loading…
Reference in a new issue