diff --git a/non-empty.cabal b/non-empty.cabal
--- a/non-empty.cabal
+++ b/non-empty.cabal
@@ -1,5 +1,5 @@
 Name:             non-empty
-Version:          0.1.3
+Version:          0.2
 License:          BSD3
 License-File:     LICENSE
 Author:           Henning Thielemann <haskell@henning-thielemann.de>
@@ -57,13 +57,13 @@
 Build-Type:       Simple
 
 Source-Repository this
-  Tag:         0.1.3
+  Tag:         0.2
   Type:        darcs
-  Location:    http://code.haskell.org/~thielema/non-empty
+  Location:    http://code.haskell.org/~thielema/non-empty/
 
 Source-Repository head
   Type:        darcs
-  Location:    http://code.haskell.org/~thielema/non-empty
+  Location:    http://code.haskell.org/~thielema/non-empty/
 
 Library
   Build-Depends:
@@ -78,8 +78,12 @@
     Data.NonEmpty
     Data.NonEmpty.Class
     Data.NonEmpty.Mixed
+    Data.NonEmpty.Set
+    Data.NonEmpty.Map
     Data.Empty
     Data.Optional
+    Data.Append
     Data.Zip
   Other-Modules:
     Data.NonEmptyPrivate
+    Data.NonEmptyTest
diff --git a/src/Data/Append.hs b/src/Data/Append.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Append.hs
@@ -0,0 +1,24 @@
+module Data.Append where
+
+import Control.Applicative (liftA2)
+import Data.Traversable (Traversable, traverse)
+import Data.Foldable (Foldable, foldMap)
+import Data.Monoid (mappend)
+
+import Prelude hiding (fst, snd)
+
+
+data T f g a =
+   Cons {
+      fst :: f a,
+      snd :: g a
+   }
+
+instance (Functor f, Functor g) => Functor (T f g) where
+   fmap f (Cons xs ys) = Cons (fmap f xs) (fmap f ys)
+
+instance (Foldable f, Foldable g) => Foldable (T f g) where
+   foldMap f (Cons xs ys) = mappend (foldMap f xs) (foldMap f ys)
+
+instance (Traversable f, Traversable g) => Traversable (T f g) where
+   traverse f (Cons xs ys) = liftA2 Cons (traverse f xs) (traverse f ys)
diff --git a/src/Data/Empty.hs b/src/Data/Empty.hs
--- a/src/Data/Empty.hs
+++ b/src/Data/Empty.hs
@@ -27,9 +27,14 @@
 instance Trav.Traversable T where
    sequenceA Cons = pure Cons
 
-instance C.View T where
+instance C.ViewL T where
    viewL _ = Nothing
 
+instance C.ViewR T where
+   viewR _ = Nothing
+
+instance C.View T where
+
 instance QC.Arbitrary (T a) where
    arbitrary = return Cons
    shrink _ = []
@@ -43,6 +48,9 @@
 instance C.Reverse T where reverse = id
 
 instance C.Sort T where
+   sort Cons = Cons
+
+instance C.SortBy T where
    sortBy _ Cons = Cons
 
 {-
diff --git a/src/Data/NonEmpty.hs b/src/Data/NonEmpty.hs
--- a/src/Data/NonEmpty.hs
+++ b/src/Data/NonEmpty.hs
@@ -7,14 +7,16 @@
    toList,
    flatten,
    fetch,
-   cons,
+   cons, snoc,
    singleton,
    reverse,
    mapHead,
    mapTail,
+   viewL, viewR,
    init,
    last,
    foldl1,
+   foldBalanced,
    maximum, maximumBy, maximumKey,
    minimum, minimumBy, minimumKey,
    sum,
@@ -23,14 +25,12 @@
    cycle,
    zipWith,
    mapAdjacent,
-   sortBy, sort,
-   Insert(insertBy), insert,
+   Insert(insert), insertDefault,
+   InsertBy(insertBy),
    scanl, scanr,
-   Zip.transposeClip,
    Tails(tails),
    RemoveEach(removeEach),
    ) where
 
-import qualified Data.Zip as Zip
 import Data.NonEmptyPrivate
 import Prelude ()
diff --git a/src/Data/NonEmpty/Class.hs b/src/Data/NonEmpty/Class.hs
--- a/src/Data/NonEmpty/Class.hs
+++ b/src/Data/NonEmpty/Class.hs
@@ -6,12 +6,14 @@
 import qualified Data.List as List
 import Data.Sequence (Seq, )
 import Data.Set (Set, )
+import Data.Traversable (Traversable, mapAccumL, mapAccumR)
 import Control.Monad (liftM2, )
+import Data.Tuple.HT (swap, )
 
 import qualified Test.QuickCheck as QC
 
 import qualified Prelude as P
-import Prelude hiding (Show, showsPrec, zipWith, reverse, )
+import Prelude hiding (Show, showsPrec, zipWith, zipWith3, reverse, )
 
 
 class Empty f where
@@ -40,19 +42,33 @@
    cons = (Seq.<|)
 
 
-class View f where
+class Snoc f where
+   snoc :: f a -> a -> f a
+
+instance Snoc [] where
+   snoc = snocDefault
+
+instance Snoc Seq where
+   snoc = (Seq.|>)
+
+snocDefault :: (Cons f, Traversable f) => f a -> a -> f a
+snocDefault xs x =
+   uncurry cons $ mapAccumR (flip (,)) x xs
+
+
+class ViewL f where
    viewL :: f a -> Maybe (a, f a)
 
-instance View [] where
+instance ViewL [] where
    viewL = ListHT.viewL
 
-instance View Maybe where
+instance ViewL Maybe where
    viewL = fmap (\a -> (a, Nothing))
 
-instance View Set where
+instance ViewL Set where
    viewL = Set.minView
 
-instance View Seq where
+instance ViewL Seq where
    viewL x =
       case Seq.viewl x of
          Seq.EmptyL -> Nothing
@@ -60,6 +76,40 @@
    -- viewL x = do y Seq.:< ys <- Just $ Seq.viewl x; Just (y,ys)
 
 
+class ViewR f where
+   viewR :: f a -> Maybe (f a, a)
+
+instance ViewR [] where
+   viewR = ListHT.viewR
+
+instance ViewR Maybe where
+   viewR = fmap (\a -> (Nothing, a))
+
+instance ViewR Set where
+   viewR = fmap swap . Set.maxView
+
+instance ViewR Seq where
+   viewR x =
+      case Seq.viewr x of
+         Seq.EmptyR -> Nothing
+         ys Seq.:> y -> Just (ys,y)
+
+
+class (ViewL f, ViewR f) => View f where
+instance View [] where
+instance View Maybe where
+instance View Set where
+instance View Seq where
+
+
+{-
+Default implementation of 'viewR' based on 'viewL' and 'Traversable'.
+-}
+viewRDefault :: (ViewL f, Traversable f) => f a -> Maybe (f a, a)
+viewRDefault =
+   fmap (swap . uncurry (mapAccumL (flip (,)))) . viewL
+
+
 class Singleton f where
    singleton :: a -> f a
 
@@ -107,10 +157,22 @@
 instance Zip Seq where
    zipWith = Seq.zipWith
 
+zipWith3 :: (Zip f) => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
+zipWith3 f a b c = zipWith ($) (zipWith f a b) c
+
+zipWith4 :: (Zip f) => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
+zipWith4 f a b c d = zipWith ($) (zipWith3 f a b c) d
+
 zip :: (Zip f) => f a -> f b -> f (a,b)
 zip = zipWith (,)
 
+zip3 :: (Zip f) => f a -> f b -> f c -> f (a,b,c)
+zip3 = zipWith3 (,,)
 
+zip4 :: (Zip f) => f a -> f b -> f c -> f d -> f (a,b,c,d)
+zip4 = zipWith4 (,,,)
+
+
 class Repeat f where
    {- |
    Create a container with as many copies as possible of a given value.
@@ -123,22 +185,53 @@
    repeat = List.repeat
 
 
+class Repeat f => Iterate f where
+   iterate :: (a -> a) -> a -> f a
+
+instance Iterate [] where
+   iterate = List.iterate
+
+
+{- |
+We need to distinguish between 'Sort' and 'SortBy',
+since there is an @instance Sort Set@
+but there cannot be an @instance SortBy Set@.
+-}
 class Sort f where
-   sortBy :: (a -> a -> Ordering) -> f a -> f a
+   sort :: (Ord a) => f a -> f a
 
 instance Sort [] where
-   sortBy = List.sortBy
+   sort = List.sort
 
 instance Sort Maybe where
-   sortBy _f = id
+   sort = id
 
 instance Sort Seq where
-   sortBy = Seq.sortBy
+   sort = Seq.sort
 
-sort :: (Ord a, Sort f) => f a -> f a
-sort = sortBy compare
+instance Sort Set where
+   sort = id
 
+{- |
+Default implementation for 'sort' based on 'sortBy'.
+-}
+sortDefault :: (Ord a, SortBy f) => f a -> f a
+sortDefault = sortBy compare
 
+
+class Sort f => SortBy f where
+   sortBy :: (a -> a -> Ordering) -> f a -> f a
+
+instance SortBy [] where
+   sortBy = List.sortBy
+
+instance SortBy Maybe where
+   sortBy _f = id
+
+instance SortBy Seq where
+   sortBy = Seq.sortBy
+
+
 class Reverse f where
    reverse :: f a -> f a
 
@@ -157,6 +250,9 @@
         else showParen (p>5) $
              foldr (.) (showString "[]") $
              map (\x -> P.showsPrec 6 x . showString ":") xs
+
+instance Show Set where
+   showsPrec = P.showsPrec
 
 
 class Arbitrary f where
diff --git a/src/Data/NonEmpty/Map.hs b/src/Data/NonEmpty/Map.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/NonEmpty/Map.hs
@@ -0,0 +1,104 @@
+module Data.NonEmpty.Map (
+   T,
+   insert,
+   singleton,
+   member,
+   lookup,
+   minViewWithKey,
+   maxViewWithKey,
+   fromList,
+   toAscList,
+   flatten,
+   union,
+   unionLeft,
+   unionRight,
+   ) where
+
+import qualified Data.NonEmpty as NonEmpty
+
+import qualified Data.Map as Map
+import Data.Map (Map, )
+
+import Control.Monad (mzero, )
+import Data.Maybe (fromMaybe, )
+import Data.Tuple.HT (forcePair, )
+import Data.Ord.HT (comparing, )
+
+import Prelude hiding (lookup, )
+
+
+{-
+The first field will always contain the smallest element.
+-}
+data T k a = Cons (k, a) (Map k a)
+   deriving (Eq, Ord)
+
+instance (Show k, Show a) => Show (T k a) where
+   showsPrec p xs =
+      showParen (p>10) $
+         showString "NonEmptyMap.fromList " .
+         showsPrec 11 (toAscList xs)
+
+
+insert :: Ord k => k -> a -> Map k a -> T k a
+insert = curry $ insertGen fst
+
+insertGen :: Ord k => (((k,a),(k,a)) -> (k,a)) -> (k,a) -> Map k a -> T k a
+insertGen select y xt =
+   uncurry Cons $
+   fromMaybe (y, xt) $ do
+      (x,xs) <- Map.minViewWithKey xt
+      case comparing fst y x of
+         GT -> return (x, uncurry Map.insert y xs)
+         EQ -> return (select (y,x), xs)
+         LT -> mzero
+
+singleton :: k -> a -> T k a
+singleton k a = Cons (k,a) Map.empty
+
+member :: (Ord k) => k -> T k a -> Bool
+member y (Cons x xs) =
+   y == fst x || Map.member y xs
+
+lookup :: (Ord k) => k -> T k a -> Maybe a
+lookup y (Cons x xs) =
+   if y == fst x
+     then Just $ snd x
+     else Map.lookup y xs
+
+minViewWithKey :: T k a -> ((k,a), Map k a)
+minViewWithKey (Cons x xs) = (x,xs)
+
+maxViewWithKey :: (Ord k) => T k a -> ((k,a), Map k a)
+maxViewWithKey (Cons x xs) =
+   forcePair $
+   case Map.maxViewWithKey xs of
+      Nothing -> (x,xs)
+      Just (y,ys) -> (y, uncurry Map.insert x ys)
+
+fromList :: (Ord k) => NonEmpty.T [] (k,a) -> T k a
+fromList (NonEmpty.Cons x xs) = uncurry insert x $ Map.fromList xs
+
+toAscList :: T k a -> NonEmpty.T [] (k,a)
+toAscList (Cons x xs) = NonEmpty.cons x $ Map.toAscList xs
+
+flatten :: (Ord k) => T k a -> Map k a
+flatten (Cons x xs) = uncurry Map.insert x xs
+
+union :: (Ord k) => T k a -> T k a -> T k a
+union (Cons x xs) (Cons y ys) =
+   uncurry Cons $
+   case Map.union xs ys of
+      zs ->
+         case comparing fst x y of
+            LT -> (x, Map.union zs $ uncurry Map.singleton y)
+            GT -> (y, uncurry Map.insert x zs)
+            EQ -> (x, zs)
+
+unionLeft :: (Ord k) => Map k a -> T k a -> T k a
+unionLeft xs (Cons y ys) =
+   insertGen snd y $ Map.union xs ys
+
+unionRight :: (Ord k) => T k a -> Map k a -> T k a
+unionRight (Cons x xs) ys =
+   insertGen fst x $ Map.union xs ys
diff --git a/src/Data/NonEmpty/Mixed.hs b/src/Data/NonEmpty/Mixed.hs
--- a/src/Data/NonEmpty/Mixed.hs
+++ b/src/Data/NonEmpty/Mixed.hs
@@ -48,17 +48,36 @@
    C.zipWith f (NonEmpty.flatten xs) (NonEmpty.tail xs)
 
 
+{- |
+This implementation is more efficient for Sequence than 'NonEmpty.viewR'.
+-}
+viewR :: (C.ViewR f, C.Empty f, C.Cons f) => NonEmpty.T f a -> (f a, a)
+viewR (NonEmpty.Cons x xs) =
+   case C.viewR xs of
+      Nothing -> (C.empty, x)
+      Just (ys, y) -> (C.cons x ys, y)
+
+init :: (C.ViewR f, C.Empty f, C.Cons f) => NonEmpty.T f a -> f a
+init = fst . viewR
+
+last :: (C.ViewR f) => NonEmpty.T f a -> a
+last (NonEmpty.Cons x xs) =
+   case C.viewR xs of
+      Nothing -> x
+      Just (_, y) -> y
+
+
 tails ::
-   (C.View f, C.Empty f) =>
+   (C.ViewL f, C.Empty f) =>
    f a -> NonEmpty.T [] (f a)
 tails xt =
    NonEmpty.force $
    case C.viewL xt of
       Nothing -> NonEmpty.Cons C.empty []
-      Just (_, xs) -> NonEmpty.cons xt $ tails xs
+      Just (_, xs) -> C.cons xt $ tails xs
 
 inits ::
-   (C.View f, C.Cons f, C.Empty f) =>
+   (C.ViewL f, C.Cons f, C.Empty f) =>
    f a -> NonEmpty.T [] (f a)
 inits xt =
    NonEmpty.Cons C.empty $
diff --git a/src/Data/NonEmpty/Set.hs b/src/Data/NonEmpty/Set.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/NonEmpty/Set.hs
@@ -0,0 +1,114 @@
+module Data.NonEmpty.Set (
+   T,
+   insert,
+   singleton,
+   member,
+   minView,
+   maxView,
+   fromList,
+   toAscList,
+   flatten,
+   union,
+   unionLeft,
+   unionRight,
+   ) where
+
+import qualified Data.NonEmpty as NonEmpty
+
+import qualified Data.Set as Set
+import Data.Set (Set, )
+
+import Control.Monad (mzero, )
+import Data.Maybe (fromMaybe, )
+import Data.Tuple.HT (forcePair, )
+
+
+{-
+The first field will always contain the smallest element.
+We do not use the NonEmpty data type here
+since it is easy to break this invariant using NonEmpty.!:.
+The custom type is also consistent with Map.
+-}
+data T a = Cons a (Set a)
+   deriving (Eq, Ord)
+
+instance (Show a) => Show (T a) where
+   showsPrec p xs =
+      showParen (p>10) $
+         showString "NonEmptySet.fromList " .
+         showsPrec 11 (toAscList xs)
+
+
+{- |
+We cannot have a reasonable @instance Insert Set@,
+since the @instance Insert (NonEmpty Set)@
+would preserve duplicate leading elements, whereas 'Set' does not.
+
+However, the @instance Insert NonEmpty@ is not the problem.
+A general type like
+
+> insertSet :: (Insert f, Ord a) => a -> f a -> NonEmpty f a
+
+cannot work, since it can be instantiated to
+
+> insertSet :: (Ord a) => a -> NonEmpty Set a -> NonEmpty (NonEmpty Set) a
+
+and this is obviously wrong:
+@insertSet x (singleton x)@ has only one element, not two.
+-}
+insert :: Ord a => a -> Set a -> T a
+insert = insertGen fst
+
+insertGen :: Ord a => ((a,a) -> a) -> a -> Set a -> T a
+insertGen select y xt =
+   uncurry Cons $
+   fromMaybe (y, xt) $ do
+      (x,xs) <- Set.minView xt
+      case compare y x of
+         GT -> return (x, Set.insert y xs)
+         EQ -> return (select (y,x), xs)
+         LT -> mzero
+
+singleton :: a -> T a
+singleton a = Cons a Set.empty
+
+member :: (Ord a) => a -> T a -> Bool
+member y (Cons x xs) =
+   y==x || Set.member y xs
+
+minView :: T a -> (a, Set a)
+minView (Cons x xs) = (x,xs)
+
+maxView :: (Ord a) => T a -> (a, Set a)
+maxView (Cons x xs) =
+   forcePair $
+   case Set.maxView xs of
+      Nothing -> (x,xs)
+      Just (y,ys) -> (y, Set.insert x ys)
+
+fromList :: (Ord a) => NonEmpty.T [] a -> T a
+fromList (NonEmpty.Cons x xs) = insert x $ Set.fromList xs
+
+toAscList :: T a -> NonEmpty.T [] a
+toAscList (Cons x xs) = NonEmpty.Cons x $ Set.toAscList xs
+
+flatten :: (Ord a) => T a -> Set a
+flatten (Cons x xs) = Set.insert x xs
+
+union :: (Ord a) => T a -> T a -> T a
+union (Cons x xs) (Cons y ys) =
+   uncurry Cons $
+   case Set.union xs ys of
+      zs ->
+         case compare x y of
+            LT -> (x, Set.union zs $ Set.singleton y)
+            GT -> (y, Set.insert x zs)
+            EQ -> (x, zs)
+
+unionLeft :: (Ord a) => Set a -> T a -> T a
+unionLeft xs (Cons y ys) =
+   insertGen snd y $ Set.union xs ys
+
+unionRight :: (Ord a) => T a -> Set a -> T a
+unionRight (Cons x xs) ys =
+   insertGen fst x $ Set.union xs ys
diff --git a/src/Data/NonEmptyPrivate.hs b/src/Data/NonEmptyPrivate.hs
--- a/src/Data/NonEmptyPrivate.hs
+++ b/src/Data/NonEmptyPrivate.hs
@@ -8,6 +8,7 @@
 
 import qualified Data.Traversable as Trav
 import qualified Data.Foldable as Fold
+import qualified Data.List.Match as Match
 import qualified Data.List.HT as ListHT
 import qualified Data.List as List
 import Data.Traversable (Traversable, mapAccumL, mapAccumR)
@@ -20,7 +21,7 @@
 import Data.Maybe (Maybe(Just, Nothing), maybe, mapMaybe, )
 import Data.Ord (Ord, Ordering(GT), (<), (>), compare, comparing, )
 import Data.Eq ((==), )
-import Data.Tuple.HT (mapSnd, )
+import Data.Tuple.HT (mapSnd, swap, )
 import Data.Tuple (fst, snd, )
 import qualified Prelude as P
 import Prelude (Eq, Show, Num, uncurry, )
@@ -59,7 +60,7 @@
   by nesting Optional and NonEmpty constructors.
   If list length @n@ is allowed, then place @Optional@ at depth @n@,
   if it is disallowed then place @NonEmpty@.
-  The maximm length is marked by @Empty@.
+  The maximum length is marked by @Empty@.
 -}
 data T f a = Cons { head :: a, tail :: f a }
    deriving (Eq, Ord)
@@ -117,10 +118,21 @@
    return = singleton
    (>>=) = bind
 
+
+instance (C.Arbitrary f) => C.Arbitrary (T f) where
+   arbitrary = arbitrary
+   shrink = shrink
+
 instance (QC.Arbitrary a, C.Arbitrary f) => QC.Arbitrary (T f a) where
-   arbitrary = liftA2 Cons QC.arbitrary C.arbitrary
-   shrink (Cons x xs) = fmap (\(y, Aux ys) -> Cons y ys) $ QC.shrink (x, Aux xs)
+   arbitrary = arbitrary
+   shrink = shrink
 
+arbitrary :: (QC.Arbitrary a, C.Arbitrary f) => QC.Gen (T f a)
+arbitrary = liftA2 Cons QC.arbitrary C.arbitrary
+
+shrink :: (QC.Arbitrary a, C.Arbitrary f) => T f a -> [T f a]
+shrink (Cons x xs) = fmap (\(y, Aux ys) -> Cons y ys) $ QC.shrink (x, Aux xs)
+
 newtype Aux f a = Aux (f a)
 
 instance (C.Arbitrary f, QC.Arbitrary a) => QC.Arbitrary (Aux f a) where
@@ -154,22 +166,32 @@
 flatten :: C.Cons f => T f a -> f a
 flatten (Cons x xs) = C.cons x xs
 
-fetch :: C.View f => f a -> Maybe (T f a)
+fetch :: C.ViewL f => f a -> Maybe (T f a)
 fetch = fmap (uncurry Cons) . C.viewL
 
 
 instance C.Cons f => C.Cons (T f) where
-   cons = cons
+   cons x0 (Cons x1 xs) = x0 !: C.cons x1 xs
 
-cons :: C.Cons f => a -> T f a -> T f a
-cons x0 (Cons x1 xs) = x0 !: C.cons x1 xs
+instance C.Snoc f => C.Snoc (T f) where
+   snoc (Cons x0 xs) x1 = x0 !: C.snoc xs x1
 
--- snoc :: T f a -> a -> T f a
-snocExtend :: Traversable f => f a -> a -> T f a
-snocExtend xs y0 =
-   uncurry Cons $ mapAccumR (\y x -> (x,y)) y0 xs
 
+{- |
+Synonym for 'Cons'.
+For symmetry to 'snoc'.
+-}
+cons :: a -> f a -> T f a
+cons = Cons
 
+snoc :: Traversable f => f a -> a -> T f a
+snoc xs x =
+   uncurry Cons $ mapAccumR (flip (,)) x xs
+
+snocAlt :: (C.Cons f, Traversable f) => f a -> a -> f a
+snocAlt xs x = flatten $ snoc xs x
+
+
 instance C.Empty f => C.Singleton (T f) where
    singleton = singleton
 
@@ -177,17 +199,11 @@
 singleton x = x !: C.empty
 
 
-{-
-This implementation needs quadratic time
-with respect to the number of 'Cons'.
-Maybe a linear time solution can be achieved using a type function
-that maps a container type to the type of the reversed container.
--}
-reverse :: (Traversable f, C.Reverse f) => T f a -> T f a
-reverse (Cons x xs) = snocExtend (C.reverse xs) x
+viewL :: T f a -> (a, f a)
+viewL (Cons x xs) = (x, xs)
 
-instance (Traversable f, C.Reverse f) => C.Reverse (T f) where
-   reverse = reverse
+viewR :: (Traversable f) => T f a -> (f a, a)
+viewR (Cons x xs) = swap $ mapAccumL (flip (,)) x xs
 
 
 mapHead :: (a -> a) -> T f a -> T f a
@@ -196,8 +212,8 @@
 mapTail :: (f a -> g a) -> T f a -> T g a
 mapTail f (Cons x xs) = x !: f xs
 
-init :: (C.Zip f, C.Cons f) => T f a -> f a
-init (Cons x xs) = C.zipWith const (C.cons x xs) xs
+init :: (Traversable f) => T f a -> f a
+init = fst . viewR
 
 last :: (Foldable f) => T f a -> a
 last = foldl1 (flip const)
@@ -216,6 +232,46 @@
 foldl1Map g f (Cons x xs) = Fold.foldl (\b a -> f b (g a)) (g x) xs
 
 
+-- cf. NumericPrelude: Algebra.Additive.sumNestedCommutative
+{-
+Estimate costs of @foldBalanced ListHT.merge@.
+@a, b, c@ length of sub-lists and our measure for the cost.
+
+xs = [a,b,c]
+ys = [a,b,c,a+b,c+a+b]
+costs: (a+b) + (c+a+b) = 2a+2b+c
+
+xs = [a,b,c,d]
+ys = [a,b,c,d,a+b,c+d,a+b+c+d]
+costs: (a+b) + (c+d) + (a+b+c+d) = 2a+2b+2c+2d
+
+xs = [a,b,c,d,e]
+ys = [a,b,c,d,e,a+b,c+d,e+(a+b),c+d+e+(a+b)]
+costs: (a+b) + (c+d) + (e+(a+b)) + (c+d+e+(a+b)) = 3a+3b+2c+2d+2e
+
+Analysis is easiest if @length xs@ is a power of two, e.g. @2^n@.
+Then the operator tree has height @n@.
+That is, we get a run-time of @n * sum (map length xs)@.
+This is usually better than @sort (concat xs)@
+which has run-time @let m = sum (map length xs) in m * logBase 2 m@.
+-}
+{- |
+Fold a non-empty list in a balanced way.
+/Balanced/ means that each element
+has approximately the same depth in the operator tree.
+/Approximately the same depth/ means
+that the difference between maximum and minimum depth is at most 1.
+The accumulation operation must be associative and commutative
+in order to get the same result as 'foldl1' or 'foldr1'.
+-}
+foldBalanced :: (a -> a -> a) -> T [] a -> a
+foldBalanced f xs@(Cons _ rs) =
+   let reduce (z0:z1:zs) = f z0 z1 : reduce zs
+       reduce zs = zs
+       ys = appendRight xs $ Match.take rs $ reduce $ flatten ys
+   in  last ys
+
+
 -- | maximum is a total function
 maximum :: (Ord a, Foldable f) => T f a -> a
 maximum = foldl1 P.max
@@ -269,22 +325,20 @@
 
 
 instance (C.Cons f, C.Append f) => C.Append (T f) where
-   append = append
+   append xs ys = appendRight xs (flatten ys)
 
-append :: (C.Cons f, C.Append f) => T f a -> T f a -> T f a
-append xs ys = appendRight xs (flatten ys)
+append :: (C.Append f, Traversable f) => T f a -> T f a -> T (T f) a
+append xs ys =
+   mapTail (flip appendLeft ys) xs
 
 appendRight :: (C.Append f) => T f a -> f a -> T f a
 appendRight (Cons x xs) ys = Cons x (C.append xs ys)
 
 appendLeft ::
-   (C.Append f, C.View f, C.Cons f) =>
+   (C.Append f, Traversable f) =>
    f a -> T f a -> T f a
-appendLeft xt yt =
-   force $
-   case C.viewL xt of
-      Nothing -> yt
-      Just (x,xs) -> Cons x $ C.append xs $ flatten yt
+appendLeft xt (Cons y ys) =
+   mapTail (flip C.append ys) $ snoc xt y
 
 
 {- |
@@ -293,7 +347,7 @@
 -}
 cycle :: (C.Cons f, C.Append f) => T f a -> T f a
 cycle x =
-   let y = append x y
+   let y = C.append x y
    in  y
 
 
@@ -307,38 +361,101 @@
 instance (C.Repeat f) => C.Repeat (T f) where
    repeat a = Cons a $ C.repeat a
 
+instance (C.Iterate f) => C.Iterate (T f) where
+   iterate f a = Cons a $ C.iterate f (f a)
 
-instance (C.Sort f, Insert f) => C.Sort (T f) where
-   sortBy = sortBy
 
+{-
+This implementation needs quadratic time
+with respect to the number of 'Cons'.
+Maybe a linear time solution can be achieved using a type function
+that maps a container type to the type of the reversed container.
+-}
+reverse :: (Traversable f, C.Reverse f) => T f a -> T f a
+reverse (Cons x xs) = snoc (C.reverse xs) x
+
+instance (Traversable f, C.Reverse f) => C.Reverse (T f) where
+   reverse = reverse
+
+
 {- |
 If you nest too many non-empty lists
 then the efficient merge-sort (linear-logarithmic runtime)
 will degenerate to an inefficient insert-sort (quadratic runtime).
 -}
-sortBy :: (C.Sort f, Insert f) => (a -> a -> Ordering) -> T f a -> T f a
-sortBy f (Cons x xs) =
-   insertBy f x $ C.sortBy f xs
-
-sort :: (Ord a, C.Sort f, Insert f) => T f a -> T f a
-sort = sortBy compare
+instance (C.Sort f, InsertBy f) => C.Sort (T f) where
+   sort (Cons x xs) = insert x $ C.sort xs
 
+instance (C.SortBy f, InsertBy f) => C.SortBy (T f) where
+   sortBy f (Cons x xs) = insertBy f x $ C.sortBy f xs
 
 
 class Insert f where
-   insertBy :: (a -> a -> Ordering) -> a -> f a -> T f a
+   {- |
+   Insert an element into an ordered list while preserving the order.
+   -}
+   insert :: (Ord a) => a -> f a -> T f a
 
 instance (Insert f) => Insert (T f) where
+   insert y xt@(Cons x xs) =
+      uncurry Cons $
+      case compare y x of
+         GT -> (x, insert y xs)
+         _ -> (y, xt)
+
+instance Insert Empty.T where
+   insert = insertDefault
+
+instance Insert [] where
+   insert = insertDefault
+
+instance Insert Maybe where
+   insert = insertDefault
+
+instance Insert Seq where
+   insert = insertDefault
+
+{-
+This does not work consistently!
+A Set is not a sorted list, since it collapses duplicate elements.
+
+*Data.NonEmptyPrivate> mapTail (mapTail Set.toList) $ insert '3' $ insert '7' $ Set.fromList "346"
+'3'!:'3'!:'4':'6':'7':[]
+
+instance Insert Set where
+   insert y xt =
+      uncurry Cons $
+      fromMaybe (y, xt) $ do
+         (x,xs) <- Set.minView xt
+         case compare y x of
+            GT -> return (x, Set.insert y xs)
+            EQ -> return (x, xs)
+            LT -> mzero
+
+We have preserved that function in NonEmpty.Mixed.
+-}
+
+{- |
+Default implementation for 'insert' based on 'insertBy'.
+-}
+insertDefault :: (Ord a, InsertBy f, C.SortBy f) => a -> f a -> T f a
+insertDefault = insertBy compare
+
+
+class Insert f => InsertBy f where
+   insertBy :: (a -> a -> Ordering) -> a -> f a -> T f a
+
+instance (InsertBy f) => InsertBy (T f) where
    insertBy f y xt@(Cons x xs) =
       uncurry Cons $
       case f y x of
          GT -> (x, insertBy f y xs)
          _ -> (y, xt)
 
-instance Insert Empty.T where
+instance InsertBy Empty.T where
    insertBy _ x Empty.Cons = Cons x Empty.Cons
 
-instance Insert [] where
+instance InsertBy [] where
    insertBy f y xt =
       uncurry Cons $
       case xt of
@@ -348,7 +465,7 @@
                GT -> (x, List.insertBy f y xs)
                _ -> (y, xt)
 
-instance Insert Maybe where
+instance InsertBy Maybe where
    insertBy f y mx =
       uncurry Cons $
       case mx of
@@ -359,7 +476,7 @@
                GT -> (x, y)
                _ -> (y, x)
 
-instance Insert Seq where
+instance InsertBy Seq where
    {-
    If we assume a sorted list
    we could do binary search for the splitting point.
@@ -373,16 +490,7 @@
                w Seq.:< ws -> (w, ws Seq.>< y Seq.<| zs)
 
 
-{- |
-Insert an element into an ordered list while preserving the order.
-The first element of the resulting list is returned individually.
-We need this for construction of a non-empty list.
--}
-insert :: (Ord a, Insert f, C.Sort f) => a -> f a -> T f a
-insert = insertBy compare
 
-
-
 class Functor f => RemoveEach f where
    removeEach :: T f a -> T f (a, f a)
 
@@ -434,7 +542,7 @@
    tails = tailsDefault
 
 tailsDefault ::
-   (C.Cons f, C.Empty f, C.View f, Tails f,
+   (C.Cons f, C.Empty f, C.ViewL f, Tails f,
     C.Cons g, C.Empty g) =>
    f a -> T f (g a)
 tailsDefault xt =
@@ -443,11 +551,11 @@
       Nothing -> Cons C.empty C.empty
       Just (x, xs) ->
          case tails xs of
-            xss -> cons (C.cons x $ head xss) xss
+            xss -> C.cons (C.cons x $ head xss) xss
 
 
 {-
-Not exorted by NonEmpty.
+Not exported by NonEmpty.
 I think the transposeClip function is better.
 -}
 class TransposeOuter f where
diff --git a/src/Data/NonEmptyTest.hs b/src/Data/NonEmptyTest.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/NonEmptyTest.hs
@@ -0,0 +1,8 @@
+module Data.NonEmptyTest where
+
+import qualified Data.NonEmptyPrivate as NonEmpty
+
+
+foldBalanced :: NonEmpty.T [] Integer -> Bool
+foldBalanced xs =
+   NonEmpty.foldBalanced (+) xs == NonEmpty.sum xs
diff --git a/src/Data/Optional.hs b/src/Data/Optional.hs
--- a/src/Data/Optional.hs
+++ b/src/Data/Optional.hs
@@ -8,7 +8,7 @@
 import qualified Data.NonEmpty.Class as C
 import qualified Data.NonEmpty as NonEmpty
 import qualified Data.Empty as Empty
-import Data.NonEmptyPrivate (Aux(Aux), snocExtend)
+import Data.NonEmptyPrivate (Aux(Aux), snoc)
 
 import qualified Data.Traversable as Trav
 import qualified Data.Foldable as Fold
@@ -88,14 +88,29 @@
 instance (Trav.Traversable f, C.Reverse f) => C.Reverse (T f) where
    reverse Nil = Nil
    reverse (Cons x xs) =
-      fromNonEmpty (snocExtend (C.reverse xs) x)
+      fromNonEmpty (snoc (C.reverse xs) x)
 
 instance (NonEmpty.Insert f, C.Sort f) => C.Sort (T f) where
+   sort Nil = Nil
+   sort (Cons x xs) =
+      fromNonEmpty $ NonEmpty.insert x $ C.sort xs
+
+instance (NonEmpty.InsertBy f, C.SortBy f) => C.SortBy (T f) where
    sortBy _ Nil = Nil
    sortBy f (Cons x xs) =
       fromNonEmpty $ NonEmpty.insertBy f x $ C.sortBy f xs
 
 instance (NonEmpty.Insert f) => NonEmpty.Insert (T f) where
+   insert y xt =
+      uncurry NonEmpty.Cons $
+      case xt of
+         Nil -> (y, xt)
+         Cons x xs ->
+            case P.compare y x of
+               GT -> (x, fromNonEmpty $ NonEmpty.insert y xs)
+               _ -> (y, xt)
+
+instance (NonEmpty.InsertBy f) => NonEmpty.InsertBy (T f) where
    insertBy f y xt =
       uncurry NonEmpty.Cons $
       case xt of