diff --git a/bifunctors.cabal b/bifunctors.cabal
--- a/bifunctors.cabal
+++ b/bifunctors.cabal
@@ -1,6 +1,6 @@
 name:          bifunctors
 category:      Data, Functors
-version:       3.0.4
+version:       3.1
 license:       BSD3
 cabal-version: >= 1.6
 license-file:  LICENSE
@@ -24,12 +24,16 @@
   build-depends:
     base          == 4.*,
     semigroups    >= 0.8.3.1,
-    semigroupoids >= 3.0
+    semigroupoids == 3.*,
+    tagged        >= 0.4.4 && < 1
 
   exposed-modules:
+    Data.Biapplicative
     Data.Bifunctor
     Data.Bifunctor.Apply
+    Data.Bifunctor.Clown
     Data.Bifunctor.Flip
+    Data.Bifunctor.Joker
     Data.Bifunctor.Wrapped
     Data.Bifoldable
     Data.Bitraversable
diff --git a/src/Data/Biapplicative.hs b/src/Data/Biapplicative.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Biapplicative.hs
@@ -0,0 +1,81 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Bifunctor.Apply
+-- Copyright   :  (C) 2011-2013 Edward Kmett,
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+----------------------------------------------------------------------------
+module Data.Biapplicative (
+  -- * Biapplicative bifunctors
+    Biapplicative(..)
+  , (<<$>>)
+  , (<<**>>)
+  , biliftA2
+  , biliftA3
+  , module Data.Bifunctor
+  ) where
+
+import Control.Applicative
+import Data.Bifunctor
+import Data.Bifunctor.Apply ((<<$>>))
+import Data.Tagged
+
+infixl 4 <<*>>, <<*, *>>, <<**>>
+
+class Bifunctor p => Biapplicative p where
+  bipure :: a -> b -> p a b
+
+  (<<*>>) :: p (a -> b) (c -> d) -> p a c -> p b d
+
+  -- |
+  -- @
+  -- a '*>' b ≡ 'const' 'id' '<$>' a '<*>' b
+  -- @
+  (*>>) :: p a b -> p c d -> p c d
+  a *>> b = bimap (const id) (const id) <<$>> a <<*>> b
+  {-# INLINE (*>>) #-}
+
+  -- |
+  -- @
+  -- a '<*' b ≡ 'const' '<$>' a '<.>' b
+  -- @
+  (<<*) :: p a b -> p c d -> p a b
+  a <<* b = bimap const const <<$>> a <<*>> b
+  {-# INLINE (<<*) #-}
+
+(<<**>>) :: Biapplicative p => p a c -> p (a -> b) (c -> d) -> p b d
+(<<**>>) = biliftA2 (flip id) (flip id)
+{-# INLINE (<<**>>) #-}
+
+-- | Lift binary functions
+biliftA2 :: Biapplicative w => (a -> b -> c) -> (d -> e -> f) -> w a d -> w b e -> w c f
+biliftA2 f g a b = bimap f g <<$>> a <<*>> b
+{-# INLINE biliftA2 #-}
+
+-- | Lift ternary functions
+biliftA3 :: Biapplicative w => (a -> b -> c -> d) -> (e -> f -> g -> h) -> w a e -> w b f -> w c g -> w d h
+biliftA3 f g a b c = bimap f g <<$>> a <<*>> b <<*>> c
+{-# INLINE biliftA3 #-}
+
+instance Biapplicative (,) where
+  bipure = (,)
+  {-# INLINE bipure #-}
+  (f, g) <<*>> (a, b) = (f a, g b)
+  {-# INLINE (<<*>>) #-}
+
+instance Biapplicative Tagged where
+  bipure _ b = Tagged b
+  {-# INLINE bipure #-}
+
+  Tagged f <<*>> Tagged x = Tagged (f x)
+  {-# INLINE (<<*>>) #-}
+
+instance Biapplicative Const where
+  bipure a _ = Const a
+  {-# INLINE bipure #-}
+  Const f <<*>> Const x = Const (f x)
+  {-# INLINE (<<*>>) #-}
diff --git a/src/Data/Bifoldable.hs b/src/Data/Bifoldable.hs
--- a/src/Data/Bifoldable.hs
+++ b/src/Data/Bifoldable.hs
@@ -30,6 +30,7 @@
 
 import Control.Applicative
 import Data.Monoid
+import Data.Tagged
 
 class Bifoldable p where
   bifold :: Monoid m => p m m -> m
@@ -50,6 +51,26 @@
 
 instance Bifoldable (,) where
   bifoldMap f g ~(a, b) = f a `mappend` g b
+  {-# INLINE bifoldMap #-}
+
+instance Bifoldable Const where
+  bifoldMap f _ (Const a) = f a
+  {-# INLINE bifoldMap #-}
+
+instance Bifoldable ((,,) x) where
+  bifoldMap f g ~(_,a,b) = f a `mappend` g b
+  {-# INLINE bifoldMap #-}
+
+instance Bifoldable ((,,,) x y) where
+  bifoldMap f g ~(_,_,a,b) = f a `mappend` g b
+  {-# INLINE bifoldMap #-}
+
+instance Bifoldable ((,,,,) x y z) where
+  bifoldMap f g ~(_,_,_,a,b) = f a `mappend` g b
+  {-# INLINE bifoldMap #-}
+
+instance Bifoldable Tagged where
+  bifoldMap _ g (Tagged b) = g b
   {-# INLINE bifoldMap #-}
 
 instance Bifoldable Either where
diff --git a/src/Data/Bifunctor.hs b/src/Data/Bifunctor.hs
--- a/src/Data/Bifunctor.hs
+++ b/src/Data/Bifunctor.hs
@@ -14,6 +14,7 @@
   ) where
 
 import Control.Applicative
+import Data.Tagged
 
 -- | Minimal definition either 'bimap' or 'first' and 'second'
 
@@ -92,4 +93,8 @@
 
 instance Bifunctor Const where
   bimap f _ (Const a) = Const (f a)
+  {-# INLINE bimap #-}
+
+instance Bifunctor Tagged where
+  bimap _ g (Tagged b) = Tagged (g b)
   {-# INLINE bimap #-}
diff --git a/src/Data/Bifunctor/Apply.hs b/src/Data/Bifunctor/Apply.hs
--- a/src/Data/Bifunctor/Apply.hs
+++ b/src/Data/Bifunctor/Apply.hs
@@ -19,7 +19,10 @@
   , module Data.Bifunctor
   ) where
 
+import Control.Applicative
 import Data.Bifunctor
+import Data.Semigroup
+import Data.Tagged
 
 infixl 4 <<$>>, <<.>>, <<., .>>, <<..>>
 
@@ -62,4 +65,17 @@
 
 instance Biapply (,) where
   (f, g) <<.>> (a, b) = (f a, g b)
+  {-# INLINE (<<.>>) #-}
+
+instance Semigroup s => Biapply ((,,) s) where
+  (s,f,g) <<.>> (t,a,b) = (s <> t, f a, g b)
+  {-# INLINE (<<.>>) #-}
+
+instance Biapply Const where
+  Const f <<.>> Const x = Const (f x)
+  {-# INLINE (<<.>>) #-}
+
+
+instance Biapply Tagged where
+  Tagged f <<.>> Tagged x = Tagged (f x)
   {-# INLINE (<<.>>) #-}
diff --git a/src/Data/Bifunctor/Clown.hs b/src/Data/Bifunctor/Clown.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Bifunctor/Clown.hs
@@ -0,0 +1,81 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Bifunctor.Clown
+-- Copyright   :  (C) 2008-2013 Edward Kmett,
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- From the Functional Pearl \"Clowns to the Left of me, Jokers to the Right: Dissecting Data Structures\"
+-- by Conor McBride.
+----------------------------------------------------------------------------
+module Data.Bifunctor.Clown
+  ( Clown(..)
+  ) where
+
+import Control.Applicative
+import Data.Biapplicative
+import Data.Bifunctor.Apply
+import Data.Bifoldable
+import Data.Bitraversable
+import Data.Foldable
+import Data.Functor.Apply
+import Data.Monoid
+import Data.Semigroup.Bifoldable
+import Data.Semigroup.Bitraversable
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+import Data.Traversable
+
+-- | Make a 'Functor' over the first argument of a 'Bifunctor'.
+newtype Clown f a b = Clown { runClown :: f a }
+  deriving (Eq,Ord,Show,Read)
+
+instance Functor f => Bifunctor (Clown f) where
+  first f = Clown . fmap f . runClown
+  {-# INLINE first #-}
+  second _ = Clown . runClown
+  {-# INLINE second #-}
+  bimap f _ = Clown . fmap f . runClown
+  {-# INLINE bimap #-}
+
+instance Functor (Clown f a) where
+  fmap _ = Clown . runClown
+  {-# INLINE fmap #-}
+
+instance Applicative f => Biapplicative (Clown f) where
+  bipure a _ = Clown (pure a)
+  {-# INLINE bipure #-}
+
+  Clown mf <<*>> Clown mx = Clown (mf <*> mx)
+  {-# INLINE (<<*>>) #-}
+
+instance Apply f => Biapply (Clown f) where
+  Clown fg <<.>> Clown xy = Clown (fg <.> xy)
+  {-# INLINE (<<.>>) #-}
+
+instance Foldable f => Bifoldable (Clown f) where
+  bifoldMap f _ = foldMap f . runClown
+  {-# INLINE bifoldMap #-}
+
+instance Foldable (Clown f a) where
+  foldMap _ = mempty
+  {-# INLINE foldMap #-}
+
+instance Traversable f => Bitraversable (Clown f) where
+  bitraverse f _ = fmap Clown . traverse f . runClown
+  {-# INLINE bitraverse #-}
+
+instance Traversable (Clown f a) where
+  traverse _ = pure . Clown . runClown
+  {-# INLINE traverse #-}
+
+instance Foldable1 f => Bifoldable1 (Clown f) where
+  bifoldMap1 f _ = foldMap1 f . runClown
+  {-# INLINE bifoldMap1 #-}
+
+instance Traversable1 f => Bitraversable1 (Clown f) where
+  bitraverse1 f _ = fmap Clown . traverse1 f . runClown
+  {-# INLINE bitraverse1 #-}
diff --git a/src/Data/Bifunctor/Flip.hs b/src/Data/Bifunctor/Flip.hs
--- a/src/Data/Bifunctor/Flip.hs
+++ b/src/Data/Bifunctor/Flip.hs
@@ -14,7 +14,7 @@
   ) where
 
 import Control.Applicative
-import Data.Bifunctor
+import Data.Biapplicative
 import Data.Bifunctor.Apply
 import Data.Bifoldable
 import Data.Bitraversable
@@ -39,6 +39,13 @@
 instance Bifunctor p => Functor (Flip p a) where
   fmap f = Flip . first f . runFlip
   {-# INLINE fmap #-}
+
+instance Biapplicative p => Biapplicative (Flip p) where
+  bipure a b = Flip (bipure b a)
+  {-# INLINE bipure #-}
+
+  Flip fg <<*>> Flip xy = Flip (fg <<*>> xy)
+  {-# INLINE (<<*>>) #-}
 
 instance Biapply p => Biapply (Flip p) where
   Flip fg <<.>> Flip xy = Flip (fg <<.>> xy)
diff --git a/src/Data/Bifunctor/Joker.hs b/src/Data/Bifunctor/Joker.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Bifunctor/Joker.hs
@@ -0,0 +1,88 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Bifunctor.Joker
+-- Copyright   :  (C) 2008-2013 Edward Kmett,
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- From the Functional Pearl \"Clowns to the Left of me, Jokers to the Right: Dissecting Data Structures\"
+-- by Conor McBride.
+----------------------------------------------------------------------------
+module Data.Bifunctor.Joker
+  ( Joker(..)
+  ) where
+
+import Control.Applicative
+import Data.Biapplicative
+import Data.Bifunctor.Apply
+import Data.Bifoldable
+import Data.Bitraversable
+import Data.Foldable
+import Data.Functor.Apply
+import Data.Semigroup.Bifoldable
+import Data.Semigroup.Bitraversable
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+import Data.Traversable
+
+-- | Make a 'Functor' over the first argument of a 'Bifunctor'.
+newtype Joker g a b = Joker { runJoker :: g b }
+  deriving (Eq,Ord,Show,Read)
+
+instance Functor g => Bifunctor (Joker g) where
+  first _ = Joker . runJoker
+  {-# INLINE first #-}
+  second g = Joker . fmap g . runJoker
+  {-# INLINE second #-}
+  bimap _ g = Joker . fmap g . runJoker
+  {-# INLINE bimap #-}
+
+instance Functor g => Functor (Joker g a) where
+  fmap g = Joker . fmap g . runJoker
+  {-# INLINE fmap #-}
+
+instance Applicative g => Biapplicative (Joker g) where
+  bipure _ b = Joker (pure b)
+  {-# INLINE bipure #-}
+
+  Joker mf <<*>> Joker mx = Joker (mf <*> mx)
+  {-# INLINE (<<*>>) #-}
+
+instance Apply g => Biapply (Joker g) where
+  Joker fg <<.>> Joker xy = Joker (fg <.> xy)
+  {-# INLINE (<<.>>) #-}
+
+instance Foldable g => Bifoldable (Joker g) where
+  bifoldMap _ g = foldMap g . runJoker
+  {-# INLINE bifoldMap #-}
+
+instance Foldable g => Foldable (Joker g a) where
+  foldMap g = foldMap g . runJoker
+  {-# INLINE foldMap #-}
+
+instance Traversable g => Bitraversable (Joker g) where
+  bitraverse _ g = fmap Joker . traverse g . runJoker
+  {-# INLINE bitraverse #-}
+
+instance Traversable g => Traversable (Joker g a) where
+  traverse g = fmap Joker . traverse g . runJoker
+  {-# INLINE traverse #-}
+
+instance Foldable1 g => Bifoldable1 (Joker g) where
+  bifoldMap1 _ g = foldMap1 g . runJoker
+  {-# INLINE bifoldMap1 #-}
+
+instance Foldable1 g => Foldable1 (Joker g a) where
+  foldMap1 g = foldMap1 g . runJoker
+  {-# INLINE foldMap1 #-}
+
+instance Traversable1 g => Bitraversable1 (Joker g) where
+  bitraverse1 _ g = fmap Joker . traverse1 g . runJoker
+  {-# INLINE bitraverse1 #-}
+
+instance Traversable1 g => Traversable1 (Joker g a) where
+  traverse1 g = fmap Joker . traverse1 g . runJoker
+  {-# INLINE traverse1 #-}
diff --git a/src/Data/Bifunctor/Wrapped.hs b/src/Data/Bifunctor/Wrapped.hs
--- a/src/Data/Bifunctor/Wrapped.hs
+++ b/src/Data/Bifunctor/Wrapped.hs
@@ -14,8 +14,8 @@
   ) where
 
 import Control.Applicative
+import Data.Biapplicative
 import Data.Bifoldable
-import Data.Bifunctor
 import Data.Bifunctor.Apply
 import Data.Bitraversable
 import Data.Foldable
@@ -42,6 +42,13 @@
 
 instance Biapply p => Biapply (WrappedBifunctor p) where
   WrapBifunctor fg <<.>> WrapBifunctor xy = WrapBifunctor (fg <<.>> xy)
+  {-# INLINE (<<.>>) #-}
+
+instance Biapplicative p => Biapplicative (WrappedBifunctor p) where
+  bipure a b = WrapBifunctor (bipure a b)
+  {-# INLINE bipure #-}
+  WrapBifunctor fg <<*>> WrapBifunctor xy = WrapBifunctor (fg <<*>> xy)
+  {-# INLINE (<<*>>) #-}
 
 instance Bifoldable p => Foldable (WrappedBifunctor p a) where
   foldMap f = bifoldMap (const mempty) f . unwrapBifunctor
diff --git a/src/Data/Bitraversable.hs b/src/Data/Bitraversable.hs
--- a/src/Data/Bitraversable.hs
+++ b/src/Data/Bitraversable.hs
@@ -20,9 +20,10 @@
   ) where
 
 import Control.Applicative
-import Data.Monoid
 import Data.Bifunctor
 import Data.Bifoldable
+import Data.Monoid
+import Data.Tagged
 
 class (Bifunctor t, Bifoldable t) => Bitraversable t where
   bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
@@ -45,11 +46,31 @@
   bitraverse f g ~(a, b) = (,) <$> f a <*> g b
   {-# INLINE bitraverse #-}
 
+instance Bitraversable ((,,) x) where
+  bitraverse f g ~(x, a, b) = (,,) x <$> f a <*> g b
+  {-# INLINE bitraverse #-}
+
+instance Bitraversable ((,,,) x y) where
+  bitraverse f g ~(x, y, a, b) = (,,,) x y <$> f a <*> g b
+  {-# INLINE bitraverse #-}
+
+instance Bitraversable ((,,,,) x y z) where
+  bitraverse f g ~(x, y, z, a, b) = (,,,,) x y z <$> f a <*> g b
+  {-# INLINE bitraverse #-}
+
 instance Bitraversable Either where
   bitraverse f _ (Left a) = Left <$> f a
   bitraverse _ g (Right b) = Right <$> g b
   {-# INLINE bitraverse #-}
 
+instance Bitraversable Const where
+  bitraverse f _ (Const a) = Const <$> f a
+  {-# INLINE bitraverse #-}
+
+instance Bitraversable Tagged where
+  bitraverse _ g (Tagged b) = Tagged <$> g b
+  {-# INLINE bitraverse #-}
+
 bifor :: (Bitraversable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)
 bifor t f g = bitraverse f g t
 {-# INLINE bifor #-}
@@ -58,8 +79,7 @@
 biforM t f g = bimapM f g t
 {-# INLINE biforM #-}
 
-
--- left-to-right state transformer
+-- | left-to-right state transformer
 newtype StateL s a = StateL { runStateL :: s -> (s, a) }
 
 instance Functor (StateL s) where
@@ -80,7 +100,7 @@
 bimapAccumL f g s t = runStateL (bitraverse (StateL . flip f) (StateL . flip g) t) s
 {-# INLINE bimapAccumL #-}
 
--- right-to-left state transformer
+-- | right-to-left state transformer
 newtype StateR s a = StateR { runStateR :: s -> (s, a) }
 
 instance Functor (StateR s) where
diff --git a/src/Data/Semigroup/Bifoldable.hs b/src/Data/Semigroup/Bifoldable.hs
--- a/src/Data/Semigroup/Bifoldable.hs
+++ b/src/Data/Semigroup/Bifoldable.hs
@@ -17,44 +17,74 @@
   , bifoldMapDefault1
   ) where
 
-import Prelude hiding (foldr)
+import Control.Applicative
 import Data.Bifoldable
 import Data.Functor.Apply
 import Data.Semigroup
+import Data.Tagged
+import Prelude hiding (foldr)
 
 class Bifoldable t => Bifoldable1 t where
   bifold1 :: Semigroup m => t m m -> m
   bifold1 = bifoldMap1 id id
+  {-# INLINE bifold1 #-}
 
   bifoldMap1 :: Semigroup m => (a -> m) -> (b -> m) -> t a b -> m
   bifoldMap1 f g = maybe (error "bifoldMap1") id . getOption . bifoldMap (Option . Just . f) (Option . Just . g)
+  {-# INLINE bifoldMap1 #-}
 
 instance Bifoldable1 Either where
   bifoldMap1 f _ (Left a) = f a
   bifoldMap1 _ g (Right b) = g b
+  {-# INLINE bifoldMap1 #-}
 
 instance Bifoldable1 (,) where
   bifoldMap1 f g (a, b) = f a <> g b
+  {-# INLINE bifoldMap1 #-}
 
+instance Bifoldable1 ((,,) x) where
+  bifoldMap1 f g (_,a,b) = f a <> g b
+  {-# INLINE bifoldMap1 #-}
+
+instance Bifoldable1 ((,,,) x y) where
+  bifoldMap1 f g (_,_,a,b) = f a <> g b
+  {-# INLINE bifoldMap1 #-}
+
+instance Bifoldable1 ((,,,,) x y z) where
+  bifoldMap1 f g (_,_,_,a,b) = f a <> g b
+  {-# INLINE bifoldMap1 #-}
+
+instance Bifoldable1 Const where
+  bifoldMap1 f _ (Const a) = f a
+  {-# INLINE bifoldMap1 #-}
+
+instance Bifoldable1 Tagged where
+  bifoldMap1 _ g (Tagged b) = g b
+  {-# INLINE bifoldMap1 #-}
+
 newtype Act f a = Act { getAct :: f a }
 
 instance Apply f => Semigroup (Act f a) where
   Act a <> Act b = Act (a .> b)
+  {-# INLINE (<>) #-}
 
 instance Functor f => Functor (Act f) where
   fmap f (Act a) = Act (f <$> a)
+  {-# INLINE fmap #-}
   b <$ Act a = Act (b <$ a)
+  {-# INLINE (<$) #-}
 
 bitraverse1_ :: (Bifoldable1 t, Apply f) => (a -> f b) -> (c -> f d) -> t a c -> f ()
 bitraverse1_ f g t = getAct (bifoldMap1 (Act . ignore . f) (Act . ignore . g) t)
 {-# INLINE bitraverse1_ #-}
 
 bifor1_ :: (Bifoldable1 t, Apply f) => t a c -> (a -> f b) -> (c -> f d) -> f ()
-bifor1_ t f g = bitraverse1_ f g t 
+bifor1_ t f g = bitraverse1_ f g t
 {-# INLINE bifor1_ #-}
 
 ignore :: Functor f => f a -> f ()
 ignore = (() <$)
+{-# INLINE ignore #-}
 
 bisequenceA1_ :: (Bifoldable1 t, Apply f) => t (f a) (f b) -> f ()
 bisequenceA1_ t = getAct (bifoldMap1 (Act . ignore) (Act . ignore) t)
@@ -64,4 +94,3 @@
 bifoldMapDefault1 :: (Bifoldable1 t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m
 bifoldMapDefault1 f g = unwrapMonoid . bifoldMap (WrapMonoid . f) (WrapMonoid . g)
 {-# INLINE bifoldMapDefault1 #-}
-
diff --git a/src/Data/Semigroup/Bitraversable.hs b/src/Data/Semigroup/Bitraversable.hs
--- a/src/Data/Semigroup/Bitraversable.hs
+++ b/src/Data/Semigroup/Bitraversable.hs
@@ -15,25 +15,51 @@
   ) where
 
 import Control.Applicative
-import Data.Functor.Apply
-import Data.Semigroup.Bifoldable
 import Data.Bitraversable
 import Data.Bifunctor
+import Data.Functor.Apply
 import Data.Semigroup
+import Data.Semigroup.Bifoldable
+import Data.Tagged
 
 class (Bifoldable1 t, Bitraversable t) => Bitraversable1 t where
   bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> t a c -> f (t b d)
   bitraverse1 f g  = bisequence1 . bimap f g
+  {-# INLINE bitraverse1 #-}
 
   bisequence1 :: Apply f => t (f a) (f b) -> f (t a b)
   bisequence1 = bitraverse1 id id
+  {-# INLINE bisequence1 #-}
 
 bifoldMap1Default :: (Bitraversable1 t, Semigroup m) => (a -> m) -> (b -> m) -> t a b -> m
 bifoldMap1Default f g = getConst . bitraverse1 (Const . f) (Const . g)
+{-# INLINE bifoldMap1Default #-}
 
 instance Bitraversable1 Either where
   bitraverse1 f _ (Left a) = Left <$> f a
   bitraverse1 _ g (Right b) = Right <$> g b
+  {-# INLINE bitraverse1 #-}
 
 instance Bitraversable1 (,) where
   bitraverse1 f g (a, b) = (,) <$> f a <.> g b
+  {-# INLINE bitraverse1 #-}
+
+instance Bitraversable1 ((,,) x) where
+  bitraverse1 f g (x, a, b) = (,,) x <$> f a <.> g b
+  {-# INLINE bitraverse1 #-}
+
+instance Bitraversable1 ((,,,) x y) where
+  bitraverse1 f g (x, y, a, b) = (,,,) x y <$> f a <.> g b
+  {-# INLINE bitraverse1 #-}
+
+instance Bitraversable1 ((,,,,) x y z) where
+  bitraverse1 f g (x, y, z, a, b) = (,,,,) x y z <$> f a <.> g b
+  {-# INLINE bitraverse1 #-}
+
+instance Bitraversable1 Const where
+  bitraverse1 f _ (Const a) = Const <$> f a
+  {-# INLINE bitraverse1 #-}
+
+instance Bitraversable1 Tagged where
+  bitraverse1 _ g (Tagged b) = Tagged <$> g b
+  {-# INLINE bitraverse1 #-}