diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,10 @@
+0.0.4
+
+* Add Data.BiId module with BiId p s t a b newtype and full instance coverage
+* Add INLINE pragmas to all functions and instance methods in Data.Id and Data.BiId
+* Add SPECIALIZE pragmas on identity isos for common concrete types ((,), Either, (->))
+* Add Comonad instance for Id
+
 0.0.3
 
 * Add __Unwrapped iso (dual of __Wrapped) with specializations for all type aliases
diff --git a/id.cabal b/id.cabal
--- a/id.cabal
+++ b/id.cabal
@@ -1,6 +1,6 @@
 cabal-version:        2.4
 name:                 id
-version:              0.0.3
+version:              0.0.4
 synopsis:             Id (f a) data type
 description:          (f a) data type, with optics and functions for switching the type constructor (f)
 license:              BSD-3-Clause
@@ -21,11 +21,18 @@
 
 library
   exposed-modules:    Data.Id
+                    , Data.BiId
 
-  build-depends:        base >= 4.8 && < 6
+  build-depends:        base >= 4.18 && < 6
+                      , bifunctors >= 5 && < 6
+                      , comonad >= 5 && < 6
                       , contravariant >= 1.4 && < 2
+                      , deepseq >= 1.4 && < 2
+                      , distributive >= 0.5 && < 1
+                      , hashable >= 1.3 && < 2
                       , lens >= 4 && < 6
                       , mtl >= 2.2 && < 3
+                      , profunctors >= 5 && < 6
                       , semigroupoids >= 6 && < 7
                       , tagged >= 0.8 && < 1
                       , selective >= 0.7 && < 1
@@ -36,6 +43,14 @@
   default-language:   Haskell2010
 
   ghc-options:        -Wall
+
+  if flag(dev)
+    ghc-options:      -Werror
+
+flag dev
+  description:        Enable -Werror for development
+  manual:             True
+  default:            False
 
 test-suite doctest
   type:               exitcode-stdio-1.0
diff --git a/src/Data/BiId.hs b/src/Data/BiId.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/BiId.hs
@@ -0,0 +1,760 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- |
+-- @BiId p s t a b@ — a newtype around @p (s a) (t b)@, with optics and instances
+-- for switching the type constructors @p@, @s@, and @t@.
+module Data.BiId
+  ( -- * BiId data type
+    BiId (..),
+
+    -- * Optics
+    __Wrapped,
+    identityBifunctor,
+    identityProfunctor,
+    identityProfunctorBifunctor,
+    identityBifunctorProfunctor,
+
+    -- * Type aliases
+    BiIdIdentity,
+    Product,
+    Coproduct,
+    Exponential,
+  )
+where
+
+import Control.Applicative (Alternative (empty, (<|>)))
+import Control.Comonad (Comonad (..))
+import Control.Lens
+  ( FoldableWithIndex (..),
+    FunctorWithIndex (..),
+    Iso,
+    Rewrapped,
+    TraversableWithIndex (..),
+    Wrapped (..),
+    iso,
+  )
+import Control.Monad (MonadPlus (..), join)
+import Control.Monad.Cont (MonadCont (..))
+import Control.Monad.Error.Class (MonadError (..))
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.RWS.Class (MonadRWS)
+import Control.Monad.Reader.Class (MonadReader (..))
+import Control.Monad.State.Class (MonadState (..))
+import Control.Monad.Writer (MonadWriter (..))
+import Control.Monad.Zip (MonadZip (..))
+import Control.Selective (Selective (..))
+import Data.Biapplicative (Biapplicative (..))
+import Data.Bifoldable (Bifoldable (..))
+import Data.Bifunctor (Bifunctor (..))
+import Data.Bitraversable (Bitraversable (..))
+import Data.Data (Data)
+import Data.Distributive (Distributive (..))
+import Data.Functor.Alt (Alt ((<!>)))
+import Data.Functor.Apply (Apply ((<.>), liftF2))
+import Data.Functor.Bind (Bind ((>>-)))
+import Data.Functor.Classes
+  ( Eq1 (..),
+    Eq2 (..),
+    Ord1 (..),
+    Ord2 (..),
+    Show1 (..),
+    Show2 (..),
+  )
+import Data.Functor.Contravariant (Contravariant (..))
+import Data.Functor.Contravariant.Divisible (Decidable (..), Divisible (..))
+import Data.Functor.Extend (Extend (..))
+import Data.Functor.Identity
+import Data.Functor.Plus (Plus (..))
+import Data.Profunctor (Profunctor (..))
+import Data.Profunctor.Choice (Choice (..), Cochoice (..))
+import Data.Profunctor.Closed (Closed (..))
+import Data.Profunctor.Strong (Costrong (..), Strong (..))
+import Data.Semigroup.Bifoldable (Bifoldable1 (..))
+import Data.Semigroup.Bitraversable (Bitraversable1 (..))
+import Data.Semigroup.Foldable (Foldable1 (..))
+import Data.Semigroup.Traversable (Traversable1 (..))
+import GHC.Generics (Generic, Generic1)
+
+-- $setup
+-- >>> import Control.Lens (view, over, from)
+-- >>> import Data.Functor.Identity (Identity(..), runIdentity)
+-- >>> import Data.Semigroup (Sum(..))
+-- >>> import Data.Tagged (Tagged(..))
+
+-- |
+-- >>> BiId ([1,2,3], Identity True)
+-- BiId ([1,2,3],Identity True)
+--
+-- >>> BiId ([1,2,3], Identity True) == BiId ([1,2,3], Identity True)
+-- True
+--
+-- >>> BiId ([1,2,3], Identity True) == BiId ([4,5], Identity False)
+-- False
+--
+-- >>> compare (BiId ([1], Identity True)) (BiId ([2], Identity False))
+-- LT
+newtype BiId p s t a b = BiId (p (s a) (t b))
+  deriving (Eq, Ord, Show, Data, Generic, Generic1)
+
+-- |
+-- >>> BiId ([1,2], [True, False]) :: Product [] [] Int Bool
+-- BiId ([1,2],[True,False])
+type Product s t a b = BiId (,) s t a b
+
+-- |
+-- >>> BiId (Left [1,2]) :: Coproduct [] [] Int Bool
+-- BiId (Left [1,2])
+type Coproduct s t a b = BiId Either s t a b
+
+-- |
+-- >>> (\(BiId f) -> f [1,2,3]) (BiId (fmap (+1)) :: Exponential [] [] Int Int)
+-- [2,3,4]
+type Exponential s t a b = BiId (->) s t a b
+
+type BiIdIdentity p a b = BiId p Identity Identity a b
+
+-- |
+-- >>> view identityBifunctor (BiId (Identity 3, Identity True) :: BiIdIdentity (,) Int Bool)
+-- (3,True)
+--
+-- >>> view (from identityBifunctor) (3, True) :: BiIdIdentity (,) Int Bool
+-- BiId (Identity 3,Identity True)
+identityBifunctor ::
+  (Bifunctor p, Bifunctor p') =>
+  Iso
+    (BiIdIdentity p a b)
+    (BiIdIdentity p' a' b')
+    (p a b)
+    (p' a' b')
+identityBifunctor =
+  iso
+    (\(BiId x) -> bimap runIdentity runIdentity x)
+    (BiId . bimap Identity Identity)
+{-# INLINE identityBifunctor #-}
+{-# SPECIALIZE identityBifunctor :: Iso (BiIdIdentity (,) a b) (BiIdIdentity (,) a' b') ((,) a b) ((,) a' b') #-}
+{-# SPECIALIZE identityBifunctor :: Iso (BiIdIdentity Either a b) (BiIdIdentity Either a' b') (Either a b) (Either a' b') #-}
+{-# SPECIALIZE identityBifunctor :: Iso (BiIdIdentity (,) a b) (BiIdIdentity Either a' b') ((,) a b) (Either a' b') #-}
+{-# SPECIALIZE identityBifunctor :: Iso (BiIdIdentity Either a b) (BiIdIdentity (,) a' b') (Either a b) ((,) a' b') #-}
+
+-- |
+-- >>> view identityProfunctor (BiId (Tagged (Identity True)) :: BiIdIdentity Tagged Int Bool)
+-- Tagged True
+--
+-- >>> view (from identityProfunctor) (Tagged True) :: BiIdIdentity Tagged Int Bool
+-- BiId (Tagged (Identity True))
+identityProfunctor ::
+  (Profunctor p, Profunctor p') =>
+  Iso
+    (BiIdIdentity p a b)
+    (BiIdIdentity p' a' b')
+    (p a b)
+    (p' a' b')
+identityProfunctor =
+  iso
+    (\(BiId x) -> dimap Identity runIdentity x)
+    (BiId . dimap runIdentity Identity)
+{-# INLINE identityProfunctor #-}
+{-# SPECIALIZE identityProfunctor :: Iso (BiIdIdentity (->) a b) (BiIdIdentity (->) a' b') ((->) a b) ((->) a' b') #-}
+
+-- |
+-- >>> view identityProfunctorBifunctor (BiId (Tagged (Identity True)) :: BiIdIdentity Tagged Int Bool) :: Tagged Int Bool
+-- Tagged True
+identityProfunctorBifunctor ::
+  (Profunctor p, Bifunctor p') =>
+  Iso
+    (BiIdIdentity p a b)
+    (BiIdIdentity p' a' b')
+    (p a b)
+    (p' a' b')
+identityProfunctorBifunctor =
+  iso
+    (\(BiId x) -> dimap Identity runIdentity x)
+    (BiId . bimap Identity Identity)
+{-# INLINE identityProfunctorBifunctor #-}
+{-# SPECIALIZE identityProfunctorBifunctor :: Iso (BiIdIdentity (->) a b) (BiIdIdentity (,) a' b') ((->) a b) ((,) a' b') #-}
+{-# SPECIALIZE identityProfunctorBifunctor :: Iso (BiIdIdentity (->) a b) (BiIdIdentity Either a' b') ((->) a b) (Either a' b') #-}
+
+-- |
+-- >>> view identityBifunctorProfunctor (BiId (Tagged (Identity True)) :: BiIdIdentity Tagged Int Bool) :: Tagged Int Bool
+-- Tagged True
+identityBifunctorProfunctor ::
+  (Bifunctor p, Profunctor p') =>
+  Iso
+    (BiIdIdentity p a b)
+    (BiIdIdentity p' a' b')
+    (p a b)
+    (p' a' b')
+identityBifunctorProfunctor =
+  iso
+    (\(BiId x) -> bimap runIdentity runIdentity x)
+    (BiId . dimap runIdentity Identity)
+{-# INLINE identityBifunctorProfunctor #-}
+{-# SPECIALIZE identityBifunctorProfunctor :: Iso (BiIdIdentity (,) a b) (BiIdIdentity (->) a' b') ((,) a b) ((->) a' b') #-}
+{-# SPECIALIZE identityBifunctorProfunctor :: Iso (BiIdIdentity Either a b) (BiIdIdentity (->) a' b') (Either a b) ((->) a' b') #-}
+
+instance
+  (BiId p s t a b ~ x) =>
+  Rewrapped (BiId p s' t' a' b') x
+
+-- |
+-- >>> view _Wrapped' (BiId ([1,2,3], Identity True))
+-- ([1,2,3],Identity True)
+instance Wrapped (BiId p s t a b) where
+  type
+    Unwrapped (BiId p s t a b) =
+      p (s a) (t b)
+  _Wrapped' =
+    iso (\(BiId x) -> x) BiId
+  {-# INLINE _Wrapped' #-}
+
+-- |
+-- >>> view __Wrapped (BiId ([1,2,3], Identity True))
+-- ([1,2,3],Identity True)
+--
+-- >>> view (from __Wrapped) ([1,2,3], Identity True) :: BiId (,) [] Identity Int Bool
+-- BiId ([1,2,3],Identity True)
+--
+-- >>> over __Wrapped (\(xs, Identity b) -> (fmap (+1) xs, Identity (not b))) (BiId ([1,2,3], Identity True))
+-- BiId ([2,3,4],Identity False)
+__Wrapped ::
+  Iso
+    (BiId p s t a b)
+    (BiId p' s' t' a' b')
+    (p (s a) (t b))
+    (p' (s' a') (t' b'))
+__Wrapped =
+  iso
+    (\(BiId x) -> x)
+    BiId
+{-# INLINE __Wrapped #-}
+
+-- |
+-- >>> liftEq (==) (BiId ([1,2], Identity True)) (BiId ([1,2], Identity True))
+-- True
+--
+-- >>> liftEq (==) (BiId ([1,2], Identity True)) (BiId ([1,2], Identity False))
+-- False
+instance (Eq1 (p (s a)), Eq1 t) => Eq1 (BiId p s t a) where
+  liftEq f (BiId x) (BiId y) =
+    liftEq (liftEq f) x y
+  {-# INLINE liftEq #-}
+
+-- |
+-- >>> liftCompare compare (BiId ([1], Identity 'a')) (BiId ([1], Identity 'b'))
+-- LT
+instance (Ord1 (p (s a)), Ord1 t) => Ord1 (BiId p s t a) where
+  liftCompare f (BiId x) (BiId y) =
+    liftCompare (liftCompare f) x y
+  {-# INLINE liftCompare #-}
+
+-- |
+-- >>> liftShowsPrec showsPrec showList 0 (BiId ([1,2], Identity True)) ""
+-- "BiId ([1,2],Identity True)"
+instance (Show1 (p (s a)), Show1 t) => Show1 (BiId p s t a) where
+  liftShowsPrec sp l d (BiId x) =
+    showParen (d > 10) $ showString "BiId " . liftShowsPrec (liftShowsPrec sp l) (liftShowList sp l) 11 x
+  {-# INLINE liftShowsPrec #-}
+
+-- |
+-- >>> liftEq2 (==) (==) (BiId ([1,2], Identity True)) (BiId ([1,2], Identity True))
+-- True
+--
+-- >>> liftEq2 (==) (==) (BiId ([1,2], Identity True)) (BiId ([3,4], Identity True))
+-- False
+instance (Eq2 p, Eq1 s, Eq1 t) => Eq2 (BiId p s t) where
+  liftEq2 f g (BiId x) (BiId y) =
+    liftEq2 (liftEq f) (liftEq g) x y
+  {-# INLINE liftEq2 #-}
+
+-- |
+-- >>> liftCompare2 compare compare (BiId ([1], Identity 'a')) (BiId ([2], Identity 'a'))
+-- LT
+instance (Ord2 p, Ord1 s, Ord1 t) => Ord2 (BiId p s t) where
+  liftCompare2 f g (BiId x) (BiId y) =
+    liftCompare2 (liftCompare f) (liftCompare g) x y
+  {-# INLINE liftCompare2 #-}
+
+-- |
+-- >>> liftShowsPrec2 showsPrec showList showsPrec showList 0 (BiId ([1,2], Identity True)) ""
+-- "BiId ([1,2],Identity True)"
+instance (Show2 p, Show1 s, Show1 t) => Show2 (BiId p s t) where
+  liftShowsPrec2 spa la spb lb d (BiId x) =
+    showParen (d > 10) $ showString "BiId " . liftShowsPrec2 (liftShowsPrec spa la) (liftShowList spa la) (liftShowsPrec spb lb) (liftShowList spb lb) 11 x
+  {-# INLINE liftShowsPrec2 #-}
+
+-- |
+-- >>> dimap (+1) (*2) (BiId (Tagged (Identity 3))) :: BiId Tagged [] Identity Int Int
+-- BiId (Tagged (Identity 6))
+instance (Profunctor p, Functor s, Functor t) => Profunctor (BiId p s t) where
+  dimap f g (BiId x) =
+    BiId (dimap (fmap f) (fmap g) x)
+  {-# INLINE dimap #-}
+  lmap f (BiId x) =
+    BiId (lmap (fmap f) x)
+  {-# INLINE lmap #-}
+  rmap f (BiId x) =
+    BiId (rmap (fmap f) x)
+  {-# INLINE rmap #-}
+
+-- |
+-- >>> let f = first' (BiId id :: BiId (->) Identity Identity Int Int)
+-- >>> (\(BiId g) -> g) f (Identity (3, 'x'))
+-- Identity (3,'x')
+instance (Strong p, Comonad s, Functor t) => Strong (BiId p s t) where
+  first' (BiId x) =
+    BiId
+      ( dimap
+          (\sac -> (fmap fst sac, snd (extract sac)))
+          (\(tb, c) -> fmap (, c) tb)
+          (first' x)
+      )
+  {-# INLINE first' #-}
+  second' (BiId x) =
+    BiId
+      ( dimap
+          (\sca -> (fst (extract sca), fmap snd sca))
+          (\(c, tb) -> fmap (c,) tb)
+          (second' x)
+      )
+  {-# INLINE second' #-}
+
+-- |
+-- >>> let f = left' (BiId id :: BiId (->) Identity Identity Int Int)
+-- >>> (\(BiId g) -> g) f (Identity (Left 3))
+-- Identity (Left 3)
+instance (Choice p, Traversable s, Applicative t) => Choice (BiId p s t) where
+  left' (BiId x) =
+    BiId
+      ( dimap
+          (either Right Left . traverse (either Right Left))
+          (either (fmap Left) (pure . Right))
+          (left' x)
+      )
+  {-# INLINE left' #-}
+  right' (BiId x) =
+    BiId
+      ( dimap
+          (either Left Right . traverse (either Left Right))
+          (either (pure . Left) (fmap Right))
+          (right' x)
+      )
+  {-# INLINE right' #-}
+
+-- |
+-- >>> let BiId f = closed (BiId id :: BiId (->) Identity Identity Int Int)
+-- >>> runIdentity (f (Identity (const 7))) 'x'
+-- 7
+instance (Closed p, Distributive s, Distributive t) => Closed (BiId p s t) where
+  closed (BiId x) =
+    BiId (dimap distribute distribute (closed x))
+  {-# INLINE closed #-}
+
+-- |
+-- >>> bimap (+1) not (BiId ([1,2,3], Identity True))
+-- BiId ([2,3,4],Identity False)
+instance (Bifunctor p, Functor s, Functor t) => Bifunctor (BiId p s t) where
+  bimap f g (BiId x) =
+    BiId (bimap (fmap f) (fmap g) x)
+  {-# INLINE bimap #-}
+  first f (BiId x) =
+    BiId (first (fmap f) x)
+  {-# INLINE first #-}
+  second f (BiId x) =
+    BiId (second (fmap f) x)
+  {-# INLINE second #-}
+
+-- |
+-- >>> bifoldMap Sum Sum (BiId ([1,2,3], Identity 4))
+-- Sum {getSum = 10}
+instance (Bifoldable p, Foldable s, Foldable t) => Bifoldable (BiId p s t) where
+  bifoldMap f g (BiId x) =
+    bifoldMap (foldMap f) (foldMap g) x
+  {-# INLINE bifoldMap #-}
+
+-- |
+-- >>> bifoldMap1 Sum Sum (BiId (Identity 3, Identity 4))
+-- Sum {getSum = 7}
+instance (Bifoldable1 p, Foldable1 s, Foldable1 t) => Bifoldable1 (BiId p s t) where
+  bifoldMap1 f g (BiId x) =
+    bifoldMap1 (foldMap1 f) (foldMap1 g) x
+  {-# INLINE bifoldMap1 #-}
+
+-- |
+-- >>> bitraverse (\x -> if x > 2 then Nothing else Just (x * 10)) (\x -> Just (not x)) (BiId ([1,2], Identity True))
+-- Just (BiId ([10,20],Identity False))
+--
+-- >>> bitraverse (\x -> if x > 2 then Nothing else Just (x * 10)) (\x -> Just (not x)) (BiId ([1,3], Identity True))
+-- Nothing
+instance (Bitraversable p, Traversable s, Traversable t) => Bitraversable (BiId p s t) where
+  bitraverse f g (BiId x) =
+    BiId <$> bitraverse (traverse f) (traverse g) x
+  {-# INLINE bitraverse #-}
+
+-- |
+-- >>> bitraverse1 Just Just (BiId (Identity 3, Identity True))
+-- Just (BiId (Identity 3,Identity True))
+instance (Bitraversable1 p, Traversable1 s, Traversable1 t) => Bitraversable1 (BiId p s t) where
+  bitraverse1 f g (BiId x) =
+    BiId <$> bitraverse1 (traverse1 f) (traverse1 g) x
+  {-# INLINE bitraverse1 #-}
+
+-- |
+-- >>> fmap (+1) (BiId ([1,2,3], Identity 4))
+-- BiId ([1,2,3],Identity 5)
+instance (Functor (p (s a)), Functor t) => Functor (BiId p s t a) where
+  fmap f (BiId x) =
+    BiId (fmap (fmap f) x)
+  {-# INLINE fmap #-}
+
+-- |
+-- >>> foldMap Sum (BiId ([1,2,3], Identity 4))
+-- Sum {getSum = 4}
+instance (Foldable (p (s a)), Foldable t) => Foldable (BiId p s t a) where
+  foldMap f (BiId x) =
+    foldMap (foldMap f) x
+  {-# INLINE foldMap #-}
+
+-- |
+-- >>> traverse (\x -> if x > 3 then Nothing else Just (x * 10)) (BiId ([1,2], Identity 3))
+-- Just (BiId ([1,2],Identity 30))
+--
+-- >>> traverse (\x -> if x > 3 then Nothing else Just (x * 10)) (BiId ([1,2], Identity 4))
+-- Nothing
+instance (Traversable (p (s a)), Traversable t) => Traversable (BiId p s t a) where
+  traverse f (BiId x) =
+    BiId <$> traverse (traverse f) x
+  {-# INLINE traverse #-}
+
+-- |
+-- >>> (BiId ("", Identity (+1)) :: BiId (,) [] Identity Char (Int -> Int)) <.> BiId ("", Identity 10)
+-- BiId ("",Identity 11)
+instance (Apply (p (s a)), Apply t) => Apply (BiId p s t a) where
+  BiId x <.> BiId y =
+    BiId (liftF2 (<.>) x y)
+  {-# INLINE (<.>) #-}
+
+-- |
+-- >>> pure 7 :: BiId (,) [] Identity Int Int
+-- BiId ([],Identity 7)
+--
+-- >>> (BiId ("", Identity (+1)) :: BiId (,) [] Identity Char (Int -> Int)) <*> BiId ("", Identity 10)
+-- BiId ("",Identity 11)
+instance (Applicative (p (s a)), Applicative t) => Applicative (BiId p s t a) where
+  pure b =
+    BiId (pure (pure b))
+  {-# INLINE pure #-}
+  BiId x <*> BiId y =
+    BiId (liftA2 (<*>) x y)
+  {-# INLINE (<*>) #-}
+
+-- |
+-- >>> BiId ("hello", Identity 3) >>- (\b -> BiId ("!", Identity (b + 1)))
+-- BiId ("hello!",Identity 4)
+instance (Apply (p (s a)), Monad (p (s a)), Apply t, Traversable t, Monad t) => Bind (BiId p s t a) where
+  BiId x >>- f =
+    BiId (x >>= \tb -> fmap join (mapM (\b -> let BiId y = f b in y) tb))
+  {-# INLINE (>>-) #-}
+
+-- |
+-- >>> BiId ("hello", Identity 3) >>= (\b -> BiId ("!", Identity (b + 1)))
+-- BiId ("hello!",Identity 4)
+instance (Monad (p (s a)), Traversable t, Monad t) => Monad (BiId p s t a) where
+  BiId x >>= f =
+    BiId (x >>= \tb -> fmap join (mapM (\b -> let BiId y = f b in y) tb))
+  {-# INLINE (>>=) #-}
+
+-- |
+-- >>> bipure 'a' True :: BiId (,) Identity Identity Char Bool
+-- BiId (Identity 'a',Identity True)
+instance (Biapplicative p, Applicative s, Applicative t) => Biapplicative (BiId p s t) where
+  bipure a b =
+    BiId (bipure (pure a) (pure b))
+  {-# INLINE bipure #-}
+  BiId x <<*>> BiId y =
+    BiId (biliftA2 (liftA2 ($)) (liftA2 ($)) x y)
+  {-# INLINE (<<*>>) #-}
+
+-- |
+-- >>> import Control.Lens (imap)
+-- >>> imap (\(i, j) x -> (i, j, x)) (BiId (["hello", "world"], Identity 7))
+-- BiId (["hello","world"],Identity (["hello","world"],(),7))
+instance (FunctorWithIndex i (p (s a)), FunctorWithIndex j t) => FunctorWithIndex (i, j) (BiId p s t a) where
+  imap f (BiId x) =
+    BiId (imap (\i -> imap (\j -> f (i, j))) x)
+  {-# INLINE imap #-}
+
+-- |
+-- >>> import Control.Lens (ifoldMap)
+-- >>> ifoldMap (\(i, _) x -> [(i, x)]) (BiId (["hello", "world"], Identity 7))
+-- [(["hello","world"],7)]
+instance (FoldableWithIndex i (p (s a)), Foldable (p (s a)), FoldableWithIndex j t, Foldable t) => FoldableWithIndex (i, j) (BiId p s t a) where
+  ifoldMap f (BiId x) =
+    ifoldMap (\i -> ifoldMap (\j -> f (i, j))) x
+  {-# INLINE ifoldMap #-}
+
+-- |
+-- >>> import Control.Lens (itraverse)
+-- >>> itraverse (\(_, _) x -> Just (x + 1)) (BiId (["hello"], Identity 7))
+-- Just (BiId (["hello"],Identity 8))
+instance (TraversableWithIndex i (p (s a)), Traversable (p (s a)), FoldableWithIndex i (p (s a)), Foldable (p (s a)), TraversableWithIndex j t, Traversable t, FoldableWithIndex j t, Foldable t, Functor (p (s a)), Functor t) => TraversableWithIndex (i, j) (BiId p s t a) where
+  itraverse f (BiId x) =
+    BiId <$> itraverse (\i -> itraverse (\j -> f (i, j))) x
+  {-# INLINE itraverse #-}
+
+-- |
+-- >>> select (BiId ("", Identity (Right 7))) (BiId ("x", Identity (+1)))
+-- BiId ("x",Identity 7)
+--
+-- >>> select (BiId ("", Identity (Left 3))) (BiId ("x", Identity (+1)))
+-- BiId ("x",Identity 4)
+instance (Applicative (p (s a)), Selective t) => Selective (BiId p s t a) where
+  select (BiId x) (BiId y) =
+    BiId (liftA2 select x y)
+  {-# INLINE select #-}
+
+instance (Alt (p (s a)), Functor (p (s a)), Functor t) => Alt (BiId p s t a) where
+  BiId x <!> BiId y =
+    BiId (x <!> y)
+  {-# INLINE (<!>) #-}
+
+instance (Alternative (p (s a)), Applicative t) => Alternative (BiId p s t a) where
+  BiId x <|> BiId y =
+    BiId (x <|> y)
+  {-# INLINE (<|>) #-}
+  empty =
+    BiId empty
+  {-# INLINE empty #-}
+
+instance (Plus (p (s a)), Functor (p (s a)), Functor t) => Plus (BiId p s t a) where
+  zero =
+    BiId zero
+  {-# INLINE zero #-}
+
+-- |
+-- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)
+-- >>> getPredicate ((\(BiId (Tagged x)) -> x) (contramap length (BiId (Tagged (Predicate (> 3))) :: BiId Tagged [] Predicate Int Int))) "hello"
+-- True
+instance (Functor (p (s a)), Contravariant t) => Contravariant (BiId p s t a) where
+  contramap f (BiId x) =
+    BiId (fmap (contramap f) x)
+  {-# INLINE contramap #-}
+
+-- |
+-- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)
+-- >>> import Data.Functor.Contravariant.Divisible (divided)
+-- >>> let BiId (Tagged p) = divided (BiId (Tagged (Predicate even))) (BiId (Tagged (Predicate (> 0)))) :: BiId Tagged [] Predicate Int (Int, Int) in getPredicate p (4, 1)
+-- True
+instance (Applicative (p (s a)), Divisible t) => Divisible (BiId p s t a) where
+  divide f (BiId x) (BiId y) =
+    BiId (liftA2 (divide f) x y)
+  {-# INLINE divide #-}
+  conquer =
+    BiId (pure conquer)
+  {-# INLINE conquer #-}
+
+-- |
+-- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)
+-- >>> import Data.Functor.Contravariant.Divisible (chosen)
+-- >>> let BiId (Tagged p) = chosen (BiId (Tagged (Predicate even))) (BiId (Tagged (Predicate (> 0)))) :: BiId Tagged [] Predicate Int (Either Int Int) in getPredicate p (Left 4)
+-- True
+instance (Applicative (p (s a)), Decidable t) => Decidable (BiId p s t a) where
+  choose f (BiId x) (BiId y) =
+    BiId (liftA2 (choose f) x y)
+  {-# INLINE choose #-}
+  lose f =
+    BiId (pure (lose f))
+  {-# INLINE lose #-}
+
+-- |
+-- >>> let f = unfirst (BiId (Tagged (Identity (True, 'x')))) :: BiId Tagged Identity Identity Int Bool
+-- >>> (\(BiId (Tagged x)) -> x) f
+-- Identity True
+instance (Costrong p, Functor s, Comonad t) => Costrong (BiId p s t) where
+  unfirst (BiId x) =
+    BiId
+      ( unfirst
+          ( dimap
+              (\(sa, d) -> fmap (, d) sa)
+              (\tbd -> (fmap fst tbd, snd (extract tbd)))
+              x
+          )
+      )
+  {-# INLINE unfirst #-}
+  unsecond (BiId x) =
+    BiId
+      ( unsecond
+          ( dimap
+              (\(d, sa) -> fmap (d,) sa)
+              (\tdb -> (fst (extract tdb), fmap snd tdb))
+              x
+          )
+      )
+  {-# INLINE unsecond #-}
+
+-- |
+-- >>> let BiId f = unleft (BiId id :: BiId (->) Identity Identity (Either Int Char) (Either Int Char))
+-- >>> f (Identity 7)
+-- Identity 7
+instance (Cochoice p, Applicative s, Traversable t) => Cochoice (BiId p s t) where
+  unleft (BiId x) =
+    BiId
+      ( unleft
+          ( dimap
+              (either (fmap Left) (pure . Right))
+              (either Right Left . traverse (either Right Left))
+              x
+          )
+      )
+  {-# INLINE unleft #-}
+  unright (BiId x) =
+    BiId
+      ( unright
+          ( dimap
+              (either (pure . Left) (fmap Right))
+              (either Left Right . traverse (either Left Right))
+              x
+          )
+      )
+  {-# INLINE unright #-}
+
+-- |
+-- >>> BiId ([1,2], [3,4]) <> BiId ([5], [6]) :: BiId (,) [] [] Int Int
+-- BiId ([1,2,5],[3,4,6])
+instance (Semigroup (p (s a) (t b))) => Semigroup (BiId p s t a b) where
+  BiId x <> BiId y =
+    BiId (x <> y)
+  {-# INLINE (<>) #-}
+
+-- |
+-- >>> mempty :: BiId (,) [] [] Int Int
+-- BiId ([],[])
+instance (Monoid (p (s a) (t b))) => Monoid (BiId p s t a b) where
+  mempty =
+    BiId mempty
+  {-# INLINE mempty #-}
+
+-- |
+-- >>> duplicated (BiId (Identity 7, Identity True))
+-- BiId (Identity 7,Identity (BiId (Identity 7,Identity True)))
+instance (Comonad (p (s a)), Comonad t) => Extend (BiId p s t a) where
+  duplicated (BiId x) =
+    BiId (extend (\px -> extend (\tb -> BiId (fmap (const tb) px)) (extract px)) x)
+  {-# INLINE duplicated #-}
+
+-- |
+-- >>> extract (BiId (Identity 7, Identity True))
+-- True
+instance (Comonad (p (s a)), Comonad t) => Comonad (BiId p s t a) where
+  extract (BiId x) =
+    extract (extract x)
+  {-# INLINE extract #-}
+  duplicate (BiId x) =
+    BiId (extend (\px -> extend (\tb -> BiId (fmap (const tb) px)) (extract px)) x)
+  {-# INLINE duplicate #-}
+
+-- |
+-- >>> foldMap1 Sum (BiId (Identity "hello", Identity 7))
+-- Sum {getSum = 7}
+instance (Foldable1 (p (s a)), Foldable1 t) => Foldable1 (BiId p s t a) where
+  foldMap1 f (BiId x) =
+    foldMap1 (foldMap1 f) x
+  {-# INLINE foldMap1 #-}
+
+-- |
+-- >>> traverse1 Just (BiId (Identity "hello", Identity 7))
+-- Just (BiId (Identity "hello",Identity 7))
+instance (Traversable1 (p (s a)), Traversable1 t) => Traversable1 (BiId p s t a) where
+  traverse1 f (BiId x) =
+    BiId <$> traverse1 (traverse1 f) x
+  {-# INLINE traverse1 #-}
+
+instance (MonadPlus (p (s a)), Monad t, Traversable t) => MonadPlus (BiId p s t a)
+
+-- |
+-- >>> distribute [BiId (Tagged (Identity 1)), BiId (Tagged (Identity 2))] :: BiId Tagged [] Identity Int [Int]
+-- BiId (Tagged (Identity [1,2]))
+instance (Distributive (p (s a)), Distributive t) => Distributive (BiId p s t a) where
+  distribute x =
+    BiId (fmap distribute (distribute (fmap (\(BiId y) -> y) x)))
+  {-# INLINE distribute #-}
+  collect f x =
+    distribute (fmap f x)
+  {-# INLINE collect #-}
+
+instance (MonadZip (p (s a)), MonadZip t, Traversable t, Monad t, Monad (p (s a))) => MonadZip (BiId p s t a) where
+  mzipWith f (BiId x) (BiId y) =
+    BiId (mzipWith (mzipWith f) x y)
+  {-# INLINE mzipWith #-}
+
+instance (MonadFail (p (s a)), Traversable t, Monad t) => MonadFail (BiId p s t a) where
+  fail s =
+    BiId (fail s)
+  {-# INLINE fail #-}
+
+instance (MonadIO (p (s a)), Applicative t, Traversable t, Monad t) => MonadIO (BiId p s t a) where
+  liftIO =
+    BiId . fmap pure . liftIO
+  {-# INLINE liftIO #-}
+
+-- |
+-- >>> import Control.Monad.Reader (runReader)
+-- >>> (\(BiId f) -> f (Identity 42)) (ask :: BiId (->) Identity Identity Int (Identity Int))
+-- Identity (Identity 42)
+instance (MonadReader r (p (s a)), Traversable t, Monad t) => MonadReader r (BiId p s t a) where
+  ask =
+    BiId (fmap pure ask)
+  {-# INLINE ask #-}
+  local f (BiId x) =
+    BiId (local f x)
+  {-# INLINE local #-}
+  reader f =
+    BiId (fmap pure (reader f))
+  {-# INLINE reader #-}
+
+instance (MonadState st (p (s a)), Traversable t, Monad t) => MonadState st (BiId p s t a) where
+  get =
+    BiId (fmap pure get)
+  {-# INLINE get #-}
+  put =
+    BiId . fmap pure . put
+  {-# INLINE put #-}
+  state f =
+    BiId (fmap pure (state f))
+  {-# INLINE state #-}
+
+instance (MonadWriter w (p (s a)), Comonad t, Traversable t, Monad t) => MonadWriter w (BiId p s t a) where
+  writer aw =
+    BiId (fmap pure (writer aw))
+  {-# INLINE writer #-}
+  tell =
+    BiId . fmap pure . tell
+  {-# INLINE tell #-}
+  listen (BiId x) =
+    BiId (fmap (\(tb, w) -> fmap (, w) tb) (listen x))
+  {-# INLINE listen #-}
+  pass (BiId x) =
+    BiId (pass (fmap (\twf -> (fmap fst twf, snd (extract twf))) x))
+  {-# INLINE pass #-}
+
+instance (MonadError e (p (s a)), Traversable t, Monad t) => MonadError e (BiId p s t a) where
+  throwError =
+    BiId . fmap pure . throwError
+  {-# INLINE throwError #-}
+  catchError (BiId x) f =
+    BiId (catchError x (\e -> let BiId y = f e in y))
+  {-# INLINE catchError #-}
+
+instance (MonadCont (p (s a)), Traversable t, Monad t) => MonadCont (BiId p s t a) where
+  callCC f =
+    BiId (callCC (\k -> let BiId x = f (BiId . k . pure) in x))
+  {-# INLINE callCC #-}
+
+instance (MonadRWS r w st (p (s a)), Comonad t, Traversable t, Monad t) => MonadRWS r w st (BiId p s t a)
diff --git a/src/Data/Id.hs b/src/Data/Id.hs
--- a/src/Data/Id.hs
+++ b/src/Data/Id.hs
@@ -6,7 +6,6 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -Wall -Werror #-}
 
 -- |
 -- @Id f a@ — a newtype around @f a@, with optics and instances for switching
@@ -47,6 +46,7 @@
     -- * Optics
     __Wrapped,
     __Unwrapped,
+    idIdentity,
     idTagged,
     idProxy,
     just,
@@ -57,6 +57,8 @@
 where
 
 import Control.Applicative (Alternative (empty, (<|>)))
+import Control.Comonad (Comonad (..))
+import Control.DeepSeq (NFData (..), NFData1 (..))
 import Control.Lens
   ( FoldableWithIndex (..),
     FunctorWithIndex (..),
@@ -96,6 +98,7 @@
 import Control.Monad.Zip (MonadZip (..))
 import Control.Selective (Selective (..))
 import Data.Data (Data)
+import Data.Distributive (Distributive (..))
 import Data.Functor.Alt (Alt ((<!>)))
 import Data.Functor.Apply (Apply ((<.>)))
 import Data.Functor.Bind (Bind ((>>-)))
@@ -103,15 +106,15 @@
 import Data.Functor.Classes
   ( Eq1 (..),
     Ord1 (..),
-    Read1 (..),
     Show1 (liftShowsPrec),
   )
 import Data.Functor.Const (Const)
 import Data.Functor.Contravariant (Contravariant (..))
 import Data.Functor.Contravariant.Divisible (Decidable (..), Divisible (..))
 import Data.Functor.Extend (Extend (..))
-import Data.Functor.Identity (Identity (Identity))
+import Data.Functor.Identity (Identity (Identity, runIdentity))
 import Data.Functor.Plus (Plus (..))
+import Data.Hashable (Hashable (..))
 import Data.List.NonEmpty (NonEmpty)
 import Data.Proxy (Proxy (..))
 import Data.Semigroup.Foldable (Foldable1 (foldMap1))
@@ -142,7 +145,7 @@
 -- True
 newtype Id f a
   = Id (f a)
-  deriving (Eq, Ord, Show, Read, Data, Generic, Generic1)
+  deriving (Eq, Ord, Show, Data, Generic, Generic1)
 
 -- |
 -- >>> liftEq (==) (Id [1,2,3]) (Id [1,2,3])
@@ -156,6 +159,7 @@
 instance (Eq1 f) => Eq1 (Id f) where
   liftEq f (Id x) (Id y) =
     liftEq f x y
+  {-# INLINE liftEq #-}
 
 -- |
 -- >>> liftCompare compare (Id [1,2,3]) (Id [1,2,4])
@@ -169,6 +173,7 @@
 instance (Ord1 f) => Ord1 (Id f) where
   liftCompare f (Id x) (Id y) =
     liftCompare f x y
+  {-# INLINE liftCompare #-}
 
 -- |
 -- >>> liftShowsPrec showsPrec showList 0 (Id [1,2,3]) ""
@@ -182,21 +187,8 @@
 instance (Show1 f) => Show1 (Id f) where
   liftShowsPrec sp l d (Id x) =
     showParen (d > 10) $ showString "Id " . liftShowsPrec sp l 11 x
+  {-# INLINE liftShowsPrec #-}
 
--- |
--- >>> liftReadsPrec readsPrec readList 0 "Id [1,2,3]" :: [(Id [] Int, String)]
--- [(Id [1,2,3],"")]
---
--- >>> liftReadsPrec readsPrec readList 0 "Id (Just 'x')" :: [(Id Maybe Char, String)]
--- [(Id (Just 'x'),"")]
---
--- >>> liftReadsPrec readsPrec readList 11 "(Id [1,2,3])" :: [(Id [] Int, String)]
--- [(Id [1,2,3],"")]
-instance (Read1 f) => Read1 (Id f) where
-  liftReadsPrec rp rl d =
-    readParen
-      (d > 10)
-      (\s -> [(Id x, t) | ("Id", r) <- lex s, (x, t) <- liftReadsPrec rp rl 11 r])
 
 instance
   (Id f a ~ x) =>
@@ -214,6 +206,7 @@
       f a
   _Wrapped' =
     iso (\(Id x) -> x) Id
+  {-# INLINE _Wrapped' #-}
 
 -- |
 -- >>> view __Wrapped (Id [1,2,3])
@@ -255,6 +248,7 @@
   iso
     (\(Id x) -> x)
     Id
+{-# INLINE __Wrapped #-}
 
 -- |
 -- >>> view __Unwrapped [1,2,3] :: Id [] Int
@@ -296,6 +290,7 @@
   iso
     Id
     (\(Id x) -> x)
+{-# INLINE __Unwrapped #-}
 
 -- |
 -- >>> unId (Id [1,2,3])
@@ -305,6 +300,7 @@
 -- Identity 7
 unId :: Id f a -> f a
 unId (Id x) = x
+{-# INLINE unId #-}
 
 -- |
 -- >>> mapId reverse (Id [1,2,3])
@@ -317,6 +313,7 @@
 -- Id (Identity [1,2,3])
 mapId :: (f a -> g b) -> Id f a -> Id g b
 mapId = over __Wrapped
+{-# INLINE mapId #-}
 
 -- |
 -- >>> view getId (Id [1,2,3])
@@ -331,42 +328,52 @@
 instance GetterId (Id f a) f a where
   getId =
     id
+  {-# INLINE getId #-}
 
 instance GetterId (Identity a) Identity a where
   getId =
     to Id
+  {-# INLINE getId #-}
 
 instance GetterId (Maybe a) Maybe a where
   getId =
     to Id
+  {-# INLINE getId #-}
 
 instance GetterId [a] [] a where
   getId =
     to Id
+  {-# INLINE getId #-}
 
 instance GetterId (NonEmpty a) NonEmpty a where
   getId =
     to Id
+  {-# INLINE getId #-}
 
 instance GetterId (Either e a) (Either e) a where
   getId =
     to Id
+  {-# INLINE getId #-}
 
 instance GetterId (w, a) ((,) w) a where
   getId =
     to Id
+  {-# INLINE getId #-}
 
 instance GetterId (Const c a) (Const c) a where
   getId =
     to Id
+  {-# INLINE getId #-}
 
 instance GetterId (Proxy a) Proxy a where
   getId =
     to Id
+  {-# INLINE getId #-}
 
 instance GetterId (Tagged s a) (Tagged s) a where
   getId =
     to Id
+  {-# INLINE getId #-}
 
 -- |
 -- >>> view id' (Id [1,2,3])
@@ -382,46 +389,57 @@
     Lens' a (Id f x)
   id' =
     lens (view getId) (flip setId)
+  {-# INLINE id' #-}
 
 instance HasId (Id f a) f a where
   setId =
     const
+  {-# INLINE setId #-}
 
 instance HasId (Identity a) Identity a where
   setId =
     const . unId
+  {-# INLINE setId #-}
 
 instance HasId (Maybe a) Maybe a where
   setId =
     const . unId
+  {-# INLINE setId #-}
 
 instance HasId [a] [] a where
   setId =
     const . unId
+  {-# INLINE setId #-}
 
 instance HasId (NonEmpty a) NonEmpty a where
   setId =
     const . unId
+  {-# INLINE setId #-}
 
 instance HasId (Either e a) (Either e) a where
   setId =
     const . unId
+  {-# INLINE setId #-}
 
 instance HasId (w, a) ((,) w) a where
   setId =
     const . unId
+  {-# INLINE setId #-}
 
 instance HasId (Const c a) (Const c) a where
   setId =
     const . unId
+  {-# INLINE setId #-}
 
 instance HasId (Proxy a) Proxy a where
   setId =
     const . unId
+  {-# INLINE setId #-}
 
 instance HasId (Tagged s a) (Tagged s) a where
   setId =
     const . unId
+  {-# INLINE setId #-}
 
 -- |
 -- >>> review reviewId (Id [1,2,3]) :: Id [] Int
@@ -436,42 +454,52 @@
 instance ReviewId (Id f a) f a where
   reviewId =
     unto id
+  {-# INLINE reviewId #-}
 
 instance ReviewId (Identity a) Identity a where
   reviewId =
     unto unId
+  {-# INLINE reviewId #-}
 
 instance ReviewId (Maybe a) Maybe a where
   reviewId =
     unto unId
+  {-# INLINE reviewId #-}
 
 instance ReviewId [a] [] a where
   reviewId =
     unto unId
+  {-# INLINE reviewId #-}
 
 instance ReviewId (NonEmpty a) NonEmpty a where
   reviewId =
     unto unId
+  {-# INLINE reviewId #-}
 
 instance ReviewId (Either e a) (Either e) a where
   reviewId =
     unto unId
+  {-# INLINE reviewId #-}
 
 instance ReviewId (w, a) ((,) w) a where
   reviewId =
     unto unId
+  {-# INLINE reviewId #-}
 
 instance ReviewId (Const c a) (Const c) a where
   reviewId =
     unto unId
+  {-# INLINE reviewId #-}
 
 instance ReviewId (Proxy a) Proxy a where
   reviewId =
     unto unId
+  {-# INLINE reviewId #-}
 
 instance ReviewId (Tagged s a) (Tagged s) a where
   reviewId =
     unto unId
+  {-# INLINE reviewId #-}
 
 -- |
 -- >>> preview _Id (Id [1,2,3])
@@ -487,46 +515,57 @@
     Prism' a (Id f x)
   _Id =
     prism' (review reviewId) matchId
+  {-# INLINE _Id #-}
 
 instance AsId (Id f a) f a where
   matchId =
     Just
+  {-# INLINE matchId #-}
 
 instance AsId (Identity a) Identity a where
   matchId =
     Just . Id
+  {-# INLINE matchId #-}
 
 instance AsId (Maybe a) Maybe a where
   matchId =
     Just . Id
+  {-# INLINE matchId #-}
 
 instance AsId [a] [] a where
   matchId =
     Just . Id
+  {-# INLINE matchId #-}
 
 instance AsId (NonEmpty a) NonEmpty a where
   matchId =
     Just . Id
+  {-# INLINE matchId #-}
 
 instance AsId (Either e a) (Either e) a where
   matchId =
     Just . Id
+  {-# INLINE matchId #-}
 
 instance AsId (w, a) ((,) w) a where
   matchId =
     Just . Id
+  {-# INLINE matchId #-}
 
 instance AsId (Const c a) (Const c) a where
   matchId =
     Just . Id
+  {-# INLINE matchId #-}
 
 instance AsId (Proxy a) Proxy a where
   matchId =
     Just . Id
+  {-# INLINE matchId #-}
 
 instance AsId (Tagged s a) (Tagged s) a where
   matchId =
     Just . Id
+  {-# INLINE matchId #-}
 
 -- |
 -- >>> Id [1,2,3] <> Id [4,5]
@@ -537,6 +576,7 @@
 instance (Semigroup (f a)) => Semigroup (Id f a) where
   Id x <> Id y =
     Id (x <> y)
+  {-# INLINE (<>) #-}
 
 -- |
 -- >>> mempty :: Id [] Int
@@ -550,6 +590,7 @@
 instance (Monoid (f a)) => Monoid (Id f a) where
   mempty =
     Id mempty
+  {-# INLINE mempty #-}
 
 -- |
 -- >>> fmap (+1) (Id [1,2,3])
@@ -561,8 +602,9 @@
 -- >>> fmap show (Id [1,2,3])
 -- Id ["1","2","3"]
 instance (Functor f) => Functor (Id f) where
-  fmap =
-    over _Wrapped . fmap
+  fmap f (Id x) =
+    Id (fmap f x)
+  {-# INLINE fmap #-}
 
 -- |
 -- >>> Id [(+1), (*2)] <.> Id [3,4]
@@ -573,6 +615,7 @@
 instance (Apply f) => Apply (Id f) where
   Id x <.> Id y =
     Id (x <.> y)
+  {-# INLINE (<.>) #-}
 
 -- |
 -- >>> Id [(+1), (*2)] <*> Id [3,4]
@@ -586,14 +629,19 @@
 instance (Applicative f) => Applicative (Id f) where
   Id x <*> Id y =
     Id (x <*> y)
+  {-# INLINE (<*>) #-}
   pure =
     Id . pure
+  {-# INLINE pure #-}
   liftA2 f (Id x) (Id y) =
     Id (liftA2 f x y)
+  {-# INLINE liftA2 #-}
   Id x *> Id y =
     Id (x *> y)
+  {-# INLINE (*>) #-}
   Id x <* Id y =
     Id (x <* y)
+  {-# INLINE (<*) #-}
 
 -- |
 -- >>> select (Id [Right 7]) (Id [const 0])
@@ -607,6 +655,7 @@
 instance (Selective f) => Selective (Id f) where
   select (Id x) (Id y) =
     Id (select x y)
+  {-# INLINE select #-}
 
 -- |
 -- >>> Id [1,2] <!> Id [3,4]
@@ -620,6 +669,7 @@
 instance (Alt f) => Alt (Id f) where
   Id x <!> Id y =
     Id (x <!> y)
+  {-# INLINE (<!>) #-}
 
 -- |
 -- >>> Id [1,2] <|> Id [3,4]
@@ -636,8 +686,10 @@
 instance (Alternative f) => Alternative (Id f) where
   Id x <|> Id y =
     Id (x <|> y)
+  {-# INLINE (<|>) #-}
   empty =
     Id empty
+  {-# INLINE empty #-}
 
 -- |
 -- >>> Id [1,2,3] >>- (\x -> Id [x, x*10])
@@ -648,6 +700,7 @@
 instance (Bind f) => Bind (Id f) where
   Id x >>- f =
     Id (x >>- view _Wrapped . f)
+  {-# INLINE (>>-) #-}
 
 -- |
 -- >>> Id [1,2,3] >>= (\x -> Id [x, x*10])
@@ -658,6 +711,7 @@
 instance (Monad f) => Monad (Id f) where
   Id x >>= f =
     Id (x >>= view _Wrapped . f)
+  {-# INLINE (>>=) #-}
 
 -- |
 -- >>> foldMap show (Id [1,2,3])
@@ -671,12 +725,16 @@
 instance (Foldable f) => Foldable (Id f) where
   foldMap f (Id x) =
     foldMap f x
+  {-# INLINE foldMap #-}
   foldr f z (Id x) =
     foldr f z x
+  {-# INLINE foldr #-}
   null (Id x) =
     null x
+  {-# INLINE null #-}
   length (Id x) =
     length x
+  {-# INLINE length #-}
 
 -- |
 -- >>> foldMap1 show (Id (Identity 7))
@@ -684,6 +742,7 @@
 instance (Foldable1 f) => Foldable1 (Id f) where
   foldMap1 f (Id x) =
     foldMap1 f x
+  {-# INLINE foldMap1 #-}
 
 -- |
 -- >>> traverse Just (Id [1,2,3])
@@ -697,6 +756,7 @@
 instance (Traversable f) => Traversable (Id f) where
   traverse f (Id x) =
     Id <$> traverse f x
+  {-# INLINE traverse #-}
 
 -- |
 -- >>> traverse1 Just (Id (Identity 7))
@@ -704,6 +764,7 @@
 instance (Traversable1 f) => Traversable1 (Id f) where
   traverse1 f (Id x) =
     Id <$> traverse1 f x
+  {-# INLINE traverse1 #-}
 
 -- |
 -- >>> unId (liftIO (pure 7) :: Id IO Int)
@@ -711,6 +772,7 @@
 instance (MonadIO f) => MonadIO (Id f) where
   liftIO =
     Id . liftIO
+  {-# INLINE liftIO #-}
 
 -- |
 -- >>> lift [1,2,3] :: Id [] Int
@@ -721,6 +783,7 @@
 instance MonadTrans Id where
   lift =
     Id
+  {-# INLINE lift #-}
 
 -- |
 -- >>> liftB [1,2,3] :: Id [] Int
@@ -728,6 +791,7 @@
 instance BindTrans Id where
   liftB =
     Id
+  {-# INLINE liftB #-}
 
 -- |
 -- >>> throwError "oops" :: Id (Either String) Int
@@ -738,8 +802,10 @@
 instance (MonadError a f) => MonadError a (Id f) where
   throwError =
     Id . throwError
+  {-# INLINE throwError #-}
   catchError (Id x) f =
     Id (catchError x (view _Wrapped . f))
+  {-# INLINE catchError #-}
 
 -- |
 -- >>> import Control.Monad.Cont (runCont)
@@ -748,6 +814,7 @@
 instance (MonadCont f) => MonadCont (Id f) where
   callCC f =
     Id (callCC (\k -> view _Wrapped (f (Id . k))))
+  {-# INLINE callCC #-}
 
 -- |
 -- >>> import Control.Monad.Reader (runReader)
@@ -759,10 +826,13 @@
 instance (MonadReader a f) => MonadReader a (Id f) where
   ask =
     Id ask
+  {-# INLINE ask #-}
   local f (Id x) =
     Id (local f x)
+  {-# INLINE local #-}
   reader =
     Id . reader
+  {-# INLINE reader #-}
 
 -- |
 -- >>> import Control.Monad.Writer (runWriter)
@@ -774,12 +844,16 @@
 instance (MonadWriter a f) => MonadWriter a (Id f) where
   writer aw =
     Id (writer aw)
+  {-# INLINE writer #-}
   tell =
     Id . tell
+  {-# INLINE tell #-}
   listen =
     over _Wrapped listen
+  {-# INLINE listen #-}
   pass =
     over _Wrapped pass
+  {-# INLINE pass #-}
 
 -- |
 -- >>> import Control.Monad.State (runState)
@@ -788,10 +862,13 @@
 instance (MonadState a f) => MonadState a (Id f) where
   get =
     Id get
+  {-# INLINE get #-}
   put =
     Id . put
+  {-# INLINE put #-}
   state =
     Id . state
+  {-# INLINE state #-}
 
 instance (MonadRWS r w s f) => MonadRWS r w s (Id f)
 
@@ -801,6 +878,7 @@
 instance (MonadFix f) => MonadFix (Id f) where
   mfix g =
     Id (mfix (unId . g))
+  {-# INLINE mfix #-}
 
 -- |
 -- >>> fail "oops" :: Id Maybe Int
@@ -808,6 +886,7 @@
 instance (MonadFail f) => MonadFail (Id f) where
   fail =
     Id . fail
+  {-# INLINE fail #-}
 
 -- |
 -- >>> mzero :: Id [] Int
@@ -823,6 +902,7 @@
 instance (MonadZip f) => MonadZip (Id f) where
   mzipWith f (Id x) (Id y) =
     Id (mzipWith f x y)
+  {-# INLINE mzipWith #-}
 
 -- |
 -- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)
@@ -834,6 +914,7 @@
 instance (Contravariant f) => Contravariant (Id f) where
   contramap f (Id x) =
     Id (contramap f x)
+  {-# INLINE contramap #-}
 
 -- |
 -- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)
@@ -846,8 +927,10 @@
 instance (Divisible f) => Divisible (Id f) where
   divide f (Id x) (Id y) =
     Id (divide f x y)
+  {-# INLINE divide #-}
   conquer =
     Id conquer
+  {-# INLINE conquer #-}
 
 -- |
 -- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)
@@ -860,8 +943,10 @@
 instance (Decidable f) => Decidable (Id f) where
   choose f (Id x) (Id y) =
     Id (choose f x y)
+  {-# INLINE choose #-}
   lose f =
     Id (lose f)
+  {-# INLINE lose #-}
 
 -- |
 -- >>> zero :: Id [] Int
@@ -869,6 +954,7 @@
 instance (Plus f) => Plus (Id f) where
   zero =
     Id zero
+  {-# INLINE zero #-}
 
 -- |
 -- >>> duplicated (Id (Identity 7))
@@ -876,14 +962,27 @@
 instance (Extend f) => Extend (Id f) where
   duplicated (Id x) =
     Id (Id <$> duplicated x)
+  {-# INLINE duplicated #-}
 
 -- |
+-- >>> extract (Id (Identity 7))
+-- 7
+instance (Comonad f) => Comonad (Id f) where
+  extract (Id x) =
+    extract x
+  {-# INLINE extract #-}
+  duplicate (Id x) =
+    Id (Id <$> duplicate x)
+  {-# INLINE duplicate #-}
+
+-- |
 -- >>> import Control.Lens (imap)
 -- >>> imap (+) (Id [10,20,30])
 -- Id [10,21,32]
 instance (FunctorWithIndex i f) => FunctorWithIndex i (Id f) where
   imap f (Id x) =
     Id (imap f x)
+  {-# INLINE imap #-}
 
 -- |
 -- >>> import Control.Lens (ifoldMap)
@@ -892,6 +991,7 @@
 instance (FoldableWithIndex i f) => FoldableWithIndex i (Id f) where
   ifoldMap f (Id x) =
     ifoldMap f x
+  {-# INLINE ifoldMap #-}
 
 -- |
 -- >>> import Control.Lens (itraverse)
@@ -903,7 +1003,93 @@
 instance (TraversableWithIndex i f) => TraversableWithIndex i (Id f) where
   itraverse f (Id x) =
     Id <$> itraverse f x
+  {-# INLINE itraverse #-}
 
+instance (Distributive f) => Distributive (Id f) where
+  distribute x =
+    Id (distribute (fmap (\(Id y) -> y) x))
+  {-# INLINE distribute #-}
+  collect f x =
+    Id (collect ((\(Id y) -> y) . f) x)
+  {-# INLINE collect #-}
+
+instance (NFData (f a)) => NFData (Id f a) where
+  rnf (Id x) =
+    rnf x
+  {-# INLINE rnf #-}
+
+instance (NFData1 f) => NFData1 (Id f) where
+  liftRnf f (Id x) =
+    liftRnf f x
+  {-# INLINE liftRnf #-}
+
+instance (Hashable (f a)) => Hashable (Id f a) where
+  hashWithSalt s (Id x) =
+    hashWithSalt s x
+  {-# INLINE hashWithSalt #-}
+
+instance (Num (f a)) => Num (Id f a) where
+  Id x + Id y = Id (x + y)
+  {-# INLINE (+) #-}
+  Id x * Id y = Id (x * y)
+  {-# INLINE (*) #-}
+  Id x - Id y = Id (x - y)
+  {-# INLINE (-) #-}
+  negate (Id x) = Id (negate x)
+  {-# INLINE negate #-}
+  abs (Id x) = Id (abs x)
+  {-# INLINE abs #-}
+  signum (Id x) = Id (signum x)
+  {-# INLINE signum #-}
+  fromInteger = Id . fromInteger
+  {-# INLINE fromInteger #-}
+
+instance (Fractional (f a)) => Fractional (Id f a) where
+  Id x / Id y = Id (x / y)
+  {-# INLINE (/) #-}
+  recip (Id x) = Id (recip x)
+  {-# INLINE recip #-}
+  fromRational = Id . fromRational
+  {-# INLINE fromRational #-}
+
+instance (Floating (f a)) => Floating (Id f a) where
+  pi = Id pi
+  {-# INLINE pi #-}
+  exp (Id x) = Id (exp x)
+  {-# INLINE exp #-}
+  log (Id x) = Id (log x)
+  {-# INLINE log #-}
+  sqrt (Id x) = Id (sqrt x)
+  {-# INLINE sqrt #-}
+  Id x ** Id y = Id (x ** y)
+  {-# INLINE (**) #-}
+  logBase (Id x) (Id y) = Id (logBase x y)
+  {-# INLINE logBase #-}
+  sin (Id x) = Id (sin x)
+  {-# INLINE sin #-}
+  cos (Id x) = Id (cos x)
+  {-# INLINE cos #-}
+  tan (Id x) = Id (tan x)
+  {-# INLINE tan #-}
+  asin (Id x) = Id (asin x)
+  {-# INLINE asin #-}
+  acos (Id x) = Id (acos x)
+  {-# INLINE acos #-}
+  atan (Id x) = Id (atan x)
+  {-# INLINE atan #-}
+  sinh (Id x) = Id (sinh x)
+  {-# INLINE sinh #-}
+  cosh (Id x) = Id (cosh x)
+  {-# INLINE cosh #-}
+  tanh (Id x) = Id (tanh x)
+  {-# INLINE tanh #-}
+  asinh (Id x) = Id (asinh x)
+  {-# INLINE asinh #-}
+  acosh (Id x) = Id (acosh x)
+  {-# INLINE acosh #-}
+  atanh (Id x) = Id (atanh x)
+  {-# INLINE atanh #-}
+
 -- |
 -- >>> let x = Id Proxy :: IdProxy Int in x
 -- Id Proxy
@@ -989,7 +1175,21 @@
     (Id (Tagged s') a')
 idTagged =
   iso (over __Wrapped (Tagged . view _Wrapped)) (over __Wrapped (Identity . untag))
+{-# INLINE idTagged #-}
 
+idIdentity ::
+  Iso
+    (IdIdentity a)
+    (IdIdentity a')
+    a
+    a'
+idIdentity =
+  _Wrapped .
+    iso
+      runIdentity
+      Identity
+{-# INLINE idIdentity #-}
+
 -- |
 -- >>> view idProxy (Id Proxy :: IdProxy Int)
 -- ()
@@ -1004,6 +1204,7 @@
     ()
 idProxy =
   iso (const ()) (const (Id Proxy))
+{-# INLINE idProxy #-}
 
 -- |
 -- >>> preview (just :: Prism (IdMaybe Int) (IdMaybe Int) (IdIdentity Int) (IdIdentity Int)) (Id (Just 7))
@@ -1034,6 +1235,7 @@
   Prism s t a b
 just =
   _Wrapped . _Just . _Unwrapped . _Unwrapped
+{-# INLINE just #-}
 
 -- |
 -- >>> view (rejust :: Getter (IdIdentity Int) (IdMaybe Int)) (Id (Identity 7))
@@ -1052,6 +1254,7 @@
   Getter b t
 rejust =
   re just
+{-# INLINE rejust #-}
 
 -- |
 -- >>> preview (nothing :: Prism (IdMaybe Int) (IdMaybe Int) (IdIdentity ()) (IdIdentity ())) (Id Nothing)
@@ -1084,6 +1287,7 @@
   Prism s t a b
 nothing =
   _Wrapped . _Nothing . _Unwrapped . _Unwrapped
+{-# INLINE nothing #-}
 
 -- |
 -- >>> view (renothing :: Getter (IdIdentity ()) (IdMaybe Int)) (Id (Identity ()))
@@ -1103,3 +1307,4 @@
   Getter a t
 renothing =
   re nothing
+{-# INLINE renothing #-}
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wall -Werror -Wno-orphans #-}
-
 module Main where
 
 import System.Exit (exitWith)