Merge pull request #1032 from Taneb/master

Add bifunctors instances for Servant.API.Alt

servant/servant.cabal

@@ -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.5.3    && < 5.6
     , aeson                  >= 1.3.1.1  && < 1.5
     , attoparsec             >= 0.13.2.2 && < 0.14
     , case-insensitive       >= 1.2.0.11 && < 1.3

servant/src/Servant/API/Alternative.hs

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