@@ -38,6 +38,7 @@ import Data.Binary.Put ( Put )
3838
3939import Data.ByteString
4040
41+import Control.Applicative
4142import Data.Bits
4243import Data.Monoid
4344import Data.Word
@@ -154,6 +155,18 @@ runBitPut m = Put.putBuilder b
154155 PairS _ s = run m (S mempty 0 0)
155156 (S b _ _) = flushIncomplete s
156157
158+instance Functor BitPut where
159+ fmap f (BitPut k) = BitPut $ \s ->
160+ let PairS x s' = k s
161+ in PairS (f x) s'
162+
163+instance Applicative BitPut where
164+ pure a = BitPut (\s -> PairS a s)
165+ (BitPut f) <*> (BitPut g) = BitPut $ \s ->
166+ let PairS a s' = f s
167+ PairS b s'' = g s'
168+ in PairS (a b) s''
169+
157170instance Monad BitPut where
158171 m >>= k = BitPut $ \s ->
159172 let PairS a s' = run m s