diff --git a/.travis.yml b/.travis.yml
--- a/.travis.yml
+++ b/.travis.yml
@@ -1,10 +1,55 @@
-language: haskell
+# NB: don't set `language: haskell` here
 
+# See also https://github.com/hvr/multi-ghc-travis for more information
+
+# The following lines enable several GHC versions and/or HP versions
+# to be tested; often it's enough to test only against the last
+# release of a major GHC version. Setting HPVER implictly sets
+# GHCVER. Omit lines with versions you don't need/want testing for.
 env:
-  - GHCVER=7.8.4
+ - CABALVER=1.18 GHCVER=7.8.4
+ - CABALVER=1.22 GHCVER=7.10.1
 
+# Note: the distinction between `before_install` and `install` is not
+#       important.
 before_install:
-  - sudo add-apt-repository -y ppa:hvr/ghc
-  - sudo apt-get update
-  - sudo apt-get install -y -qq cabal-install-1.22 ghc-$GHCVER
-  - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/1.20/bin:$PATH
+ - travis_retry sudo add-apt-repository -y ppa:hvr/ghc
+ - travis_retry sudo apt-get update
+ - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER
+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
+
+install:
+ - cabal --version
+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
+ - travis_retry cabal update
+ - cabal install --only-dependencies --enable-tests --enable-benchmarks
+
+# Here starts the actual work to be performed for the package under
+# test; any command which exits with a non-zero exit code causes the
+# build to fail.
+script:
+ - if [ -f configure.ac ]; then autoreconf -i; fi
+ # -v2 provides useful information for debugging
+ - cabal configure --enable-tests --enable-benchmarks -v2
+
+ # this builds all libraries and executables
+ # (including tests/benchmarks)
+ - cabal build
+
+ - cabal test
+ - cabal check
+
+ # tests that a source-distribution can be generated
+ - cabal sdist
+
+ # check that the generated source-distribution can be built & installed
+ - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;
+   cd dist/;
+   if [ -f "$SRC_TGZ" ]; then
+      cabal install --force-reinstalls "$SRC_TGZ";
+   else
+      echo "expected '$SRC_TGZ' not found";
+      exit 1;
+   fi
+
+# EOF
diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,16 @@
+0.3.3
+-----------------------------------------------------
+* Renamed `sectorAt`, `sector`, `sectorAssoc` to `pieceAt`, `piece`, `pieceAssoc`, respectively
+* `picked` is now subsumed by `piece`
+    * `mkField` yields more generalized optics
+* Renamed `UnionAt` to `EmbedAt`
+* Removed `clause`; Use `piece . _Match`
+* Removed `record`; Use `piece . _K0`
+* Added `htraverseWithIndex`
+* Renamed `ord` to `mkMembership`
+* Fixed the `Show` instance of `:|`
+* Added `Variant`
+
 0.3.2
 -----------------------------------------------------
 * Added `Associate` class and combinators around it
diff --git a/examples/records.hs b/examples/records.hs
--- a/examples/records.hs
+++ b/examples/records.hs
@@ -5,7 +5,8 @@
 
 mkField "name weight price description featured quantity"
 
-type Stock c = Record '["name" :> String
+type Stock c = Record '[
+    "name" :> String
   , "weight" :> Float
   , "price" :> c
   , "featured" :> Bool
@@ -21,7 +22,7 @@
   <: Field 20
   <: Nil
 
--- Use shrink to permute elements
+-- Use shrinkAssoc to permute elements
 s1 :: Num c => Stock c
 s1 = shrinkAssoc
    $ name @= "HHP-150"
diff --git a/extensible.cabal b/extensible.cabal
--- a/extensible.cabal
+++ b/extensible.cabal
@@ -1,5 +1,5 @@
 name:                extensible
-version:             0.3.2
+version:             0.3.3
 synopsis:            Extensible, efficient, lens-friendly data types
 homepage:            https://github.com/fumieval/extensible
 bug-reports:         http://github.com/fumieval/extensible/issues
@@ -29,6 +29,7 @@
 library
   exposed-modules:
     Data.Extensible
+    Data.Extensible.Class
     Data.Extensible.Dictionary
     Data.Extensible.Inclusion
     Data.Extensible.Internal
@@ -50,7 +51,7 @@
     , FlexibleInstances
     , PolyKinds
     , CPP
-  build-depends:       base >= 4.7 && <5, template-haskell, binary < 1, constraints
+  build-depends:       base >= 4.7 && <5, template-haskell, constraints, profunctors
   hs-source-dirs:      src
-  ghc-options: -Wall -O2
+  ghc-options: -Wall
   default-language:    Haskell2010
diff --git a/src/Data/Extensible.hs b/src/Data/Extensible.hs
--- a/src/Data/Extensible.hs
+++ b/src/Data/Extensible.hs
@@ -23,7 +23,8 @@
 -----------------------------------------------------------------------------
 module Data.Extensible (
   -- * Reexport
-  module Data.Extensible.Dictionary
+  module Data.Extensible.Class
+  , module Data.Extensible.Dictionary
   , module Data.Extensible.Inclusion
   , module Data.Extensible.Match
   , module Data.Extensible.Plain
@@ -33,14 +34,13 @@
   , Comp(..)
   , comp
   ) where
+
+import Data.Extensible.Class
+import Data.Extensible.Dictionary
 import Data.Extensible.Inclusion
+import Data.Extensible.Internal.Rig
 import Data.Extensible.Match
 import Data.Extensible.Plain
 import Data.Extensible.Product
-import Data.Extensible.Sum
 import Data.Extensible.Record
-import Data.Extensible.Internal.Rig
-import Data.Extensible.Dictionary
-
--------------------------------------------------------------
-
+import Data.Extensible.Sum
diff --git a/src/Data/Extensible/Class.hs b/src/Data/Extensible/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Extensible/Class.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Data.Extensible.Class (
+  -- * Class
+   Extensible(..)
+  , piece
+  , pieceAssoc
+  -- * Membership
+  , Membership
+  , mkMembership
+  -- * Member
+  , Member(..)
+  , remember
+  , (∈)()
+  , FindType
+  -- * Association
+  , Assoc(..)
+  , Associate(..)
+  , FindAssoc
+  -- * Sugar
+  , Elaborate
+  , Elaborated(..)
+  ) where
+import Data.Extensible.Internal
+
+-- | This class allows us to use 'pieceAt' for both sums and products.
+class Extensible f p q (t :: (k -> *) -> [k] -> *) where
+  pieceAt :: Membership xs x -> p (h x) (f (h x)) -> q (t h xs) (f (t h xs))
+
+-- | Accessor for an element.
+piece :: (x ∈ xs, Extensible f p q t) => p (h x) (f (h x)) -> q (t h xs) (f (t h xs))
+piece = pieceAt membership
+{-# INLINE piece #-}
+
+-- | Like 'piece', but reckon membership from its key.
+pieceAssoc :: (Associate k v xs, Extensible f p q t) => p (h (k ':> v)) (f (h (k ':> v))) -> q (t h xs) (f (t h xs))
+pieceAssoc = pieceAt association
+{-# INLINE pieceAssoc #-}
diff --git a/src/Data/Extensible/Dictionary.hs b/src/Data/Extensible/Dictionary.hs
--- a/src/Data/Extensible/Dictionary.hs
+++ b/src/Data/Extensible/Dictionary.hs
@@ -10,17 +10,18 @@
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- Reifying some classes to make instances for (':*') and (':|')
+-- Reifying classes to make instances for (':*') and (':|')
 -----------------------------------------------------------------------
 module Data.Extensible.Dictionary where
 import Data.Monoid
+import Data.Extensible.Class
 import Data.Extensible.Product
 import Data.Extensible.Sum
 import Data.Extensible.Internal
 import Data.Extensible.Internal.Rig
-import qualified Data.Binary as B
 import Data.Constraint
 
+-- | Reify a collection of dictionaries, as you wish.
 library :: forall c xs. Forall c xs => Comp Dict c :* xs
 library = htabulateFor (Proxy :: Proxy c) $ const (Comp Dict)
 {-# INLINE library #-}
@@ -49,24 +50,22 @@
   mappend xs ys = hzipWith3 (\(Comp Dict) -> mappend) (library :: Comp Dict (Instance1 Monoid h) :* xs) xs ys
   {-# INLINE mappend #-}
 
-instance WrapForall B.Binary h xs => B.Binary (h :* xs) where
-  get = hgenerateFor (Proxy :: Proxy (Instance1 B.Binary h)) (const B.get)
-  put = flip appEndo (return ()) . hfoldMap getConst' . hzipWith (\(Comp Dict) x -> Const' $ Endo $ (B.put x >>)) (library :: Comp Dict (Instance1 B.Binary h) :* xs)
-
 instance WrapForall Show h xs => Show (h :| xs) where
-  showsPrec d (UnionAt pos h) = showParen (d > 10) $ showString "embed "
-    . views (sectorAt pos) (\(Comp Dict) -> showsPrec 11 h) (library :: Comp Dict (Instance1 Show h) :* xs)
+  showsPrec d (EmbedAt i h) = showParen (d > 10) $ showString "EmbedAt "
+    . showsPrec 11 i
+    . showString " "
+    . views (pieceAt i) (\(Comp Dict) -> showsPrec 11 h) (library :: Comp Dict (Instance1 Show h) :* xs)
 
 instance WrapForall Eq h xs => Eq (h :| xs) where
-  UnionAt p g == UnionAt q h = case compareMembership p q of
+  EmbedAt p g == EmbedAt q h = case compareMembership p q of
     Left _ -> False
-    Right Refl -> views (sectorAt p) (\(Comp Dict) -> g == h) (library :: Comp Dict (Instance1 Eq h) :* xs)
+    Right Refl -> views (pieceAt p) (\(Comp Dict) -> g == h) (library :: Comp Dict (Instance1 Eq h) :* xs)
   {-# INLINE (==) #-}
 
 instance (Eq (h :| xs), WrapForall Ord h xs) => Ord (h :| xs) where
-  UnionAt p g `compare` UnionAt q h = case compareMembership p q of
+  EmbedAt p g `compare` EmbedAt q h = case compareMembership p q of
     Left x -> x
-    Right Refl -> views (sectorAt p) (\(Comp Dict) -> compare g h) (library :: Comp Dict (Instance1 Ord h) :* xs)
+    Right Refl -> views (pieceAt p) (\(Comp Dict) -> compare g h) (library :: Comp Dict (Instance1 Ord h) :* xs)
   {-# INLINE compare #-}
 
 -- | Forall upon a wrapper
diff --git a/src/Data/Extensible/Inclusion.hs b/src/Data/Extensible/Inclusion.hs
--- a/src/Data/Extensible/Inclusion.hs
+++ b/src/Data/Extensible/Inclusion.hs
@@ -12,25 +12,13 @@
 --
 ------------------------------------------------------------------------
 module Data.Extensible.Inclusion (
-  -- * Membership
-    Membership
-  , runMembership
-  , (∈)()
-  , Member(..)
-  , remember
-  , Expecting
-  , Missing
-  , Ambiguous
-  , ord
-  , Assoc(..)
-  , Associate(..)
   -- * Inclusion
-  , (⊆)()
+   (⊆)()
   , Include
   , inclusion
   , shrink
   , spread
-  -- * Dictionary-like
+  -- * Key-value
   , IncludeAssoc
   , Associated
   , inclusionAssoc
@@ -45,6 +33,7 @@
   , mapNullable
   ) where
 
+import Data.Extensible.Class
 import Data.Extensible.Product
 import Data.Extensible.Sum
 import Data.Extensible.Internal
@@ -60,22 +49,23 @@
 -- | Reify the inclusion of type level sets.
 inclusion :: forall xs ys. Include ys xs => Membership ys :* xs
 inclusion = htabulateFor (Proxy :: Proxy (Member ys)) (const membership)
+{-# INLINABLE inclusion #-}
 
 -- | /O(m log n)/ Select some elements.
 shrink :: (xs ⊆ ys) => h :* ys -> h :* xs
-shrink h = hmap (`hlookup` h) inclusion
+shrink h = hmap (hindex h) inclusion
 {-# INLINE shrink #-}
 
 -- | /O(log n)/ Embed to a larger union.
 spread :: (xs ⊆ ys) => h :| xs -> h :| ys
-spread (UnionAt pos h) = views (sectorAt pos) UnionAt inclusion h
+spread (EmbedAt i h) = views (pieceAt i) EmbedAt inclusion h
 {-# INLINE spread #-}
 
 -- | The inverse of 'inclusion'.
 coinclusion :: (Include ys xs, Generate ys) => Nullable (Membership xs) :* ys
 coinclusion = flip appEndo (htabulate (const Null))
   $ hfoldMap getConst'
-  $ hmapWithIndex (\src dst -> Const' $ Endo $ sectorAt dst `over` const (Eine src))
+  $ hmapWithIndex (\src dst -> Const' $ Endo $ pieceAt dst `over` const (Eine src))
   $ inclusion
 
 -- | Extend a product and fill missing fields by 'Null'.
@@ -85,7 +75,7 @@
 
 -- | Narrow the range of the sum, if possible.
 retrench :: (Generate ys, xs ⊆ ys) => h :| ys -> Nullable ((:|) h) xs
-retrench (UnionAt pos h) = views (sectorAt pos) (mapNullable (`UnionAt`h)) coinclusion
+retrench (EmbedAt i h) = views (pieceAt i) (mapNullable (`EmbedAt`h)) coinclusion
 {-# INLINE retrench #-}
 
 ------------------------------------------------------------------
@@ -95,20 +85,22 @@
 
 instance Associate k v xs => Associated xs (k ':> v) where
   getAssociation = association
+  {-# INLINE getAssociation #-}
 
--- | Similar to 'Include', but works nicely for key-value pairs.
-type IncludeAssoc ys xs = Forall (Associated ys) xs
+-- | Similar to 'Include', but this focuses on keys.
+type IncludeAssoc ys = Forall (Associated ys)
 
 -- | Reify the inclusion of type level sets.
 inclusionAssoc :: forall xs ys. IncludeAssoc ys xs => Membership ys :* xs
 inclusionAssoc = htabulateFor (Proxy :: Proxy (Associated ys)) (const getAssociation)
+{-# INLINABLE inclusionAssoc #-}
 
 -- | /O(m log n)/ Select some elements.
 shrinkAssoc :: (IncludeAssoc ys xs) => h :* ys -> h :* xs
-shrinkAssoc h = hmap (`hlookup` h) inclusionAssoc
+shrinkAssoc h = hmap (hindex h) inclusionAssoc
 {-# INLINE shrinkAssoc #-}
 
 -- | /O(log n)/ Embed to a larger union.
 spreadAssoc :: (IncludeAssoc ys xs) => h :| xs -> h :| ys
-spreadAssoc (UnionAt pos h) = views (sectorAt pos) UnionAt inclusionAssoc h
+spreadAssoc (EmbedAt i h) = views (pieceAt i) EmbedAt inclusionAssoc h
 {-# INLINE spreadAssoc #-}
diff --git a/src/Data/Extensible/Internal.hs b/src/Data/Extensible/Internal.hs
--- a/src/Data/Extensible/Internal.hs
+++ b/src/Data/Extensible/Internal.hs
@@ -15,33 +15,36 @@
 --
 -- A bunch of combinators that contains magic
 ------------------------------------------------------------------------
-module Data.Extensible.Internal (Membership
+module Data.Extensible.Internal (
+  -- * Membership
+  Membership
   , getMemberId
+  , mkMembership
   , runMembership
   , compareMembership
-  , ord
+  -- * Member class
+  , Member(..)
+  , remember
+  , (∈)()
+  , FindType
+  -- * Association
+  , Assoc(..)
+  , Associate(..)
+  , FindAssoc
+  -- * Sugar
+  , Elaborate
+  , Elaborated(..)
+  -- * Tree navigation
   , NavHere(..)
   , navigate
   , here
   , navNext
   , navL
   , navR
-  , (:*)(..)
-  , Member(..)
-  , remember
-  , (∈)()
+  -- * Miscellaneous
   , Nat(..)
-  , ToInt(..)
-  , Lookup
-  , ListIndex
-  , Assoc(..)
-  , AssocKeys
-  , Associate(..)
-  , LookupTree(..)
+  , KnownPosition(..)
   , Succ
-  , MapSucc
-  , Pred
-  , Div2
   , Half
   , Head
   , Tail
@@ -51,10 +54,6 @@
   , Map
   , Merge
   , Concat
-  , Check
-  , Expecting
-  , Missing
-  , Ambiguous
   , module Data.Type.Equality
   , module Data.Proxy
   ) where
@@ -70,10 +69,9 @@
 import Language.Haskell.TH hiding (Pred)
 import Data.Bits
 
-
 -- | Generates a 'Membership' that corresponds to the given ordinal (0-origin).
-ord :: Int -> Q Exp
-ord n = do
+mkMembership :: Int -> Q Exp
+mkMembership n = do
   let names = map mkName $ take (n + 1) $ concatMap (flip replicateM ['a'..'z']) [1..]
   let rest = mkName "any"
   let cons x xs = PromotedConsT `AppT` x `AppT` xs
@@ -89,71 +87,46 @@
 
 -- | Remember that @Member xs x@ from 'Membership'.
 remember :: forall xs x r. Membership xs x -> (Member xs x => r) -> r
-remember pos r = unsafeCoerce (Remembrance r :: Remembrance xs x r) pos
+remember i r = unsafeCoerce (Remembrance r :: Remembrance xs x r) i
 {-# INLINE remember #-}
 
--- | Lookup types
-type family ListIndex (n :: Nat) (xs :: [k]) :: k where
-  ListIndex 'Zero (x ': xs) = x
-  ListIndex ('SDNat n) (y ': xs) = ListIndex n (Half xs)
-  ListIndex ('DNat n) xs = ListIndex n (Half xs)
-
-type family Pred (n :: Nat) :: Nat where
-  Pred ('SDNat 'Zero) = 'Zero
-  Pred ('SDNat n) = 'DNat n
-  Pred ('DNat n) = 'SDNat (Pred n)
-  Pred 'Zero = 'Zero
+class Member xs x where
+  membership :: Membership xs x
 
-type family Div2 (n :: Nat) :: Nat where
-  Div2 ('SDNat n) = n
-  Div2 ('DNat n) = n
-  Div2 'Zero = 'Zero
+instance (Elaborate x (FindType x xs) ~ 'Expecting pos, KnownPosition pos) => Member xs x where
+  membership = Membership (theInt (Proxy :: Proxy pos))
+  {-# INLINE membership #-}
 
 -- | The kind of key-value pairs
 data Assoc k v = k :> v
-
-type family AssocKeys (xs :: [Assoc k v]) :: [k] where
-  AssocKeys ((k ':> v) ': xs) = k ': AssocKeys xs
-  AssocKeys '[] = '[]
+infix 0 :>
 
 -- | @'Associate' k v xs@ is essentially identical to @(k :> v) ∈ xs@
 -- , but the type @v@ is inferred from @k@ and @xs@.
 class Associate k v xs | k xs -> v where
   association :: Membership xs (k ':> v)
 
-instance (Check k (Lookup k (AssocKeys xs)) ~ Expecting one, ToInt one, (k ':> v) ~ ListIndex one xs) => Associate k v xs where
-  association = Membership (theInt (Proxy :: Proxy one))
-
--- | The type of extensible products.
-data (h :: k -> *) :* (s :: [k]) where
-  Nil :: h :* '[]
-  Tree :: !(h x)
-    -> h :* Half xs
-    -> h :* Half (Tail xs)
-    -> h :* (x ': xs)
-
-deriving instance Typeable (:*)
+instance (Elaborate k (FindAssoc k xs) ~ 'Expecting (n ':> v), KnownPosition n) => Associate k v xs where
+  association = Membership (theInt (Proxy :: Proxy n))
 
-class LookupTree (n :: Nat) (xs :: [k]) x | n xs -> x where
-  lookupTree :: Functor f => proxy n
-    -> (h x -> f (h x))
-    -> h :* xs -> f (h :* xs)
+data Elaborated k v = Expecting v | Missing k | Duplicate k
 
-instance LookupTree 'Zero (x ': xs) x where
-  lookupTree _ f (Tree h a b) = fmap (\h' -> Tree h' a b) (f h)
-  {-# INLINE lookupTree #-}
+type family Elaborate (key :: k) (xs :: [v]) :: Elaborated k v where
+  Elaborate k '[] = 'Missing k
+  Elaborate k '[x] = 'Expecting x
+  Elaborate k xs = 'Duplicate k
 
-instance LookupTree n (Half xs) x => LookupTree ('SDNat n) (t ': xs) x where
-  lookupTree _ f (Tree h a b) = fmap (\a' -> Tree h a' b) (lookupTree (Proxy :: Proxy n) f a)
-  {-# INLINE lookupTree #-}
+type family FindAssoc (key :: k) (xs :: [Assoc k v]) where
+  FindAssoc k ((k ':> v) ': xs) = ('Zero ':> v) ': MapSuccKey (FindAssoc k xs)
+  FindAssoc k ((k' ':> v) ': xs) = MapSuccKey (FindAssoc k xs)
+  FindAssoc k '[] = '[]
 
-instance LookupTree (Pred n) (Half (Tail xs)) x => LookupTree ('DNat n) (t ': xs) x where
-  lookupTree _ f (Tree h a b) = fmap (\b' -> Tree h a b')
-    (lookupTree (Proxy :: Proxy (Div2 (Pred ('DNat n)))) (unsafeCoerce f) b)
-  {-# INLINE lookupTree #-}
+type family MapSuccKey (xs :: [Assoc Nat v]) :: [Assoc Nat v] where
+  MapSuccKey '[] = '[]
+  MapSuccKey ((k ':> x) ': xs) = (Succ k ':> x) ': MapSuccKey xs
 
 instance Show (Membership xs x) where
-  show (Membership n) = "$(ord " ++ show n ++ ")"
+  show (Membership n) = "$(mkMembership " ++ show n ++ ")"
 
 instance Eq (Membership xs x) where
   _ == _ = True
@@ -217,33 +190,11 @@
 type family Head (xs :: [k]) :: k where
   Head (x ': xs) = x
 
-class Member xs x where
-  membership :: Membership xs x
-
--- | A type sugar to make type error more readable.
-data Expecting a
-
--- | A type sugar to make type error more readable.
-data Missing a
-
--- | A type sugar to make type error more readable.
-data Ambiguous a
-
--- | Elaborate the result of 'Lookup'
-type family Check x xs where
-  Check x '[n] = Expecting n
-  Check x '[] = Missing x
-  Check x xs = Ambiguous x
-
-instance (Check x (Lookup x xs) ~ Expecting one, ToInt one) => Member xs x where
-  membership = Membership (theInt (Proxy :: Proxy one))
-  {-# INLINE membership #-}
-
--- | Lookup types
-type family Lookup (x :: k) (xs :: [k]) :: [Nat] where
-  Lookup x (x ': xs) = 'Zero ': Lookup x xs
-  Lookup x (y ': ys) = MapSucc (Lookup x ys)
-  Lookup x '[] = '[]
+-- | FindType types
+type family FindType (x :: k) (xs :: [k]) :: [Nat] where
+  FindType x (x ': xs) = 'Zero ': FindType x xs
+  FindType x (y ': ys) = MapSucc (FindType x ys)
+  FindType x '[] = '[]
 
 -- | Interleaved list
 type family Half (xs :: [k]) :: [k] where
@@ -260,18 +211,18 @@
 data Nat = Zero | DNat Nat | SDNat Nat
 
 -- | Converts type naturals into 'Word'.
-class ToInt n where
+class KnownPosition n where
   theInt :: proxy n -> Word
 
-instance ToInt 'Zero where
+instance KnownPosition 'Zero where
   theInt _ = 0
   {-# INLINE theInt #-}
 
-instance ToInt n => ToInt ('DNat n) where
+instance KnownPosition n => KnownPosition ('DNat n) where
   theInt _ = theInt (Proxy :: Proxy n) `unsafeShiftL` 1
   {-# INLINE theInt #-}
 
-instance ToInt n => ToInt ('SDNat n) where
+instance KnownPosition n => KnownPosition ('SDNat n) where
   theInt _ = (theInt (Proxy :: Proxy n) `unsafeShiftL` 1) + 1
   {-# INLINE theInt #-}
 
diff --git a/src/Data/Extensible/Internal/Rig.hs b/src/Data/Extensible/Internal/Rig.hs
--- a/src/Data/Extensible/Internal/Rig.hs
+++ b/src/Data/Extensible/Internal/Rig.hs
@@ -20,6 +20,7 @@
 import Data.Foldable (Foldable)
 import Data.Traversable (Traversable)
 #endif
+import Data.Profunctor
 
 -- | A type synonym for lenses
 type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s
@@ -37,6 +38,9 @@
 -- | Just a value.
 newtype K0 a = K0 { getK0 :: a } deriving (Eq, Ord, Read, Typeable, Functor, Foldable, Traversable)
 
+_K0 :: (Functor f, Profunctor p) => p a (f b) -> p (K0 a) (f (K0 b))
+_K0 = dimap getK0 (fmap K0)
+
 instance Applicative K0 where
   pure = K0
   K0 f <*> K0 a = K0 (f a)
@@ -55,9 +59,6 @@
 
 -- | Poly-kinded Const
 newtype Const' a x = Const' { getConst' :: a } deriving Show
-
--- | Turn a wrapper type into one clause that returns @a@.
-newtype Match h a x = Match { runMatch :: h x -> a } deriving Typeable
 
 newtype Comp f g a = Comp { getComp :: f (g a) }
 
diff --git a/src/Data/Extensible/Match.hs b/src/Data/Extensible/Match.hs
--- a/src/Data/Extensible/Match.hs
+++ b/src/Data/Extensible/Match.hs
@@ -11,20 +11,24 @@
 -- Pattern matching
 ------------------------------------------------------------------------
 module Data.Extensible.Match (
-  Match(..)
-  , clause
+  matchWith
+  , Match(..)
+  , _Match
   , match
   , mapMatch
   , caseOf) where
 
-import Data.Extensible.Internal
 import Data.Extensible.Internal.Rig
+import Data.Extensible.Class
 import Data.Extensible.Product
 import Data.Extensible.Sum
+import Data.Profunctor
+import Data.Typeable
 
--- | A lens for a specific clause.
-clause :: (x ∈ xs) => Lens' (Match h a :* xs) (h x -> a)
-clause f = sector (fmap Match . f . runMatch)
+-- | Retrieve the contents so that they matches and pass both to the given function.
+matchWith :: (forall x. f x -> g x -> r) -> f :* xs -> g :| xs -> r
+matchWith f p = \(EmbedAt i h) -> views (pieceAt i) f p h
+{-# INLINE matchWith #-}
 
 -- | Applies a function to the result of 'Match'.
 mapMatch :: (a -> b) -> Match h a x -> Match h b x
@@ -33,7 +37,7 @@
 
 -- | /O(log n)/ Perform pattern matching.
 match :: Match h a :* xs -> h :| xs -> a
-match p = \(UnionAt pos h) -> views (sectorAt pos) runMatch p h
+match = matchWith runMatch
 {-# INLINE match #-}
 
 -- | Flipped `match`
@@ -41,3 +45,9 @@
 caseOf = flip match
 {-# INLINE caseOf #-}
 infix 0 `caseOf`
+
+-- | Turn a wrapper type into one clause that returns @a@.
+newtype Match h a x = Match { runMatch :: h x -> a } deriving Typeable
+
+_Match :: (Profunctor p, Functor f) => p (g x -> a) (f (h y -> b)) -> p (Match g a x) (f (Match h b y))
+_Match = dimap runMatch (fmap Match)
diff --git a/src/Data/Extensible/Plain.hs b/src/Data/Extensible/Plain.hs
--- a/src/Data/Extensible/Plain.hs
+++ b/src/Data/Extensible/Plain.hs
@@ -12,21 +12,20 @@
 ------------------------------------------------------------------------
 module Data.Extensible.Plain (
   K0(..)
+  , _K0
   , AllOf
   , OneOf
   , (<%)
   , pluck
   , bury
   , (<%|)
-  , record
-  , recordAt
-  , (<?%)
   , accessing
   , decFields
   , decFieldsDeriving
-  )where
+  ) where
 import Data.Extensible.Internal
 import Data.Extensible.Internal.Rig
+import Data.Extensible.Class
 import Data.Extensible.Product
 import Data.Extensible.Sum
 import Unsafe.Coerce
@@ -48,7 +47,7 @@
 
 -- | Extract a plain value.
 pluck :: (x ∈ xs) => AllOf xs -> x
-pluck = views sector getK0
+pluck = views piece getK0
 {-# INLINE pluck #-}
 
 -- | Embed a plain value.
@@ -61,25 +60,9 @@
 (<%|) = unsafeCoerce (<:|)
 infixr 1 <%|
 
--- | /O(log n)/ A lens for a plain value in a product.
-record :: (x ∈ xs, Functor f) => (x -> f x) -> (AllOf xs -> f (AllOf xs))
-record f = sector $ unsafeCoerce f `asTypeOf` (fmap K0 . f . getK0)
-{-# INLINE record #-}
-
--- | /O(log n)/ A lens for a plain value in a product.
-recordAt :: (Functor f) => Membership xs x -> (x -> f x) -> (AllOf xs -> f (AllOf xs))
-recordAt pos f = sectorAt pos $ unsafeCoerce f `asTypeOf` (fmap K0 . f . getK0)
-{-# INLINE recordAt #-}
-
--- | Prepend a clause for a plain value.
-(<?%) :: (x -> a) -> Match K0 a :* xs -> Match K0 a :* (x ': xs)
-(<?%) = unsafeCoerce (<:*)
-{-# INLINE (<?%) #-}
-infixr 1 <?%
-
 -- | An accessor for newtype constructors.
 accessing :: (Coercible b a, b ∈ xs) => (a -> b) -> Lens' (AllOf xs) a
-accessing c f = record (fmap c . f . coerce)
+accessing c f = piece (_K0 (fmap c . f . coerce))
 {-# INLINE accessing #-}
 
 -- | Generate newtype wrappers and lenses from type synonyms.
diff --git a/src/Data/Extensible/Product.hs b/src/Data/Extensible/Product.hs
--- a/src/Data/Extensible/Product.hs
+++ b/src/Data/Extensible/Product.hs
@@ -28,15 +28,15 @@
   , hzipWith3
   , hfoldMap
   , htraverse
+  , htraverseWithIndex
   , hsequence
   , hcollect
   , hdistribute
   -- * Lookup
   , hlookup
   , hindex
-  , sector
-  , sectorAssoc
   , sectorAt
+  , sector
   -- * Generation
   , Generate(..)
   , htabulate
@@ -50,14 +50,25 @@
 import Control.Applicative
 #endif
 import Data.Monoid
+import Data.Typeable
+import Data.Extensible.Class
 
+-- | The type of extensible products.
+data (h :: k -> *) :* (s :: [k]) where
+  Nil :: h :* '[]
+  Tree :: !(h x)
+    -> h :* Half xs
+    -> h :* Half (Tail xs)
+    -> h :* (x ': xs)
+
+deriving instance Typeable (:*)
+
 -- | /O(1)/ Extract the head element.
 hhead :: h :* (x ': xs) -> h x
 hhead (Tree a _ _) = a
 {-# INLINE hhead #-}
 
 -- | /O(n)/ Extract the tail of the product.
--- FIXME: unsafeCoerce
 htail :: h :* (x ': xs) -> h :* xs
 htail (Tree _ a@(Tree h _ _) b) = unsafeCoerce (Tree h) b (htail a)
 htail (Tree _ Nil _) = unsafeCoerce Nil
@@ -137,7 +148,7 @@
 
 -- | The dual of 'htraverse'
 hcollect :: (Functor f, Generate xs) => (a -> h :* xs) -> f a -> Comp f h :* xs
-hcollect f m = htabulate $ \pos -> Comp $ fmap (hlookup pos . f) m
+hcollect f m = htabulate $ \i -> Comp $ fmap (hlookup i . f) m
 {-# INLINABLE hcollect #-}
 
 -- | The dual of 'hsequence'
@@ -147,7 +158,7 @@
 
 -- | /O(log n)/ Pick up an elemtnt.
 hlookup :: Membership xs x -> h :* xs -> h x
-hlookup = view . sectorAt
+hlookup = view . pieceAt
 {-# INLINABLE hlookup #-}
 
 -- | Flipped 'hlookup'
@@ -155,7 +166,7 @@
 hindex = flip hlookup
 {-# INLINE hindex #-}
 
--- | 'hmap' with its indices.
+-- | 'hmap' with 'Membership's.
 hmapWithIndex :: forall g h xs. (forall x. Membership xs x -> g x -> h x) -> g :* xs -> h :* xs
 hmapWithIndex f = go id where
   go :: (forall x. Membership t x -> Membership xs x) -> g :* t -> h :* t
@@ -163,30 +174,44 @@
   go _ Nil = Nil
 {-# INLINE hmapWithIndex #-}
 
--- | /O(log n)/ A lens for a specific element.
-sector :: (x ∈ xs) => Lens' (h :* xs) (h x)
-sector = sectorAt membership
-{-# INLINE sector #-}
+-- | 'htraverse' with 'Membership's.
+htraverseWithIndex :: forall f g h xs. Applicative f
+  => (forall x. Membership xs x -> g x -> f (h x)) -> g :* xs -> f (h :* xs)
+htraverseWithIndex f = go id where
+  go :: (forall x. Membership t x -> Membership xs x) -> g :* t -> f (h :* t)
+  go k (Tree g a b) = Tree <$> f (k here) g <*> go (k . navL) a <*> go (k . navR) b
+  go _ Nil = pure Nil
+{-# INLINE htraverseWithIndex #-}
 
--- | /O(log n)/ A lens for a specific element.
-sectorAssoc :: (Associate k v xs) => Lens' (h :* xs) (h (k ':> v))
-sectorAssoc = sectorAt association
-{-# INLINE sectorAssoc #-}
+instance Functor f => Extensible f (->) (->) (:*) where
+  -- | /O(log n)/ A lens for a value in a known position.
+  pieceAt = pieceAt_
+  {-# INLINE pieceAt #-}
 
--- | /O(log n)/ A lens for a value in a known position.
-sectorAt :: forall f h x xs. Functor f => Membership xs x -> (h x -> f (h x)) -> h :* xs -> f (h :* xs)
-sectorAt pos f = flip go pos where
+pieceAt_ :: forall (xs :: [k]) (x :: k) (h :: k -> *) (f :: * -> *). Functor f
+  => Membership xs x -> (h x -> f (h x)) -> h :* xs -> f (h :* xs)
+pieceAt_ i f = flip go i where
   go :: forall t. h :* t -> Membership t x -> f (h :* t)
   go (Tree h a b) = navigate
     (\Here -> fmap (\h' -> Tree h' a b) (f h))
     (fmap (\a' -> Tree h a' b) . go a)
     (fmap (\b' -> Tree h a b') . go b)
   go Nil = error "Impossible"
-{-# INLINE sectorAt #-}
+{-# INLINE pieceAt_ #-}
 
+{-# DEPRECATED sectorAt "Use pieceAt" #-}
+-- | The legacy name for 'pieceAt'
+sectorAt :: Functor f => Membership xs x -> (h x -> f (h x)) -> h :* xs -> f (h :* xs)
+sectorAt = pieceAt
+
+{-# DEPRECATED sector "Use piece" #-}
+-- | The legacy name for 'piece'
+sector :: (Functor f, x ∈ xs) => (h x -> f (h x)) -> h :* xs -> f (h :* xs)
+sector = piece
+
 -- | Given a function that maps types to values, we can "collect" entities all you want.
 class Generate (xs :: [k]) where
-  -- | /O(n)/ htabulates a product with the given function.
+  -- | /O(n)/ Generate a product with the given function.
   hgenerate :: Applicative f => (forall x. Membership xs x -> f (h x)) -> f (h :* xs)
 
 instance Generate '[] where
@@ -210,7 +235,7 @@
 
 -- | Guarantees the all elements satisfies the predicate.
 class Forall c (xs :: [k]) where
-  -- | /O(n)/ Analogous to 'htabulate', but it also supplies a context @c x@ for every elements in @xs@.
+  -- | /O(n)/ Analogous to 'hgenerate', but it also supplies a context @c x@ for every elements in @xs@.
   hgenerateFor :: Applicative f => proxy c -> (forall x. c x => Membership xs x -> f (h x)) -> f (h :* xs)
 
 instance Forall c '[] where
diff --git a/src/Data/Extensible/Record.hs b/src/Data/Extensible/Record.hs
--- a/src/Data/Extensible/Record.hs
+++ b/src/Data/Extensible/Record.hs
@@ -9,26 +9,31 @@
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- Flexible records with well-typed fields.
+-- Flexible records and variants
 -- Example: <https://github.com/fumieval/extensible/blob/master/examples/records.hs>
 ------------------------------------------------------------------------
 module Data.Extensible.Record (
-   module Data.Extensible.Inclusion
-  , Record
-  , (<:)
-  , (<:*)
-  , (:*)(Nil)
+   module Data.Extensible.Class
+  , module Data.Extensible.Inclusion
   , (@=)
   , (<@=>)
   , mkField
   , Field(..)
   , getField
-  , FieldLens
+  , FieldOptic
   , FieldName
+  , fieldOptic
+  -- * Records and variants
+  , Record
+  , (<:)
+  , (:*)(Nil)
+  , Variant
   -- * Internal
-  , Labelable(..)
   , LabelPhantom
+  , Labelling
   ) where
+import Data.Extensible.Class
+import Data.Extensible.Sum
 import Data.Extensible.Product
 import Data.Extensible.Internal
 import Data.Extensible.Internal.Rig
@@ -37,6 +42,8 @@
 import Data.Extensible.Inclusion
 import Data.Extensible.Dictionary ()
 import Control.Monad
+import Data.Profunctor
+import Data.Constraint
 
 -- | The type of fields.
 data Field kv where
@@ -45,43 +52,57 @@
 -- | Get a value of a field.
 getField :: Field (k ':> v) -> v
 getField (Field v) = v
+{-# INLINE getField #-}
 
 -- | The type of records which contain several fields.
 type Record = (:*) Field
 
+-- | The dual of 'Record'
+type Variant = (:|) Field
+
 -- | Shows in @field \@= value@ style instead of the derived one.
 instance (KnownSymbol k, Show v) => Show (Field (k ':> v)) where
   showsPrec d (Field a) = showParen (d >= 1) $ showString (symbolVal (Proxy :: Proxy k))
     . showString " @= "
     . showsPrec 1 a
 
--- | @FieldLens s@ is a type of lens that points a field named @s@.
+-- | @FieldOptic s@ is a type of optics that points a field/constructor named @s@.
 --
+-- The yielding fields can be
+-- <http://hackage.haskell.org/package/lens/docs/Control-Lens-Lens.html#t:Lens Lens>es
+-- for 'Record's and
+-- <http://hackage.haskell.org/package/lens/docs/Control-Lens-Lens.html#t:Prism Prism>s
+-- for 'Variant's.
+--
 -- @
--- 'FieldLens' "foo" = Associate "foo" a xs => Lens' ('Record' xs) a
+-- 'FieldOptic' "foo" = Associate "foo" a xs => Lens' ('Record' xs) a
+-- 'FieldOptic' "foo" = Associate "foo" a xs => Prism' ('Variant' xs) a
 -- @
 --
-type FieldLens k = forall f p xs v. (Functor f, Labelable k p, Associate k v xs)
-  => p v (f v) -> Record xs -> f (Record xs)
+type FieldOptic k = forall f p q t xs v. (Functor f
+  , Profunctor p
+  , Extensible f p q t
+  , Associate k v xs
+  , Labelling k p)
+  => p v (f v) -> q (t Field xs) (f (t Field xs))
 
 -- | When you see this type as an argument, it expects a 'FieldLens'.
 -- This type is used to resolve the name of the field internally.
 type FieldName k = forall v. LabelPhantom k v (Proxy v)
   -> Record '[k ':> v] -> Proxy (Record '[k ':> v])
 
+type family Labelling s p :: Constraint where
+  Labelling s (LabelPhantom t) = s ~ t
+  Labelling s p = ()
+
 -- | A ghostly type which spells the field name
 data LabelPhantom s a b
 
--- | An internal class to characterize 'FieldLens'
-class Labelable s p where
-  unlabel :: proxy s -> p a b -> a -> b
-
-instance Labelable s (->) where
-  unlabel _ = id
-  {-# INLINE unlabel #-}
+instance Profunctor (LabelPhantom s) where
+  dimap _ _ _ = error "Impossible"
 
-instance (s ~ t) => Labelable s (LabelPhantom t) where
-  unlabel _ = error "Impossible"
+instance Extensible f (LabelPhantom s) q t where
+  pieceAt _ _ = error "Impossible"
 
 -- | Annotate a value by the field name.
 (@=) :: FieldName k -> v -> Field (k ':> v)
@@ -95,27 +116,24 @@
 {-# INLINE (<@=>) #-}
 infix 1 <@=>
 
-type Assoc_ a b = a ':> b
+-- | Generate a field optic from the given name.
+fieldOptic :: forall proxy k. proxy k -> FieldOptic k
+fieldOptic _ = pieceAssoc . dimap getField (fmap (Field :: v -> Field (k ':> v)))
+{-# INLINE fieldOptic #-}
 
--- | Generate a field.
+-- | Generate fields using 'fieldOptic'.
 -- @'mkField' "foo bar"@ defines:
 --
 -- @
--- foo :: FieldLens "foo"
--- foo :: FieldLens "bar"
+-- foo :: FieldOptic "foo"
+-- bar :: FieldOptic "bar"
 -- @
 --
--- The yielding field is a <http://hackage.haskell.org/package/lens/docs/Control-Lens-Lens.html#t:Lens Lens>.
 mkField :: String -> DecsQ
 mkField str = fmap concat $ forM (words str) $ \s -> do
-  f <- newName "f"
   let st = litT (strTyLit s)
-  let vt = varT (mkName "v")
-  let fcon = sigE (conE 'Field) $ forallT [PlainTV $ mkName "v"] (return []) $ arrowT `appT` vt `appT` (conT ''Field `appT` (conT ''Assoc_ `appT` st `appT` vt))
   let lbl = conE 'Proxy `sigE` (conT ''Proxy `appT` st)
-  let wf = varE '(.) `appE` (varE 'fmap `appE` fcon)
-        `appE` (varE '(.) `appE` (varE 'unlabel `appE` lbl `appE` varE f) `appE` varE 'getField)
-  sequence [sigD (mkName s) $ conT ''FieldLens `appT` st
-    , funD (mkName s) [clause [varP f] (normalB $ varE 'sectorAssoc `appE` wf) []]
+  sequence [sigD (mkName s) $ conT ''FieldOptic `appT` st
+    , valD (varP (mkName s)) (normalB $ varE 'fieldOptic `appE` lbl) []
     , return $ PragmaD $ InlineP (mkName s) Inline FunLike AllPhases
     ]
diff --git a/src/Data/Extensible/Sum.hs b/src/Data/Extensible/Sum.hs
--- a/src/Data/Extensible/Sum.hs
+++ b/src/Data/Extensible/Sum.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Extensible.Sum
@@ -22,6 +24,7 @@
   , exhaust
   , picked
   , embedAssoc
+  , pattern UnionAt
   ) where
 
 import Data.Extensible.Internal
@@ -29,37 +32,44 @@
 import Control.Applicative
 #endif
 import Data.Typeable
+import Data.Extensible.Class
+import Data.Profunctor
 
 -- | The extensible sum type
 data (h :: k -> *) :| (s :: [k]) where
-  UnionAt :: !(Membership xs x) -> h x -> h :| xs
+  EmbedAt :: !(Membership xs x) -> h x -> h :| xs
 deriving instance Typeable (:|)
 
+{-# DEPRECATED UnionAt "This has renamed to EmbedAt" #-}
+pattern UnionAt a b = EmbedAt a b
+
 -- | Change the wrapper.
 hoist :: (forall x. g x -> h x) -> g :| xs -> h :| xs
-hoist f (UnionAt pos h) = UnionAt pos (f h)
+hoist f (EmbedAt p h) = EmbedAt p (f h)
 {-# INLINE hoist #-}
 
 -- | /O(1)/ lift a value.
 embed :: (x ∈ xs) => h x -> h :| xs
-embed = UnionAt membership
+embed = EmbedAt membership
 {-# INLINE embed #-}
 
+-- | Try to extract something you want.
 strike :: forall h x xs. (x ∈ xs) => h :| xs -> Maybe (h x)
 strike = strikeAt membership
 {-# INLINE strike #-}
 
+-- | Try to extract something you want.
 strikeAt :: forall h x xs. Membership xs x -> h :| xs -> Maybe (h x)
-strikeAt q (UnionAt p h) = case compareMembership p q of
+strikeAt q (EmbedAt p h) = case compareMembership p q of
   Right Refl -> Just h
   _ -> Nothing
 {-# INLINE strikeAt #-}
 
 -- | /O(1)/ Naive pattern match
 (<:|) :: (h x -> r) -> (h :| xs -> r) -> h :| (x ': xs) -> r
-(<:|) r c = \(UnionAt pos h) -> runMembership pos
+(<:|) r c = \(EmbedAt i h) -> runMembership i
   (\Refl -> r h)
-  (\pos' -> c (UnionAt pos' h))
+  (\j -> c (EmbedAt j h))
 infixr 1 <:|
 {-# INLINE (<:|) #-}
 
@@ -67,12 +77,20 @@
 exhaust :: h :| '[] -> r
 exhaust _ = error "Impossible"
 
+-- | Embed a value, but focuses on its key.
+embedAssoc :: Associate k a xs => h (k ':> a) -> h :| xs
+embedAssoc = EmbedAt association
+{-# INLINE embedAssoc #-}
+
+{-# DEPRECATED picked "Use piece instead" #-}
 -- | A traversal that tries to point a specific element.
 picked :: forall f h x xs. (x ∈ xs, Applicative f) => (h x -> f (h x)) -> h :| xs -> f (h :| xs)
-picked f u@(UnionAt pos h) = case compareMembership (membership :: Membership xs x) pos of
-  Right Refl -> fmap (UnionAt pos) (f h)
+picked f u@(EmbedAt i h) = case compareMembership (membership :: Membership xs x) i of
+  Right Refl -> fmap (EmbedAt i) (f h)
   _ -> pure u
 {-# INLINE picked #-}
 
-embedAssoc :: Associate k a xs => h (k ':> a) -> h :| xs
-embedAssoc = UnionAt association
+instance (Applicative f, Choice p) => Extensible f p p (:|) where
+  pieceAt m p = dimap (\t@(EmbedAt i h) -> case compareMembership i m of
+    Right Refl -> Right h
+    Left _ -> Left t) (either pure (fmap (EmbedAt m))) (right' p)
diff --git a/src/Data/Extensible/Union.hs b/src/Data/Extensible/Union.hs
--- a/src/Data/Extensible/Union.hs
+++ b/src/Data/Extensible/Union.hs
@@ -15,6 +15,7 @@
 
 import Data.Extensible.Internal
 import Data.Extensible.Internal.Rig
+import Data.Extensible.Class
 import Data.Extensible.Sum
 import Data.Extensible.Product
 import Data.Typeable
@@ -25,7 +26,8 @@
 newtype Union xs a = Union { getUnion :: K1 a :| xs }
 
 reunion :: Gondola m :* xs -> Union xs a -> m a
-reunion gs (Union (UnionAt pos (K1 f))) = views (sectorAt pos) runGondola gs f
+reunion gs = \(Union (EmbedAt i (K1 f))) -> views (pieceAt i) runGondola gs f
+{-# INLINE reunion #-}
 
 -- | Transformation between effects
 newtype Gondola f g = Gondola { runGondola :: forall a. g a -> f a }
@@ -33,8 +35,10 @@
 -- | Add a new transformation.
 rung :: (forall x. f x -> g x) -> Gondola g :* fs -> Gondola g :* (f ': fs)
 rung f = (<:) (Gondola f)
+{-# INLINE rung #-}
+
 infixr 0 `rung`
 
 runGondolas :: (x ∈ xs) => Gondola f :* xs -> x a -> f a
-runGondolas = views sector runGondola
+runGondolas = views piece runGondola
 {-# INLINE runGondolas #-}