@@ -7,6 +7,15 @@
77{-# OPTIONS_HADDOCK not-home #-}
88module Servant.API.Alternative ((:<|>)(..)) where
99
10+import Control.Applicative (liftA2)
11+import Data.Biapplicative
12+ (Biapplicative (..))
13+import Data.Bifoldable
14+ (Bifoldable (..))
15+import Data.Bifunctor
16+ (Bifunctor (..))
17+import Data.Bitraversable
18+ (Bitraversable (..))
1019import Data.Semigroup
1120 (Semigroup (..))
1221import Data.Typeable
@@ -33,6 +42,19 @@ instance (Monoid a, Monoid b) => Monoid (a :<|> b) where
3342 mempty = mempty :<|> mempty
3443 (a :<|> b) `mappend` (a' :<|> b') = (a `mappend` a') :<|> (b `mappend` b')
3544
45+instance Bifoldable (:<|>) where
46+ bifoldMap f g ~(a :<|> b) = f a `mappend` g b
47+
48+instance Bifunctor (:<|>) where
49+ bimap f g ~(a :<|> b) = f a :<|> g b
50+
51+instance Biapplicative (:<|>) where
52+ bipure = (:<|>)
53+ (f :<|> g) <<*>> (a :<|> b) = f a :<|> g b
54+
55+instance Bitraversable (:<|>) where
56+ bitraverse f g ~(a :<|> b) = liftA2 (:<|>) (f a) (g b)
57+
3658-- $setup
3759-- >>> import Servant.API
3860-- >>> import Data.Aeson