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

View file

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