Add bifunctors instances for Servant.API.Alt

These mirror the corresponding instances for (,)
This commit is contained in:
Nathan van Doorn 2018-09-05 13:15:42 +01:00
parent b8f7eb4452
commit 7133e9dad2
2 changed files with 23 additions and 0 deletions

View file

@ -84,6 +84,7 @@ library
-- Here can be exceptions if we really need features from the newer versions. -- Here can be exceptions if we really need features from the newer versions.
build-depends: build-depends:
base-compat >= 0.10.4 && < 0.11 base-compat >= 0.10.4 && < 0.11
, bifunctors >= 5.4 && < 5.6
, aeson >= 1.3.1.1 && < 1.5 , aeson >= 1.3.1.1 && < 1.5
, attoparsec >= 0.13.2.2 && < 0.14 , attoparsec >= 0.13.2.2 && < 0.14
, case-insensitive >= 1.2.0.11 && < 1.3 , case-insensitive >= 1.2.0.11 && < 1.3

View file

@ -7,6 +7,15 @@
{-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_HADDOCK not-home #-}
module Servant.API.Alternative ((:<|>)(..)) where 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 import Data.Semigroup
(Semigroup (..)) (Semigroup (..))
import Data.Typeable import Data.Typeable
@ -33,6 +42,19 @@ instance (Monoid a, Monoid b) => Monoid (a :<|> b) where
mempty = mempty :<|> mempty mempty = mempty :<|> mempty
(a :<|> b) `mappend` (a' :<|> b') = (a `mappend` a') :<|> (b `mappend` b') (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 -- $setup
-- >>> import Servant.API -- >>> import Servant.API
-- >>> import Data.Aeson -- >>> import Data.Aeson