diff --git a/examples/freevars.hs b/examples/freevars.hs
new file mode 100644
--- /dev/null
+++ b/examples/freevars.hs
@@ -0,0 +1,47 @@
+-- Another go at this problem:
+-- https://github.com/sjoerdvisscher/blog/blob/master/2012/2012-03-03%20how%20to%20work%20generically%20with%20mutually%20recursive%20datatypes.md
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, FlexibleContexts, DeriveGeneric #-}
+
+import GHC.Generics
+import Generics.OneLiner
+
+data Decl = Var := Expr
+          | Seq Decl Decl
+          deriving (Eq, Show, Generic)
+
+data Expr = Con Int
+          | Add Expr Expr
+          | Mul Expr Expr
+          | EVar Var
+          | Let Decl Expr
+          deriving (Eq, Show, Generic)
+
+type Var = String
+
+class Vars t where
+  vars :: t -> [Var] -> ([Var], [Var])
+
+varsDefault :: (ADT t, Constraints t Vars) => t -> [Var] -> ([Var], [Var])
+varsDefault = gfoldMap (For :: For Vars) vars
+
+instance Vars Var where
+  vars v = const ([], [v])
+instance Vars Decl where
+  vars = varsDefault
+instance Vars Int where
+  vars = mempty
+instance Vars Expr where
+  vars (EVar v) = \bound -> (if (v `elem` bound) then [] else [v], [])
+  vars (Let d e) = \bound ->
+    let
+      (freeD, declD) = vars d bound
+      (freeE, _)     = vars e (declD ++ bound)
+    in
+      (freeD ++ freeE, [])
+  vars x = varsDefault x
+
+freeVars :: Vars t => t -> [Var]
+freeVars = fst . ($ []) . vars
+
+test :: [Var]
+test = freeVars $ Let ("x" := Con 42) (Add (EVar "x") (EVar "y"))
diff --git a/examples/freevars1.hs b/examples/freevars1.hs
new file mode 100644
--- /dev/null
+++ b/examples/freevars1.hs
@@ -0,0 +1,41 @@
+-- Another go at this problem:
+-- https://github.com/sjoerdvisscher/blog/blob/master/2012/2012-03-03%20how%20to%20work%20generically%20with%20mutually%20recursive%20datatypes.md
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, FlexibleContexts, DeriveGeneric, ScopedTypeVariables, MultiParamTypeClasses #-}
+
+import GHC.Generics
+import Generics.OneLiner
+
+data Decl a b = a := Expr a b
+              | Seq (Decl a b) (Decl a b)
+              deriving (Eq, Show, Generic1)
+
+data Expr a b = Con Int
+              | Add (Expr a b) (Expr a b)
+              | Mul (Expr a b) (Expr a b)
+              | EVar b
+              | Let (Decl a b) (Expr a b)
+              deriving (Eq, Show, Generic1)
+
+class Vars a t where
+  vars1 :: (b -> [a] -> ([a], [a])) -> t b -> [a] -> ([a], [a])
+
+vars1Default :: forall a b t. (ADT1 t, Constraints1 t (Vars a)) => (b -> [a] -> ([a], [a])) -> t b -> [a] -> ([a], [a])
+vars1Default = gfoldMap1 (For :: For (Vars a)) vars1
+
+instance Vars a (Decl a) where
+  vars1 f (v := e) = const ([], [v]) `mappend` vars1 f e
+  vars1 f x = vars1Default f x
+instance Vars a (Expr a) where
+  vars1 f (Let d e) = \bound ->
+    let
+      (freeD, declD) = vars1 f d bound
+      (freeE, _)     = vars1 f e (declD ++ bound)
+    in
+      (freeD ++ freeE, [])
+  vars1 f x = vars1Default f x
+
+freeVars :: (Eq a, Vars a t) => t a -> [a]
+freeVars = fst . ($ []) . vars1 (\v bound -> (if (v `elem` bound) then [] else [v], []))
+
+test :: [String]
+test = freeVars $ Let (Seq ("x" := Con 42) ("q" := EVar "z")) (Add (EVar "x") (EVar "y"))
diff --git a/examples/lenses.hs b/examples/lenses.hs
new file mode 100644
--- /dev/null
+++ b/examples/lenses.hs
@@ -0,0 +1,59 @@
+-- This is a go at creating lenses with one-liner.
+-- It is not a perfect match, but with some unsafeCoerce here and there it works.
+{-# LANGUAGE RankNTypes, TypeOperators, DefaultSignatures, FlexibleContexts, DeriveGeneric, DeriveAnyClass #-}
+import Generics.OneLiner
+import Data.Profunctor
+import GHC.Generics
+import Control.Applicative
+import Unsafe.Coerce (unsafeCoerce)
+
+type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
+type Key t = forall x. Lens (t x) (t x) x x
+
+constLens :: x -> Lens s t a b -> x
+constLens x _ = x
+
+index :: f a -> Key f -> a
+index f l = getConst $ l Const f
+
+
+newtype Lensed s t a b = Lensed { getLensed :: Lens s t a b -> b }
+instance Profunctor (Lensed s t) where
+  dimap f g (Lensed ix) = Lensed $ \l -> g (ix (l . (fmap g .) . (. f)))
+instance GenericRecordProfunctor (Lensed s t) where
+  unit = Lensed (constLens U1)
+  mult (Lensed a) (Lensed b) = Lensed (\l -> a (l . fstl) :*: b (l . sndl))
+
+-- GenericRecordProfunctor is a bit too polymorphic,
+-- but we can use unsafeCoerce because the types will end up being the same anyway.
+fstl :: Lens ((a :*: b) x) ((c :*: b') x') (a x) (c x')
+fstl f (a :*: b) = (\c -> c :*: unsafeCoerce b) <$> f a
+sndl :: Lens ((a :*: b) x) ((a' :*: c) x') (b x) (c x')
+sndl f (a :*: b) = (\c -> unsafeCoerce a :*: c) <$> f b
+
+
+class Repr f where
+
+  lensed :: (Lens s t a b -> b) -> Lens s t (f a) (f b) -> f b
+  default lensed :: (ADTRecord1 f, Constraints1 f Repr) => (Lens s t a b -> b) -> Lens s t (f a) (f b) -> f b
+  lensed f = getLensed $ record1 (For :: For Repr) (\(Lensed g) -> Lensed $ lensed g) (Lensed f)
+
+  tabulate :: (Key f -> a) -> f a
+  tabulate f = lensed (\l -> f (runKey (unsafeCoerce (Lens l)))) id
+
+-- Two wrappers needed to make unsafeCoerce happy
+newtype WrappedLens s t a b = Lens { runLens :: Lens s t a b }
+newtype WrappedKey t = Key { runKey :: Key t }
+
+
+data V3 a = V3 a a a deriving (Show, Generic1, Repr)
+data V10 a = V10 a (V3 (V3 a)) deriving (Show, Generic1, Repr)
+
+instance Functor V3 where
+  fmap f v = tabulate (\k -> f (index v k))
+instance Applicative V3 where
+  pure a = tabulate (constLens a)
+  fs <*> as = tabulate (\k -> index fs k (index as k))
+instance Monad V3 where
+  return = pure
+  as >>= f = tabulate (\k -> f (as `index` k) `index` k)
diff --git a/examples/realworld.hs b/examples/realworld.hs
--- a/examples/realworld.hs
+++ b/examples/realworld.hs
@@ -11,6 +11,7 @@
 import Control.Monad.Logic.Class
 import Control.Monad
 import Data.Hashable
+import Data.Functor.Classes
 import Data.Functor.Compose
 import Data.Functor.Contravariant
 import Data.Functor.Contravariant.Divisible
@@ -83,11 +84,12 @@
 gcoarbitrary = unCoArb $ consume (For :: For CoArbitrary) (CoArb coarbitrary)
 
 
--- -- http://hackage.haskell.org/package/lens-4.3.3/docs/Generics-Deriving-Lens.html
--- whenCastableOrElse :: forall a b f. (Typeable a, Typeable b) => (b -> f b) -> (a -> f a) -> a -> f a
--- whenCastableOrElse f g = maybe g (\Refl -> f) (eqT :: Maybe (a :~: b))
---
--- tinplate :: forall t b. (Typeable b, Deep Typeable t) => Traversal' t b
--- tinplate f
---   | isAtom (Proxy :: Proxy t) = f `whenCastableOrElse` pure
---   | otherwise = gtraverse (For :: For (Deep Typeable)) $ f `whenCastableOrElse` tinplate f
+liftCompareDefault :: (ADT1 f, Constraints1 f Ord1) => (a -> a -> Ordering) -> f a -> f a -> Ordering
+liftCompareDefault = mzipWith1 (For :: For Ord1) liftCompare
+
+infixr 9 .:
+(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
+(.:) = (.) . (.)
+
+liftEqDefault :: (ADT1 f, Constraints1 f Eq1) => (a -> a -> Bool) -> f a -> f a -> Bool
+liftEqDefault = (getAll .:) . mzipWith1 (For :: For Eq1) ((All .:) . liftEq . (getAll .:)) . (All .:)
diff --git a/examples/tinplate.hs b/examples/tinplate.hs
new file mode 100644
--- /dev/null
+++ b/examples/tinplate.hs
@@ -0,0 +1,54 @@
+-- http://hackage.haskell.org/package/lens-4.15.1/docs/Data-Data-Lens.html#v:tinplate
+{-# LANGUAGE
+  DataKinds,
+  TypeFamilies,
+  TypeOperators,
+  FlexibleContexts,
+  FlexibleInstances,
+  ScopedTypeVariables,
+  UndecidableInstances,
+  MultiParamTypeClasses
+  #-}
+
+import Generics.OneLiner
+import Data.Proxy
+import Data.Type.Equality
+
+import Data.Functor.Identity
+
+
+class TinplateHelper (p :: Bool) a b where
+  trav' :: Applicative f => proxy p -> (a -> f a) -> b -> f b
+
+instance TinplateHelper 'True a a where trav' _ f = f
+
+instance {-# OVERLAPPABLE #-} (ADT b, Constraints b (TinplateAlias a)) => TinplateHelper 'False a b where
+  trav' _ = tinplate
+
+instance TinplateHelper 'False a Char where trav' _ _ = pure
+instance TinplateHelper 'False a Double where trav' _ _ = pure
+instance TinplateHelper 'False a Float where trav' _ _ = pure
+instance TinplateHelper 'False a Int where trav' _ _ = pure
+instance TinplateHelper 'False a Word where trav' _ _ = pure
+
+class TinplateAlias a b where
+  trav :: Applicative f => (a -> f a) -> b -> f b
+instance TinplateHelper (a == b) a b => TinplateAlias a b where
+  trav = trav' (Proxy :: Proxy (a == b))
+
+
+tinplate :: forall a b f. (ADT b, Constraints b (TinplateAlias a), Applicative f) => (a -> f a) -> b -> f b
+tinplate f = gtraverse (For :: For (TinplateAlias a)) (trav f)
+
+
+
+test1, test2 :: [[(Char, Int)]] -> [[(Char, Int)]]
+test1 = runIdentity . tinplate (Identity . f) where
+  f :: Char -> Char
+  f = succ
+test2 = runIdentity . tinplate (Identity . f) where
+  f :: Int -> Int
+  f = succ
+
+test12 :: [[(Char, Int)]]
+test12 = test1 as ++ test2 as where as = [[('x', 1)], [('y', 2)]]
diff --git a/one-liner.cabal b/one-liner.cabal
--- a/one-liner.cabal
+++ b/one-liner.cabal
@@ -1,5 +1,5 @@
 Name:                 one-liner
-Version:              0.7
+Version:              0.8
 Synopsis:             Constraint-based generics
 Description:          Write short and concise generic instances of type classes.
                       one-liner is particularly useful for writing default
diff --git a/src/Generics/OneLiner.hs b/src/Generics/OneLiner.hs
--- a/src/Generics/OneLiner.hs
+++ b/src/Generics/OneLiner.hs
@@ -97,12 +97,12 @@
 -- | `createA1` is `generic1` specialized to `Joker`.
 createA1 :: (ADT1 t, Constraints1 t c, Alternative f)
          => for c -> (forall b s. c s => f b -> f (s b)) -> f a -> f (t a)
-createA1 for f p = runJoker $ generic1 for (Joker . f . runJoker) (Joker p)
+createA1 for f = dimap Joker runJoker $ generic1 for $ dimap runJoker Joker f
 
 -- | `consume1` is `generic1` specialized to `Clown`.
 consume1 :: (ADT1 t, Constraints1 t c, Decidable f)
          => for c -> (forall b s. c s => f b -> f (s b)) -> f a -> f (t a)
-consume1 for f p = runClown $ generic1 for (Clown . f . runClown) (Clown p)
+consume1 for f = dimap Clown runClown $ generic1 for $ dimap runClown Clown f
 
 
 -- | Map over a structure, updating each component.
@@ -150,7 +150,7 @@
 -- `gfoldMap1` is `gtraverse1` specialized to `Const`.
 gfoldMap1 :: (ADT1 t, Constraints1 t c, Monoid m)
           => for c -> (forall s b. c s => (b -> m) -> s b -> m) -> (a -> m) -> t a -> m
-gfoldMap1 for f g = getConst . gtraverse1 for ((Const .) . f . (getConst .)) (Const . g)
+gfoldMap1 for f = dimap (Const .) (getConst .) $ gtraverse1 for $ dimap (getConst .) (Const .) f
 
 -- |
 -- @
@@ -160,7 +160,7 @@
 -- `gtraverse1` is `generic1` specialized to `Star`.
 gtraverse1 :: (ADT1 t, Constraints1 t c, Applicative f)
            => for c -> (forall d e s. c s => (d -> f e) -> s d -> f (s e)) -> (a -> f b) -> t a -> f (t b)
-gtraverse1 for f g = runStar $ generic1 for (Star . f . runStar) (Star g)
+gtraverse1 for f = dimap Star runStar $ generic1 for $ dimap runStar Star f
 
 -- | Combine two values by combining each component of the structures to a monoid, and combine the results.
 -- Returns `mempty` if the constructors don't match.
@@ -172,7 +172,7 @@
 -- `mzipWith` is `zipWithA` specialized to @`Compose` `Maybe` (`Const` m)@
 mzipWith :: (ADT t, Constraints t c, Monoid m)
          => for c -> (forall s. c s => s -> s -> m) -> t -> t -> m
-mzipWith for f = outm2 $ zipWithA for (inm2 f)
+mzipWith for f = outm2 $ zipWithA for $ inm2 f
 
 -- | Combine two values by combining each component of the structures with the given function, under an applicative effect.
 -- Returns `empty` if the constructors don't match.
@@ -182,19 +182,19 @@
 
 -- |
 -- @
--- liftCompare = mzipWith (For :: For Ord1) liftCompare
+-- liftCompare = mzipWith1 (For :: For Ord1) liftCompare
 -- @
 --
 -- `mzipWith1` is `zipWithA1` specialized to @`Compose` `Maybe` (`Const` m)@
 mzipWith1 :: (ADT1 t, Constraints1 t c, Monoid m)
           => for c -> (forall s b. c s => (b -> b -> m) -> s b -> s b -> m)
           -> (a -> a -> m) -> t a -> t a -> m
-mzipWith1 for f p = outm2 $ zipWithA1 for (inm2 . f . outm2) (inm2 p)
+mzipWith1 for f = dimap inm2 outm2 $ zipWithA1 for $ dimap outm2 inm2 f
 
 zipWithA1 :: (ADT1 t, Constraints1 t c, Alternative f)
           => for c -> (forall d e s. c s => (d -> d -> f e) -> s d -> s d -> f (s e))
           -> (a -> a -> f b) -> t a -> t a -> f (t b)
-zipWithA1 for f p = runZip $ generic1 for (Zip . f . runZip) (Zip p)
+zipWithA1 for f = dimap Zip runZip $ generic1 for $ dimap runZip Zip f
 
 
 newtype Zip f a b = Zip { runZip :: a -> a -> f b }
@@ -210,11 +210,12 @@
     h _ _ = empty
 instance Alternative f => GenericProfunctor (Zip f) where
   zero = Zip absurd
+  identity = Zip $ \_ _ -> empty
 
 inm2 :: (t -> t -> m) -> t -> t -> Compose Maybe (Const m) a
-inm2 f x y = Compose $ Just $ Const $ f x y
+inm2 f = Compose .: Just .: Const .: f
 outm2 :: Monoid m => (t -> t -> Compose Maybe (Const m) a) -> t -> t -> m
-outm2 f x y = maybe mempty getConst $ getCompose (f x y)
+outm2 f = maybe mempty getConst .: getCompose .: f
 
 -- | Implement a nullary operator by calling the operator for each component.
 --
@@ -248,7 +249,7 @@
 -- `binaryOp` is `algebra` specialized to pairs.
 binaryOp :: (ADTRecord t, Constraints t c)
          => for c -> (forall s. c s => s -> s -> s) -> t -> t -> t
-binaryOp for f l r = algebra for (\(Pair a b) -> f a b) (Pair l r)
+binaryOp for f = algebra for (\(Pair a b) -> f a b) .: Pair
 
 data Pair a = Pair a a
 instance Functor Pair where
@@ -280,3 +281,7 @@
 gcotraverse1 :: (ADTRecord1 t, Constraints1 t c, Functor f)
              => for c -> (forall d e s. c s => (f d -> e) -> f (s d) -> s e) -> (f a -> b) -> f (t a) -> t b
 gcotraverse1 for f p = runCostar $ record1 for (Costar . f . runCostar) (Costar p)
+
+infixr 9 .:
+(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
+(.:) = (.) . (.)
diff --git a/src/Generics/OneLiner/Internal.hs b/src/Generics/OneLiner/Internal.hs
--- a/src/Generics/OneLiner/Internal.hs
+++ b/src/Generics/OneLiner/Internal.hs
@@ -85,6 +85,7 @@
 type instance Constraints1' (f :.: g) c = (c f, Constraints1' g c)
 type instance Constraints1' Par1 c = ()
 type instance Constraints1' (Rec1 f) c = c f
+type instance Constraints1' (K1 i v) c = ()
 type instance Constraints1' (M1 i t f) c = Constraints1' f c
 
 class ADT1' (t :: * -> *) where
@@ -106,6 +107,7 @@
 instance ADT1' g => ADT1' (f :.: g) where generic1' for f p = dimap unComp1 Comp1 $ f (generic1' for f p)
 instance ADT1' Par1 where generic1' _ _ = dimap unPar1 Par1
 instance ADT1' (Rec1 f) where generic1' _ f p = dimap unRec1 Rec1 (f p)
+instance ADT1' (K1 i v) where generic1' _ _ _ = dimap unK1 K1 identity
 instance ADT1' f => ADT1' (M1 i t f) where generic1' for f p = dimap unM1 M1 (generic1' for f p)
 
 instance ADTNonEmpty1' U1 where nonEmpty1' _ _ _ = unit
@@ -152,9 +154,11 @@
   plus :: p (f a) (f' a') -> p (g a) (g' a') -> p ((f :+: g) a) ((f' :+: g') a')
 
 -- | A generic function using a `GenericProfunctor` works on any
--- algebraic data type, including those with no constructors.
+-- algebraic data type, including those with no constructors and constants.
 class GenericNonEmptyProfunctor p => GenericProfunctor p where
+  identity :: p a a
   zero :: p (V1 a) (V1 a')
+  zero = lmap absurd identity
 
 instance GenericRecordProfunctor (->) where
   unit _ = U1
@@ -163,6 +167,7 @@
   plus f g = e1 (L1 . f) (R1 . g)
 instance GenericProfunctor (->) where
   zero = absurd
+  identity = id
 
 instance GenericRecordProfunctor Tagged where
   unit = Tagged U1
@@ -175,6 +180,7 @@
   plus (Star f) (Star g) = Star $ e1 (fmap L1 . f) (fmap R1 . g)
 instance Applicative f => GenericProfunctor (Star f) where
   zero = Star absurd
+  identity = Star pure
 
 instance Functor f => GenericRecordProfunctor (Costar f) where
   unit = Costar $ const U1
@@ -191,6 +197,7 @@
   plus (Joker l) (Joker r) = Joker $ L1 <$> l <|> R1 <$> r
 instance Alternative f => GenericProfunctor (Joker f) where
   zero = Joker empty
+  identity = Joker empty
 
 instance Divisible f => GenericRecordProfunctor (Clown f) where
   unit = Clown conquer
@@ -198,7 +205,8 @@
 instance Decidable f => GenericNonEmptyProfunctor (Clown f) where
   plus (Clown f) (Clown g) = Clown $ choose (e1 Left Right) f g where
 instance Decidable f => GenericProfunctor (Clown f) where
-  zero = Clown $ lose (\v -> v `seq` undefined)
+  zero = Clown $ lose absurd
+  identity = Clown conquer
 
 instance (GenericRecordProfunctor p, GenericRecordProfunctor q) => GenericRecordProfunctor (Product p q) where
   unit = Pair unit unit
@@ -207,6 +215,7 @@
   plus (Pair l1 r1) (Pair l2 r2) = Pair (plus l1 l2) (plus r1 r2)
 instance (GenericProfunctor p, GenericProfunctor q) => GenericProfunctor (Product p q) where
   zero = Pair zero zero
+  identity = Pair identity identity
 
 instance (Applicative f, GenericRecordProfunctor p) => GenericRecordProfunctor (Tannen f p) where
   unit = Tannen (pure unit)
@@ -215,6 +224,7 @@
   plus (Tannen l) (Tannen r) = Tannen $ liftA2 plus l r
 instance (Applicative f, GenericProfunctor p) => GenericProfunctor (Tannen f p) where
   zero = Tannen (pure zero)
+  identity = Tannen (pure identity)
 
 data Ctor a b = Ctor { index :: a -> Int, count :: Int }
 instance Profunctor Ctor where
@@ -226,6 +236,7 @@
   plus l r = Ctor (e1 (index l) ((count l + ) . index r)) (count l + count r)
 instance GenericProfunctor Ctor where
   zero = Ctor (const 0) 0
+  identity = Ctor (const 0) 1
 
 record :: (ADTRecord t, Constraints t c, GenericRecordProfunctor p)
        => for c -> (forall s. c s => p s s) -> p t t