diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,11 @@
+# 0.11.0.0
+
+* Added `makeAdaptorAndInstanceInferrable` which has better inference
+  properties, at the cost having to turn on `UndecidableInstances`.
+  The tuple instances are now made by this method too.
+
+# 0.10.0.1
+
 * Added `Data.Profunctor.Product.Examples`
 
 # 0.10.0.0
diff --git a/Data/Profunctor/Product/Default.hs b/Data/Profunctor/Product/Default.hs
--- a/Data/Profunctor/Product/Default.hs
+++ b/Data/Profunctor/Product/Default.hs
@@ -1,6 +1,8 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances,
              FlexibleContexts, PolyKinds, TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 -- | For some 'Data.Profunctor.Product.ProductProfunctor's @p@ and
 -- types @a@, @a'@ there is a unique most sensible value of @p a a'@.
diff --git a/Data/Profunctor/Product/Examples.hs b/Data/Profunctor/Product/Examples.hs
--- a/Data/Profunctor/Product/Examples.hs
+++ b/Data/Profunctor/Product/Examples.hs
@@ -2,13 +2,15 @@
 {-# LANGUAGE DeriveFunctor         #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies          #-}
 
 module Data.Profunctor.Product.Examples where
 
 import qualified Data.Profunctor                 as P
 import qualified Data.Profunctor.Product         as PP
 import qualified Data.Profunctor.Product.Default as D
-import           Control.Applicative             (Applicative, liftA2, pure, (<*>))
+import           Control.Applicative             (Applicative, liftA2, pure, (<*>),
+                                                  ZipList(ZipList), getZipList)
 
 newtype Replicator r f a b = Replicator (r -> f b)
   deriving Functor
@@ -97,9 +99,27 @@
 
 newtype Traverse f a b = Traverse { runTraverse :: a -> f b } deriving Functor
 
+-- | Use 'sequenceT' instead.  It has a better name.
 traverseT :: D.Default (Traverse f) a b => a -> f b
 traverseT = runTraverse D.def
 
+-- | Actually, @Sequence@ is a better name for this
+type Sequence = Traverse
+
+-- | A higher-order generalisation of 'Data.Traversable.sequenceA'.  For example
+--
+-- @
+-- > sequenceT (print 3110, putStrLn "World") :: IO ((), ())
+-- 3110
+-- World
+-- ((),())
+-- @
+sequenceT :: D.Default (Sequence f) a b => a -> f b
+sequenceT = runTraverse D.def
+
+-- If we used this then inference may get better:
+--
+--    instance a ~ b => D.Default (Traverse f) (f a) b where
 instance D.Default (Traverse f) (f a) a where
   def = Traverse id
 
@@ -115,3 +135,41 @@
 instance Applicative f => PP.ProductProfunctor (Traverse f) where
   purePP = pure
   (****) = (<*>)
+
+newtype Zipper a b = Zipper { unZipper :: Traverse ZipList a b }
+  deriving Functor
+
+instance a ~ b => D.Default Zipper [a] b where
+  def = Zipper (P.dimap ZipList id D.def)
+
+-- { Boilerplate
+
+instance P.Profunctor Zipper where
+  dimap f g = Zipper . P.dimap f g . unZipper
+
+instance Applicative (Zipper a) where
+  pure = Zipper . pure
+  f <*> x = Zipper ((<*>) (unZipper f) (unZipper x))
+
+instance PP.ProductProfunctor Zipper where
+  purePP = pure
+  (****) = (<*>)
+
+-- }
+
+-- | A challenge from a Clojurist on Hacker News
+-- (https://news.ycombinator.com/item?id=23939350)
+--
+-- @
+-- > cl_map (uncurry (+)) ([1,2,3], [4,5,6])
+-- [5,7,9]
+--
+-- > cl_map (+3) [1,2,3]
+-- [4,5,6]
+--
+-- > let max3 (x, y, z) = x `max` y `max` z
+-- > cl_map max3 ([1,20], [3,4], [5,6])
+-- [5,20]
+-- @
+cl_map :: D.Default Zipper a b => (b -> r) -> a -> [r]
+cl_map f = getZipList . fmap f . runTraverse (unZipper D.def)
diff --git a/Data/Profunctor/Product/Internal/Adaptor.hs b/Data/Profunctor/Product/Internal/Adaptor.hs
--- a/Data/Profunctor/Product/Internal/Adaptor.hs
+++ b/Data/Profunctor/Product/Internal/Adaptor.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -68,14 +67,7 @@
 -- For 8.0.1 and newer versions, 'Unzip' is an independent type family
 -- and 'Unzippable' is just an empty class for backwards compatibility.
 class Unzippable (a :: k) where
-#if __GLASGOW_HASKELL__ < 800
-  type Unzip (z :: Select) a :: k
-  type Unzip z a = a
 
-instance Unzippable (f :: * -> k') => Unzippable (f a) where
-  type Unzip z (f a) = Unzip z f (Project z a)
-#else
-
 type family Unzip (z :: Select) (a :: k) :: k where
   Unzip z (f a) = Unzip' z f (Project z a)
   Unzip z a = a
@@ -83,7 +75,6 @@
 -- | A hack to enable kind-polymorphic recursion.
 type family Unzip' (z :: Select) (a :: k) :: k where
   Unzip' z a = Unzip z a
-#endif
 
 -- There is a bug in GHC < 8 apparently preventing us from using pure
 -- type families. https://ghc.haskell.org/trac/ghc/ticket/11699
diff --git a/Data/Profunctor/Product/Internal/TH.hs b/Data/Profunctor/Product/Internal/TH.hs
--- a/Data/Profunctor/Product/Internal/TH.hs
+++ b/Data/Profunctor/Product/Internal/TH.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Data.Profunctor.Product.Internal.TH where
@@ -12,26 +13,32 @@
                             Con(RecC, NormalC),
                             Clause(Clause),
                             Type(VarT, ForallT, AppT, ConT),
-                            Body(NormalB), Q, classP,
+                            Body(NormalB), Q,
                             Exp(ConE, VarE, AppE, TupE, LamE),
                             Pat(TupP, VarP, ConP), Name,
-                            Info(TyConI), reify, conE, conT, varE, varP,
-                            instanceD)
+                            Info(TyConI), reify, conE, appT, conT, varE, varP,
+                            instanceD, Overlap(Incoherent), Pred)
 import Control.Monad ((<=<))
 import Control.Applicative (pure, liftA2, (<$>), (<*>))
-import Control.Arrow (second)
 
-makeAdaptorAndInstanceI :: Maybe String -> Name -> Q [Dec]
-makeAdaptorAndInstanceI adaptorNameM = returnOrFail <=< r makeAandIE <=< reify
+makeAdaptorAndInstanceI :: Bool -> Maybe String -> Name -> Q [Dec]
+makeAdaptorAndInstanceI inferrable adaptorNameM =
+  returnOrFail <=< r makeAandIE <=< reify
   where r = (return .)
         returnOrFail (Right decs) = decs
         returnOrFail (Left errMsg) = fail errMsg
-        makeAandIE = makeAdaptorAndInstanceE adaptorNameM
+        makeAandIE = makeAdaptorAndInstanceE sides adaptorNameM
+        sides = case inferrable of
+          True  -> [Just (Left ()), Just (Right ())]
+          False -> [Nothing]
 
 type Error = String
 
-makeAdaptorAndInstanceE :: Maybe String -> Info -> Either Error (Q [Dec])
-makeAdaptorAndInstanceE adaptorNameM info = do
+makeAdaptorAndInstanceE :: [Maybe (Either () ())]
+                        -> Maybe String
+                        -> Info
+                        -> Either Error (Q [Dec])
+makeAdaptorAndInstanceE sides adaptorNameM info = do
   dataDecStuff <- dataDecStuffOfInfo info
   let tyName  = dTyName  dataDecStuff
       tyVars  = dTyVars  dataDecStuff
@@ -47,8 +54,9 @@
         ConTys   _        -> adaptorDefinition numTyVars conName
         FieldTys fieldTys -> adaptorDefinitionFields conName fieldTys
 
-      instanceDefinition' = instanceDefinition tyName numTyVars numConTys
-                                               adaptorNameN conName
+      instanceDefinition' = map (\side ->
+        instanceDefinition side tyName numTyVars numConTys adaptorNameN conName)
+        sides
 
       newtypeInstance' = if numConTys == 1 then
                            newtypeInstance conName tyName
@@ -56,9 +64,9 @@
                            return []
 
   return $ do
-    as <- sequence [ adaptorSig'
-                   , adaptorDefinition' adaptorNameN
-                   , instanceDefinition']
+    as <- sequence ( [ adaptorSig'
+                     , adaptorDefinition' adaptorNameN ]
+                   ++ instanceDefinition' )
     ns <- newtypeInstance'
     return (as ++ ns)
 
@@ -90,11 +98,7 @@
   }
 
 dataDecStuffOfInfo :: Info -> Either Error DataDecStuff
-#if __GLASGOW_HASKELL__ >= 800
 dataDecStuffOfInfo (TyConI (DataD _cxt tyName tyVars _kind constructors _deriving)) =
-#else
-dataDecStuffOfInfo (TyConI (DataD _cxt tyName tyVars constructors _deriving)) =
-#endif
   do
     (conName, conTys) <- extractConstructorStuff constructors
     let tyVars' = map varNameOfBinder tyVars
@@ -104,11 +108,7 @@
                         , dConTys  = conTys
                         }
 
-#if __GLASGOW_HASKELL__ >= 800
 dataDecStuffOfInfo (TyConI (NewtypeD _cxt tyName tyVars _kind constructor _deriving)) =
-#else
-dataDecStuffOfInfo (TyConI (NewtypeD _cxt tyName tyVars constructor _deriving)) =
-#endif
   do
     (conName, conTys) <- extractConstructorStuff [constructor]
     let tyVars' = map varNameOfBinder tyVars
@@ -124,54 +124,63 @@
 varNameOfBinder (KindedTV n _) = n
 
 conStuffOfConstructor :: Con -> Either Error (Name, ConTysFields)
-conStuffOfConstructor (NormalC conName st) = do
-  return (conName, ConTys (map snd st))
-conStuffOfConstructor (RecC conName vst) = do
-  return (conName, FieldTys (map (\(n, _, t) -> (n, t)) vst))
-
-conStuffOfConstructor _ = Left "I can't deal with your constructor type"
+conStuffOfConstructor = \case
+  NormalC conName st -> return (conName, ConTys (map snd st))
+  RecC conName vst -> return (conName, FieldTys (map (\(n, _, t) -> (n, t)) vst))
+  _ -> Left "I can't deal with your constructor type"
 
 constructorOfConstructors :: [Con] -> Either Error Con
-constructorOfConstructors [single] = return single
-constructorOfConstructors [] = Left "I need at least one constructor"
-constructorOfConstructors _many =
-  Left "I can't deal with more than one constructor"
+constructorOfConstructors = \case
+  [single] -> return single
+  []       -> Left "I need at least one constructor"
+  _many    -> Left "I can't deal with more than one constructor"
 
 extractConstructorStuff :: [Con] -> Either Error (Name, ConTysFields)
 extractConstructorStuff = conStuffOfConstructor <=< constructorOfConstructors
 
-instanceDefinition :: Name -> Int -> Int -> Name -> Name -> Q Dec
-instanceDefinition tyName' numTyVars numConVars adaptorName' conName=instanceDec
+instanceDefinition :: Maybe (Either () ())
+                   -> Name
+                   -> Int
+                   -> Int
+                   -> Name
+                   -> Name
+                   -> Q Dec
+instanceDefinition side tyName' numTyVars numConVars adaptorName' conName =
+  instanceDec
   where instanceDec = liftA2
-#if __GLASGOW_HASKELL__ >= 800
-            (\i j -> InstanceD Nothing i j [defDefinition])
-#else
-            (\i j -> InstanceD i j [defDefinition])
-#endif
+            (\i j -> InstanceD (Incoherent <$ side) i j [defDefinition])
             instanceCxt instanceType
-        p = varTS "p"
+        p :: Applicative m => m Type
+        p = pure $ varTS "p"
+        x = pure $ varTS "x"
 
-        instanceCxt = mapM (uncurry classP) (pClass:defClasses)
-        pClass :: Monad m => (Name, [m Type])
-        pClass = (''ProductProfunctor, [return p])
+        instanceCxt = do
+            typeMatch' <- sequence typeMatch
+            productProfunctor_p' <- productProfunctor_p
+            default_p_as0_as1 <- traverse default_p_a0_a1 (allTyVars numTyVars)
+            pure (productProfunctor_p' : typeMatch' ++ default_p_as0_as1)
 
-        defaultPredOfVar :: String -> (Name, [Type])
-        defaultPredOfVar fn = (''Default, [p,
-                                           mkTySuffix "0" fn,
-                                           mkTySuffix "1" fn])
+        productProfunctor_p :: Q Pred
+        productProfunctor_p = classP ''ProductProfunctor [p]
 
-        defClasses = map (second (map return) . defaultPredOfVar)
-                         (allTyVars numTyVars)
+        (typeMatch, pArg0, pArg1) = case side of
+            Nothing ->         ([],                       tyName0, tyName1)
+            Just (Left ())  -> ([ [t| $x ~ $tyName0 |] ], x,       tyName1)
+            Just (Right ()) -> ([ [t| $x ~ $tyName1 |] ], tyName0, x)
 
-        pArg :: String -> Type
-        pArg s = pArg' tyName' s numTyVars
+        tyName0 = tyName "0"
+        tyName1 = tyName "1"
 
-        instanceType = [t| $(conT ''Default)
-                           $(pure $ p)
-                           $(pure $ pArg "0")
-                           $(pure $ pArg "1")
-                         |]
+        default_p_a0_a1 :: String -> Q Pred
+        default_p_a0_a1 a  = classP ''Default [p, tvar a "0", tvar a "1"]
 
+        tvar a i = pure (mkTySuffix i a)
+
+        tyName :: String -> Q Type
+        tyName suffix = pure $ pArg' tyName' suffix numTyVars
+
+        instanceType = [t| $(conT ''Default) $p $pArg0 $pArg1 |]
+
         defDefinition = FunD 'def [simpleClause defBody]
         defBody = NormalB(VarE adaptorName' `AppE` appEAll (ConE conName) defsN)
         defsN = replicate numConVars (VarE 'def)
@@ -310,6 +319,9 @@
         body = NormalB (retCon varExps)
         varPats = map varPS (allTyVars numTyVars)
         varExps = map varS (allTyVars numTyVars)
+
+classP :: Name -> [Q Type] -> Q Type
+classP class_ = foldl appT (conT class_)
 
 tupP :: [Pat] -> Pat
 tupP [p] = p
diff --git a/Data/Profunctor/Product/TH.hs b/Data/Profunctor/Product/TH.hs
--- a/Data/Profunctor/Product/TH.hs
+++ b/Data/Profunctor/Product/TH.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
-
 -- | If you have a data declaration which is a polymorphic product,
 -- for example
 --
@@ -18,7 +16,7 @@
 -- \"adaptor\" with the following splice:
 --
 -- @
--- \$(makeAdaptorAndInstance \"pFoo\" ''Foo)
+-- \$('makeAdaptorAndInstanceInferrable' \"pFoo\" ''Foo)
 -- @
 --
 -- The adaptor for a type @Foo@ is by convention called @pFoo@, but in
@@ -26,7 +24,7 @@
 -- the name @pFoo@ yourself you can use
 --
 -- @
--- \$(makeAdaptorAndInstance' ''Foo)
+-- \$('makeAdaptorAndInstanceInferrable'' ''Foo)
 -- @
 --
 -- and it will be named @pFoo@ automatically.
@@ -34,7 +32,7 @@
 -- @pFoo@ will have the type
 --
 -- @
--- pFoo :: ProductProfunctor p
+-- pFoo :: 'Data.Profunctor.Product.ProductProfunctor' p
 --      => Foo (p a a') (p b b') (p c c')
 --      -> p (Foo a b c) (Foo a' b' c')
 -- @
@@ -42,7 +40,7 @@
 -- and the instance generated will be
 --
 -- @
--- instance (ProductProfunctor p, Default p a a', Default p b b', Default p c c')
+-- instance ('Data.Profunctor.Product.ProductProfunctor' p, Default p a a', Default p b b', Default p c c')
 --       => Default p (Foo a b c) (Foo a' b' c')
 -- @
 --
@@ -51,7 +49,7 @@
 -- (its implementation is given below).
 --
 -- @
--- pFooApplicative :: Applicative f
+-- pFooApplicative :: 'Control.Applicative.Applicative' f
 --                 => Foo (f a) (f b) (f c)
 --                 -> f (Foo a b c)
 -- @
@@ -91,32 +89,32 @@
 -- @Applicative@ case.  For an @Applicative@ we would write
 --
 -- @
--- pFooApplicative :: Applicative f
+-- pFooApplicative :: 'Control.Applicative.Applicative' f
 --                 => Foo (f a) (f b) (f c) -> f (Foo a b c)
--- pFooApplicative f = Foo \<$\> foo f
---                         \<*\> bar f
---                         \<*\> baz f
+-- pFooApplicative f = Foo 'Control.Applicative.<$>' foo f
+--                         'Control.Applicative.<*>' bar f
+--                         'Control.Applicative.<*>' baz f
 -- @
 --
 -- whereas for a @ProductProfunctor@ we write
 --
 -- @
--- import Data.Profunctor (lmap)
--- import Data.Profunctor.Product ((***$), (****))
+-- import "Data.Profunctor" ('Data.Profunctor.lmap')
+-- import "Data.Profunctor.Product" (('Data.Profunctor.Product.***$'), ('Data.Profunctor.Product.****'))
 --
--- pFoo :: ProductProfunctor p
+-- pFoo :: 'Data.Profunctor.Product.ProductProfunctor' p
 --      => Foo (p a a') (p b b') (p c c') -> p (Foo a b c) (Foo a' b' c')
--- pFoo f = Foo ***$ lmap foo (foo f)
---              **** lmap bar (bar f)
---              **** lmap baz (baz f)
+-- pFoo f = Foo 'Data.Profunctor.Product.***$' 'Data.Profunctor.lmap' foo (foo f)
+--              'Data.Profunctor.Product.****' 'Data.Profunctor.lmap' bar (bar f)
+--              'Data.Profunctor.Product.****' 'Data.Profunctor.lmap' baz (baz f)
 -- @
 --
 -- The 'Default' instance is then very simple.
 --
 -- @
--- instance (ProductProfunctor p, Default p a a', Default p b b', Default p c c')
---       => Default p (Foo a b c) (Foo a' b' c') where
---     def = pFoo (Foo def def def)
+-- instance ('Data.Profunctor.Product.ProductProfunctor' p, 'Data.Profunctor.Product.Default.Default' p a a', 'Data.Profunctor.Product.Default.Default' p b b', 'Data.Profunctor.Product.Default.Default' p c c')
+--       => 'Data.Profunctor.Product.Default.Default' p (Foo a b c) (Foo a' b' c') where
+--     'Data.Profunctor.Product.Default.def' = pFoo (Foo 'Data.Profunctor.Product.Default.def' 'Data.Profunctor.Product.Default.def' 'Data.Profunctor.Product.Default.def')
 -- @
 
 
@@ -128,21 +126,37 @@
 -- | For example
 --
 -- @
--- \$(makeAdaptorAndInstance \"pFoo\" ''Foo)
+-- \$(makeAdaptorAndInstanceInferrable \"pFoo\" ''Foo)
 -- @
 --
 -- generates the 'Default' instance and the adaptor @pFoo@.
-makeAdaptorAndInstance :: String -> TH.Name -> TH.Q [TH.Dec]
-makeAdaptorAndInstance adaptorNameS = makeAdaptorAndInstanceI (Just adaptorNameS)
+makeAdaptorAndInstanceInferrable :: String -> TH.Name -> TH.Q [TH.Dec]
+makeAdaptorAndInstanceInferrable adaptorNameS =
+  makeAdaptorAndInstanceI True (Just adaptorNameS)
 
 -- | For example
 --
 -- @
--- \$(makeAdaptorAndInstance' ''Foo)
+-- \$(makeAdaptorAndInstanceInferrable' ''Foo)
 -- @
 --
 -- generates the 'Default' instance and the adaptor @pFoo@.  The name
 -- of the adaptor is chosen by prefixing the type name \"Foo\" with
 -- the string \"p\".
+makeAdaptorAndInstanceInferrable' :: TH.Name -> TH.Q [TH.Dec]
+makeAdaptorAndInstanceInferrable' =
+  makeAdaptorAndInstanceI True Nothing
+
+-- | Use 'makeAdaptorAndInstanceInferrable' instead, because it
+-- generates instances with better inference properties.  Will be
+-- deprecated in version 0.12.
+makeAdaptorAndInstance :: String -> TH.Name -> TH.Q [TH.Dec]
+makeAdaptorAndInstance adaptorNameS =
+  makeAdaptorAndInstanceI False (Just adaptorNameS)
+
+-- | Use 'makeAdaptorAndInstanceInferrable' instead, because it
+-- generates instances with better inference properties.  Will be
+-- deprecated in version 0.12.
 makeAdaptorAndInstance' :: TH.Name -> TH.Q [TH.Dec]
-makeAdaptorAndInstance' = makeAdaptorAndInstanceI Nothing
+makeAdaptorAndInstance' =
+  makeAdaptorAndInstanceI False Nothing
diff --git a/Data/Profunctor/Product/Tuples/TH.hs b/Data/Profunctor/Product/Tuples/TH.hs
--- a/Data/Profunctor/Product/Tuples/TH.hs
+++ b/Data/Profunctor/Product/Tuples/TH.hs
@@ -151,12 +151,21 @@
 convert u u' f c = dimap u f . c . u'
 
 mkDefaultNs :: [Int] -> Q [Dec]
-mkDefaultNs = mapM mkDefaultN
+mkDefaultNs = fmap concat . mapM mkDefaultN
 
-mkDefaultN :: Int -> Q Dec
-mkDefaultN n = instanceD (sequence (productProfunctor p : mkDefs))
-                         (conT ''Default `appT` varT p `appT` mkTupT as `appT` mkTupT bs)
-                         [mkFun]
+mkDefaultN :: Int -> Q [Dec]
+mkDefaultN n =
+  sequence [ instanceWithOverlapD
+                 (Just Incoherent)
+                 (sequence (productProfunctor p : x ~~ mkTupT as : mkDefs))
+                 (conT ''Default `appT` varT p `appT` x `appT` mkTupT bs)
+                 [mkFun]
+           , instanceWithOverlapD
+                 (Just Incoherent)
+                 (sequence (productProfunctor p : x ~~ mkTupT bs : mkDefs))
+                 (conT ''Default `appT` varT p `appT` mkTupT as `appT` x)
+                 [mkFun]
+           ]
   where
     mkDefs = zipWith (\a b -> default_ p a b) as bs
     mkTupT = foldl appT (tupleT n) . map varT
@@ -165,6 +174,8 @@
       0 -> varE 'empty
       _ -> varE (mkName $ 'p':show n) `appE` tupE (replicate n (varE 'def))
     p = mkName "p"
+    x = varT (mkName "x")
+    t1 ~~ t2 = [t| $t1 ~ $t2 |]
     as = take n [ mkName $ 'a':show i | i <- [0::Int ..] ]
     bs = take n [ mkName $ 'b':show i | i <- [0::Int ..] ]
 
diff --git a/Test/CheckTypes.hs b/Test/CheckTypes.hs
--- a/Test/CheckTypes.hs
+++ b/Test/CheckTypes.hs
@@ -9,8 +9,11 @@
 
 import Definitions (Data2, Data3, Record2, Record3,
                     RecordDefaultName,
+                    Data2Inferrable(Data2Inferrable),
+                    Record2Inferrable(Record2Inferrable),
                     pData2, pData3, pRecord2, pRecord3,
-                    pRecordDefaultName)
+                    pRecordDefaultName,
+                    unArrow, Unit(Unit), point)
 import DefinitionsUndecidable ()
 
 -- The test suite checks that the TH derived adaptor is of the correct
@@ -74,6 +77,28 @@
 pRecord3G :: ProductProfunctor p
           => Record3 (p a a') (p b b') (p c c') -> p (Record3 a b c) (Record3 a' b' c')
 pRecord3G = pRecord3
+
+-- Can type inference information flow from the left type argument of
+-- a Profunctor to the right?
+inferDataLR :: ()
+inferDataLR   = const () (unArrow def (Data2Inferrable   Unit Unit))
+
+inferRecordLR :: ()
+inferRecordLR = const () (unArrow def (Record2Inferrable Unit Unit))
+
+inferTupleLR :: ()
+inferTupleLR = const () (unArrow def (Unit, Unit))
+
+-- Can type inference information flow from the right type argument of
+-- a Profunctor to the left?
+inferDataRL :: ()
+inferDataRL   = case unArrow def point of Data2Inferrable Unit Unit -> ()
+
+inferRecordRL :: ()
+inferRecordRL = case unArrow def point of Record2Inferrable Unit Unit -> ()
+
+inferTupleRL :: ()
+inferTupleRL = case unArrow def point of (Unit, Unit) -> ()
 
 data a :~: b where
   Refl :: a :~: a
diff --git a/Test/Definitions.hs b/Test/Definitions.hs
--- a/Test/Definitions.hs
+++ b/Test/Definitions.hs
@@ -3,6 +3,8 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Definitions where
 
@@ -12,10 +14,12 @@
 -- because we want to ensure that no external names are required to be
 -- imported.
 
-import Data.Profunctor.Product (ProductProfunctor, SumProfunctor)
+import Data.Profunctor
+import Data.Profunctor.Product
 import Data.Profunctor.Product.Adaptor (Unzippable)
-import Data.Profunctor.Product.Default (Default)
-import Data.Profunctor.Product.TH (makeAdaptorAndInstance, makeAdaptorAndInstance')
+import Data.Profunctor.Product.Default (Default, def)
+import Data.Profunctor.Product.TH (makeAdaptorAndInstance, makeAdaptorAndInstance',
+                                  makeAdaptorAndInstanceInferrable)
 
 data Data2 a b = Data2 a b
   deriving Generic
@@ -55,3 +59,41 @@
 
 instance (ProductProfunctor p, SumProfunctor p, Default p a a', Default p b b', Default p c c')
       => Default p (ProductAndSumGeneric a b c) (ProductAndSumGeneric a' b' c')
+
+data Data2Inferrable a b = Data2Inferrable a b
+data Record2Inferrable a b = Record2Inferrable { a2I :: a, b2I :: b } deriving Show
+
+$(makeAdaptorAndInstanceInferrable "pData2Inferrable" ''Data2Inferrable)
+$(makeAdaptorAndInstanceInferrable "pRecord2Inferrable" ''Record2Inferrable)
+
+newtype Arrow a b = Arrow { unArrow :: a -> b }
+
+instance Profunctor Arrow where
+  dimap f g = Arrow . dimap f g . unArrow
+
+instance ProductProfunctor Arrow where
+  purePP = Arrow . purePP
+  f **** g = Arrow (unArrow f **** unArrow g)
+
+data Unit = Unit
+
+class Pointed a where
+  point :: a
+
+instance Pointed Unit where
+  point = Unit
+
+instance (Pointed a, Pointed b) => Pointed (Data2Inferrable a b) where
+  point = Data2Inferrable point point
+
+instance (Pointed a, Pointed b) => Pointed (Record2Inferrable a b) where
+  point = Record2Inferrable point point
+
+instance (Pointed a, Pointed b) => Pointed (a, b) where
+  point = (point, point)
+
+instance {-# INCOHERENT #-} a ~ Unit => Default Arrow Unit a where
+  def = Arrow id
+
+instance {-# INCOHERENT #-} a ~ Unit => Default Arrow a Unit where
+  def = Arrow id
diff --git a/product-profunctors.cabal b/product-profunctors.cabal
--- a/product-profunctors.cabal
+++ b/product-profunctors.cabal
@@ -1,6 +1,6 @@
 name:          product-profunctors
 copyright:     Copyright (c) 2013, Karamaan Group LLC; 2014-2018 Purely Agile Limited; 2019-2020 Tom Ellis
-version:       0.10.0.1
+version:       0.11.0.0
 synopsis:      product-profunctors
 description:   Product profunctors and tools for working with them
 homepage:      https://github.com/tomjaguarpaw/product-profunctors