diff --git a/binary-strict.cabal b/binary-strict.cabal
--- a/binary-strict.cabal
+++ b/binary-strict.cabal
@@ -1,5 +1,5 @@
 name:            binary-strict
-version:         0.4.6
+version:         0.4.7
 license:         BSD3
 license-file:    LICENSE
 author:          Lennart Kolmodin <kolmodin@dtek.chalmers.se>
diff --git a/src/Data/Binary/BitPut.hs b/src/Data/Binary/BitPut.hs
--- a/src/Data/Binary/BitPut.hs
+++ b/src/Data/Binary/BitPut.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      : Data.Binary.BitPut
@@ -19,9 +20,15 @@
 -----------------------------------------------------------------------------
 module Data.Binary.BitPut
   ( BitPut
+  , BitPutM
+  , BitPutT
   , runBitPut
+  , runBitPutM
+  , runBitPutT
   , putBit
+  , putBitT
   , putNBits
+  , putNBitsT
   , putBits
   , putByteString
   , putLeftByteString
@@ -29,37 +36,41 @@
 
 import Data.Bits (bitSize, Bits)
 import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Error
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Binary.BitBuilder as BB
 
-newtype BitPut' a = BitPut' { unPut :: (a, BB.BitBuilder) }
+newtype BitPutM a = BitPutM { unPut :: (a, BB.BitBuilder) }
 
-type BitPut = BitPut' ()
+type BitPut = BitPutM ()
 
-instance Functor BitPut' where
-   fmap f m = BitPut' (let (a, w) = unPut m in (f a, w))
+instance Functor BitPutM where
+   fmap f m = BitPutM (let (a, w) = unPut m in (f a, w))
 
-instance Monad BitPut' where
-   return a = BitPut' (a,BB.empty)
-   m >>= k = BitPut' (let (a, w) = unPut m
+instance Monad BitPutM where
+   return a = BitPutM (a,BB.empty)
+   m >>= k = BitPutM (let (a, w) = unPut m
                           (b, w') = unPut (k a)
                        in (b, w `BB.append` w'))
 
-   m >> k = BitPut' (let (_, w) = unPut m
+   m >> k = BitPutM (let (_, w) = unPut m
                          (b, w') = unPut k
                       in (b, w `BB.append` w'))
    {-# INLINE (>>) #-}
 
+newtype BitPutT m a = BitPutT { unPutT :: m (a, BB.BitBuilder) }
+
 -- | Append a single bit
 putBit :: Bool -> BitPut
-putBit bit = BitPut' ((), BB.singleton bit)
+putBit bit = BitPutM ((), BB.singleton bit)
 
 -- | Append the bottom n bits of the given bits value. In the case that more
 --   bits are requested than the value provides, this acts as if the value
 --   has as unlimited number of leading 0 bits.
 putNBits :: (Integral a, Bits a) => Int -> a -> BitPut
-putNBits n v = BitPut' ((), BB.fromBits n v)
+putNBits n v = BitPutM ((), BB.fromBits n v)
 
 -- | Append a value. Note that this function is undefined for instances of Bits
 --   which have no fixed bitsize (like Integer)
@@ -68,15 +79,52 @@
 
 -- | Append a ByteString
 putByteString :: B.ByteString -> BitPut
-putByteString bs = BitPut' ((), BB.fromByteString (bs, 0))
+putByteString bs = BitPutM ((), BB.fromByteString (bs, 0))
 
 -- | Append a left aligned ByteString where ByteString has a partial byte
 --   with the given number of valid bits, from the MSB downwards. The number
 --   of such bits must be 0..7. (A normal ByteString, which all bytes full
 --   would use 0)
 putLeftByteString :: (B.ByteString, Int) -> BitPut
-putLeftByteString bs = BitPut' ((), BB.fromByteString bs)
+putLeftByteString bs = BitPutM ((), BB.fromByteString bs)
 
 runBitPut :: BitPut -> BL.ByteString
 runBitPut m = let (_, w) = unPut m
                in BB.toLazyByteString w
+
+runBitPutM :: BitPutM a -> (a, BL.ByteString)
+runBitPutM m = let (x, w) = unPut m
+               in (x, BB.toLazyByteString w)
+
+instance Monad m => Functor (BitPutT m) where
+   fmap f m = BitPutT $ do
+      ~(x, w) <- unPutT m
+      return (f x, w)
+
+instance Monad m => Monad (BitPutT m) where
+   return a = BitPutT $ return (a, BB.empty)
+   m >>= k = BitPutT $ do
+      ~(a, w) <- unPutT m
+      ~(b, w') <- unPutT (k a)
+      return (b, w `BB.append` w')
+
+runBitPutT :: Monad m => BitPutT m a -> m (a, BL.ByteString)
+runBitPutT m = do
+  ~(x, w) <- unPutT m
+  return (x, BB.toLazyByteString w)
+
+putBitT :: (Monad m) => Bool -> BitPutT m ()
+putBitT bit = BitPutT $ return ((), BB.singleton bit)
+
+putNBitsT :: (Monad m, Integral a, Bits a) => Int -> a -> BitPutT m ()
+putNBitsT n v = BitPutT $ return ((), BB.fromBits n v)
+
+instance MonadTrans BitPutT where
+   lift m = BitPutT $ do
+      a <- m
+      return (a, BB.empty)
+
+instance MonadError e m => MonadError e (BitPutT m) where
+   throwError = lift . throwError
+   m `catchError` h = BitPutT $ do
+      unPutT m `catchError` \e -> unPutT (h e)
diff --git a/src/Data/Binary/Strict/Class.hs b/src/Data/Binary/Strict/Class.hs
--- a/src/Data/Binary/Strict/Class.hs
+++ b/src/Data/Binary/Strict/Class.hs
@@ -4,7 +4,7 @@
 --   -fno-monomorphism-restriction is very useful.
 module Data.Binary.Strict.Class where
 
-import Control.Applicative(Alternative(..))
+import Control.Applicative (Alternative, (<|>))
 
 import qualified Data.ByteString as B
 import Data.Word