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
+Version:          0.1.1
 License:          BSD3
 License-File:     LICENSE
 Author:           Henning Thielemann <haskell@henning-thielemann.de>
@@ -50,7 +50,7 @@
 Build-Type:       Simple
 
 Source-Repository this
-  Tag:         0.1
+  Tag:         0.1.1
   Type:        darcs
   Location:    http://code.haskell.org/~thielema/non-empty
 
@@ -71,5 +71,6 @@
     Data.NonEmpty.Class
     Data.NonEmpty.Mixed
     Data.Empty
+    Data.Optional
   Other-Modules:
     Data.NonEmptyPrivate
diff --git a/src/Data/NonEmptyPrivate.hs b/src/Data/NonEmptyPrivate.hs
--- a/src/Data/NonEmptyPrivate.hs
+++ b/src/Data/NonEmptyPrivate.hs
@@ -43,9 +43,19 @@
 
 * @T Maybe a@ is a list that contains one or two elements.
 
+* @Maybe@ is isomorphic to @Optional Empty@.
+
 * @T Empty a@ is a list that contains exactly one element.
 
 * @T (T Empty) a@ is a list that contains exactly two elements.
+
+* @Optional (T Empty) a@ is a list that contains zero or two elements.
+
+* You can create a list type for every finite set of allowed list length
+  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@.
 -}
 data T f a = Cons { head :: a, tail :: f a }
    deriving (Eq, Ord)
diff --git a/src/Data/Optional.hs b/src/Data/Optional.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Optional.hs
@@ -0,0 +1,122 @@
+module Data.Optional (
+   T(Nil, Cons),
+   (?:),
+   fromEmpty,
+   fromNonEmpty,
+   ) where
+
+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 qualified Data.Traversable as Trav
+import qualified Data.Foldable as Fold
+import Control.Applicative (pure, liftA2, )
+
+import qualified Test.QuickCheck as QC
+
+import Control.Monad (return, )
+import Data.Functor (Functor, fmap, )
+import Data.Function (($), (.), )
+import Data.Ord (Ord, Ordering(GT), (>), )
+import Data.Tuple.HT (mapSnd, )
+import qualified Prelude as P
+import Prelude (Eq, Show, Num, uncurry, )
+
+
+data T f a = Nil | Cons a (f a)
+   deriving (Eq, Ord)
+
+fromEmpty :: Empty.T a -> T f a
+fromEmpty Empty.Cons = Nil
+
+fromNonEmpty :: NonEmpty.T f a -> T f a
+fromNonEmpty (NonEmpty.Cons x xs) = Cons x xs
+
+
+instance (C.Show f, P.Show a) => P.Show (T f a) where
+   showsPrec = C.showsPrec
+
+instance (C.Show f) => C.Show (T f) where
+   showsPrec _ Nil = P.showString "Nil"
+   showsPrec p (Cons x xs) =
+      P.showParen (p>5) $
+      P.showsPrec 6 x . P.showString "?:" . C.showsPrec 5 xs
+
+
+infixr 5 ?:
+
+(?:) :: a -> f a -> T f a
+(?:) = Cons
+
+
+instance P.Functor f => P.Functor (T f) where
+   fmap _ Nil = Nil
+   fmap f (Cons x xs) = Cons (f x) (fmap f xs)
+
+instance (Fold.Foldable f) => Fold.Foldable (T f) where
+   foldr _ y Nil = y
+   foldr f y (Cons x xs) = f x (Fold.foldr f y xs)
+
+instance (Trav.Traversable f) => Trav.Traversable (T f) where
+   sequenceA Nil = pure Nil
+   sequenceA (Cons x xs) = liftA2 Cons x (Trav.sequenceA xs)
+
+instance (C.Arbitrary f, QC.Arbitrary a) => QC.Arbitrary (T f a) where
+   arbitrary =
+      QC.oneof
+         [return Nil, liftA2 Cons QC.arbitrary C.arbitrary]
+   shrink Nil = []
+   shrink (Cons x xs) =
+      P.map (\(y, Aux ys) -> Cons y ys) (QC.shrink (x, Aux xs))
+
+instance C.Empty (T f) where
+   empty = Nil
+
+instance (C.Cons f, C.Empty f) => C.Cons (T f) where
+   cons x Nil = Cons x C.empty
+   cons x0 (Cons x1 xs) = Cons x0 $ C.cons x1 xs
+
+instance (C.Repeat f) => C.Repeat (T f) where
+   repeat x = Cons x $ C.repeat x
+
+instance C.Zip f => C.Zip (T f) where
+   zipWith f (Cons x xs) (Cons y ys) = Cons (f x y) (C.zipWith f xs ys)
+   zipWith _ _ _ = Nil
+
+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)
+
+instance (NonEmpty.Insert f, C.Sort f) => C.Sort (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
+   insertBy f y xt =
+      uncurry NonEmpty.Cons $
+      case xt of
+         Nil -> (y, xt)
+         Cons x xs ->
+            case f y x of
+               GT -> (x, fromNonEmpty $ NonEmpty.insertBy f y xs)
+               _ -> (y, xt)
+
+instance NonEmpty.RemoveEach f => NonEmpty.RemoveEach (T f) where
+   removeEach (NonEmpty.Cons x Nil) = NonEmpty.Cons (x, Nil) Nil
+   removeEach (NonEmpty.Cons x0 xs0@(Cons x1 xs1)) =
+      NonEmpty.Cons (x0, xs0) $
+      fmap (mapSnd (x0 ?:)) $
+      fromNonEmpty $ NonEmpty.removeEach $ NonEmpty.Cons x1 xs1
+
+instance NonEmpty.Tails f => NonEmpty.Tails (T f) where
+   tails xt =
+      NonEmpty.force $
+      case xt of
+         Nil -> NonEmpty.Cons C.empty Nil
+         Cons x xs ->
+            case NonEmpty.tails xs of
+               xss -> NonEmpty.Cons (C.cons x $ NonEmpty.head xss) (fromNonEmpty xss)