diff --git a/Data/FMList.hs b/Data/FMList.hs
--- a/Data/FMList.hs
+++ b/Data/FMList.hs
@@ -4,7 +4,7 @@
 -- Copyright   :  (c) Sjoerd Visscher 2009
 -- License     :  BSD-style (see the file LICENSE)
 --
--- Maintainer  :  sjoerd
+-- Maintainer  :  sjoerd@w3future.com
 -- Stability   :  experimental
 -- Portability :  portable
 --
@@ -28,6 +28,7 @@
 -----------------------------------------------------------------------------
 {-# LANGUAGE RankNTypes #-}
 
+
 module Data.FMList ( 
 
     FMList(..)
@@ -77,8 +78,9 @@
 
 import Prelude 
   ( (.), ($), ($!), flip, const, id, error
-  , Maybe(..), maybe, Either(..)
-  , Bool(..), (||), not
+  , Maybe(..), maybe
+  , Either(..), either
+  , Bool(..), (&&)
   , Ord(..), Num(..), Int
   , Show(..), String, (++)
   )
@@ -92,7 +94,7 @@
 
 -- | 'FMList' is a 'foldMap' function wrapped up in a newtype.
 --
-newtype FMList a = FM { unFM :: forall b . Monoid b => (a -> b) -> b }
+newtype FMList a = FM { unFM :: forall m . Monoid m => (a -> m) -> m }
 
 -- | The function 'transform' transforms a list by changing 
 -- the map function that is passed to 'foldMap'.
@@ -115,30 +117,37 @@
 --
 --  * @= transform (\\f -> foldMap f . g) m@
 -- 
-transform :: (forall b. Monoid b => (a -> b) -> (c -> b)) -> FMList c -> FMList a
-transform t l = FM $ \f -> unFM l (t f)
+transform :: (forall m. Monoid m => (a -> m) -> (b -> m)) -> FMList b -> FMList a
+transform t (FM l) = FM (l . t)
 
--- nil is exported as empty from Applicative
+-- shorthand constructors
 nil          :: FMList a
-nil          = FM $ \_ -> mempty
+nil          = FM mempty
 
+one          :: a -> FMList a
+one x        = FM ($ x)
+
+(#)          :: FMList a -> FMList a -> FMList a
+FM l # FM r  = FM (l `mappend` r)
+
+-- exported constructors
 singleton    :: a -> FMList a
-singleton x  = FM $ \f -> f x
+singleton    = one
 
 cons         :: a -> FMList a -> FMList a
-cons x l     = FM $ \f -> f x `mappend` unFM l f
+cons x l     = one x # l
 
 snoc         :: FMList a -> a -> FMList a
-snoc l x     = FM $ \f -> unFM l f `mappend` f x
+snoc l x     = l # one x
 
 pair         :: a -> a -> FMList a
-pair l r     = FM $ \f -> f l `mappend` f r
+pair l r     = one l # one r
 
 append       :: FMList a -> FMList a -> FMList a
--- append l r  = FM $ \f -> unFM l f `mappend` unFM r f
-append l r   = FM $ unFM l `mappend` unFM r
+append       = (#)
 
 
+
 fromList     :: [a] -> FMList a
 fromList     = fromFoldable
 
@@ -146,8 +155,11 @@
 fromFoldable l = FM $ flip foldMap l
 
 
+mhead        :: FMList a -> Maybe a
+mhead l      = getFirst (unFM l (First . Just))
+
 null         :: FMList a -> Bool
-null         = foldr (\_ _ -> False) True
+null         = maybe True (const False) . mhead
 
 length       :: FMList a -> Int
 length       = genericLength
@@ -157,7 +169,7 @@
 
 
 head         :: FMList a -> a
-head l       = getFirst (unFM l (First . Just)) `fromJustOrError` "Data.FMList.head: empty list"
+head l       = mhead l `fromJustOrError` "Data.FMList.head: empty list"
 
 tail         :: FMList a -> FMList a
 tail l       = if null l then error "Data.FMList.tail: empty list" else drop (1::Int) l
@@ -169,7 +181,7 @@
 init l       = if null l then error "Data.FMList.init: empty list" else reverse . drop (1::Int) . reverse $ l
 
 reverse      :: FMList a -> FMList a
-reverse l    = FM $ \f -> getDual $ unFM l (Dual . f)
+reverse l    = FM $ getDual . unFM l . (Dual .)
 
 
 flatten      :: Foldable t => FMList (t a) -> FMList a
@@ -178,27 +190,25 @@
 filter       :: (a -> Bool) -> FMList a -> FMList a
 filter p     = transform (\f e -> if p e then f e else mempty)
 
-take         :: (Ord n, Num n) => n -> FMList a -> FMList a
-take n l     = FM $ \f -> 
-  foldr (\e r i -> if i > 0 then mappend (f e) (r (i-1)) else mempty) (const mempty) l n
 
-drop         :: (Ord n, Num n) => n -> FMList a -> FMList a
-drop n l     = FM $ \f -> 
-  foldr (\e r i -> if i <= 0 then mappend (f e) (r i) else r (i-1)) (const mempty) l n
+-- transform the foldMap to foldr with state.
+transformCS  :: (forall m. Monoid m => (b -> m) -> a -> (m -> s -> m) -> s -> m) -> s -> FMList a -> FMList b
+transformCS t s0 l = FM $ \f -> foldr (\e r -> t f e (\a -> mappend a . r)) mempty l s0
 
+take         :: (Ord n, Num n) => n -> FMList a -> FMList a
+take n       = transformCS (\f e c i -> if i > 0 then c (f e) (i-1) else mempty) n
+
 takeWhile    :: (a -> Bool) -> FMList a -> FMList a
-takeWhile p l = FM $ \f -> 
-  foldr (\e r -> if p e then mappend (f e) r else mempty) mempty l
+takeWhile p  = transformCS (\f e c _ -> if p e then c (f e) True else mempty) True
 
-dropWhile    :: (a -> Bool) -> FMList a -> FMList a
-dropWhile p l = FM $ \f -> 
-  foldr (\e r done -> if done || not (p e) then mappend (f e) (r True) else r False) (const mempty) l False
+drop         :: (Ord n, Num n) => n -> FMList a -> FMList a
+drop n       = transformCS (\f e c i -> if i <= 0 then c (f e) 0 else c mempty (i-1)) n
 
+dropWhile    :: (a -> Bool) -> FMList a -> FMList a
+dropWhile p  = transformCS (\f e c ok -> if ok && p e then c mempty True else c (f e) False) True
 
 zipWith      :: (a -> b -> c) -> FMList a -> FMList b -> FMList c
-zipWith t l1 l2 = FM $ \f -> 
-  foldr (\e1 r r2 -> 
-	  foldr (\e2 _ -> mappend (f (t e1 e2)) (r (drop (1::Int) r2))) mempty r2) (const mempty) l1 l2
+zipWith t    = transformCS (\f e2 c r1 -> foldr (\e1 _ -> c (f (t e1 e2)) (drop (1::Int) r1)) mempty r1)
 
 zip          :: FMList a -> FMList b -> FMList (a,b)
 zip          = zipWith (,)
@@ -225,8 +235,7 @@
 unfoldr g    = unfold (maybe empty (\(a, b) -> Right a `pair` Left b) . g)
 
 -- | 'unfold' builds a list from a seed value.
--- The function takes the seed and returns an 'FMList' 
--- (or any other 'Foldable' instance) of values.
+-- The function takes the seed and returns an 'FMList' of values.
 -- If the value is 'Right' @a@, then @a@ is appended to the result, and if the
 -- value is 'Left' @b@, then @b@ is used as seed value in a recursive call.
 --
@@ -235,10 +244,8 @@
 -- > *> unfold (\b -> if b == 0 then empty else Left (b-1) `pair` Right b) 10
 -- > fromList [1,2,3,4,5,6,7,8,9,10]
 --
-unfold       :: Foldable t => (b -> t (Either b a)) -> b -> FMList a
-unfold g b   = FM $ \f -> foldMap (u f) (g b) where
-  u f (Left b)  = foldMap (u f) (g b)
-  u f (Right a) = f a
+unfold       :: (b -> FMList (Either b a)) -> b -> FMList a
+unfold g     = transform (\f -> either (foldMap f . unfold g) f) . g
 
 
 instance Functor FMList where
@@ -247,32 +254,38 @@
 instance Foldable FMList where
   foldMap    = flip unFM
   
-instance Traversable FMList where
-  traverse f = foldr cons_f (pure empty) where cons_f x ys = cons <$> f x <*> ys
-
 instance Monad FMList where
-  return     = singleton
+  return     = one
   m >>= g    = transform (\f -> foldMap f . g) m
 
 instance Applicative FMList where
-  pure       = return
+  pure       = one
   gs <*> xs  = transform (\f g -> unFM xs (f . g)) gs
     
 instance Monoid (FMList a) where
   mempty     = nil
-  mappend    = append
+  mappend    = (#)
   
 instance MonadPlus FMList where
   mzero      = nil
-  mplus      = append
+  mplus      = (#)
   
 instance Alternative FMList where
   empty      = nil
-  (<|>)      = append
+  (<|>)      = (#)
   
 instance Show a => Show (FMList a) where
   show l     = "fromList " ++ (show $! toList l)
   
-  
+
+newtype WrapApp f m = WrapApp { unWrapApp :: f m }
+instance (Applicative f, Monoid m) => Monoid (WrapApp f m) where
+  mempty                          = WrapApp $ pure mempty
+  mappend (WrapApp a) (WrapApp b) = WrapApp $ mappend <$> a <*> b
+
+instance Traversable FMList where
+  traverse f = unWrapApp . foldMap one_f where one_f x = WrapApp $ one <$> f x
+
+
 fromJustOrError :: Maybe a -> String -> a
 fromJustOrError ma e = maybe (error e) id ma
diff --git a/fmlist.cabal b/fmlist.cabal
--- a/fmlist.cabal
+++ b/fmlist.cabal
@@ -1,5 +1,5 @@
 name:                fmlist
-version:             0.5
+version:             0.6
 synopsis:            FoldMap lists
 description:         
   FoldMap lists are lists represented by their foldMap function.