diff --git a/src/Data/Traversable.purs b/src/Data/Traversable.purs
index 884d683..7e553fb 100644
--- a/src/Data/Traversable.purs
+++ b/src/Data/Traversable.purs
@@ -1,6 +1,7 @@
 module Data.Traversable
   ( class Traversable, traverse, sequence
   , traverseDefault, sequenceDefault
+  , traverseM
   , for
   , scanl
   , scanr
@@ -70,6 +71,30 @@ sequenceDefault
   -> m (t a)
 sequenceDefault = traverse identity
 
+-- | A version of `traverse` where a `join` is applied to the inner result
+-- |
+-- | For example where `traverse` applied over an array of `Effect`s will produce `Effect (Array (Array _))` 
+-- | The same array applied to `traverseM` will results in `Effect (Array _)`
+-- |
+-- | testTraverseM :: Effect Unit
+-- | testTraverseM = do 
+-- |   result <- traverseM identity [ arrayZero, arrayOne, arrayTwo, arrayThree ] 
+-- |   assert $ result == [ 1, 2, 2, 3, 3, 3 ] 
+-- |   where
+-- |     arrayZero   = pure [ ]
+-- |     arrayOne    = pure [ 1 ]
+-- |     arrayTwo    = pure [ 2, 2 ]
+-- |     arrayThree  = pure [ 3, 3, 3 ]
+traverseM 
+  :: forall a b f t
+   . Applicative f
+  => Traversable t
+  => Bind t
+  => (a -> f (t b))
+  -> t a
+  -> f (t b)
+traverseM fn ta = join <$> traverse fn ta
+
 instance traversableArray :: Traversable Array where
   traverse = traverseArrayImpl apply map pure
   sequence = sequenceDefault
diff --git a/test/Main.purs b/test/Main.purs
index 16a377b..47eacc8 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -13,7 +13,7 @@ import Data.Int (toNumber, pow)
 import Data.Maybe (Maybe(..))
 import Data.Monoid.Additive (Additive(..))
 import Data.Newtype (unwrap)
-import Data.Traversable (class Traversable, sequenceDefault, traverse, sequence, traverseDefault)
+import Data.Traversable (class Traversable, sequenceDefault, traverse, traverseM, sequence, traverseDefault)
 import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
 import Effect (Effect, foreachE)
 import Effect.Console (log)
@@ -66,6 +66,9 @@ main = do
   log "Test sequenceDefault"
   testSequenceDefault 20
 
+  log "Test traverseM"
+  testTraverseM
+
   log "Test foldableWithIndexArray instance"
   testFoldableWithIndexArrayWith 20
 
@@ -386,6 +389,17 @@ testSequenceDefault :: Int -> Effect Unit
 testSequenceDefault = testTraversableFWith (SD <<< arrayFrom1UpTo)
 
 
+testTraverseM :: Effect Unit
+testTraverseM = do 
+  result <- traverseM identity [ arrayZero, arrayOne, arrayTwo, arrayThree ] 
+  assert $ result == [ 1, 2, 2, 3, 3, 3 ] 
+  where
+    arrayZero   = pure [ ]
+    arrayOne    = pure [ 1 ]
+    arrayTwo    = pure [ 2, 2 ]
+    arrayThree  = pure [ 3, 3, 3 ]
+
+
 -- structure for testing bifoldable, picked `inclusive or` as it has both products and sums
 
 data IOr l r = Both l r | Fst l | Snd r