Flippers: a compositional shoehorn.
Posted on January 14, 2014
This is a quick writeup about the haskell library Control.Flippers and how I find it useful.
The library was born of a real problem refactoring code; a quick search indicates I am not the first to come up with this solution, just the only one that has bothered to make a standalone library of it.
Convoluted theoretical examples aren’t my thing, so I’ll explain the actual problem from the top.
I’m writing FFI bindings to a C library to send statistics to an internal system. This library is called ‘libmarquise’ and it sends statistics to a system we have invented called ‘vaultaire’. The names make me cringe too, you’ll be okay.
I more or less have to cover five very similar but slightly different functions, they are:
sendText :: [(B.ByteString, B.ByteString)] -> Word64
-> B.ByteString -> Marquise ()
sendInt :: [(B.ByteString, B.ByteString)] -> Word64
-> Int64 -> Marquise ()
sendReal :: [(B.ByteString, B.ByteString)] -> Word64
-> Rational -> Marquise ()
sendCounter :: [(B.ByteString, B.ByteString)] -> Word64
-> Marquise ()
sendBinary :: [(B.ByteString, B.ByteString)] -> Word64
-> B.ByteString -> Marquise ()The way I usually proceed from here is to simply implement one function the stupid way, and then try on a few different refactorings. This leads me to write:
sendText :: [(B.ByteString, B.ByteString)] -> Word64
-> B.ByteString -> Marquise ()
sendText tag_pairs timestamp text = do
connection <- ask
liftIO $ void $
withCStringArray (map fst tag_pairs) $ \fields_ptr ->
withCStringArray (map snd tag_pairs) $ \values_ptr ->
B.useAsCStringLen text $ \(text_ptr, text_len) ->
E.throwIfMinus1 "marquise_send_text" $
F.c_marquise_send_text connection
fields_ptr
values_ptr
(fromIntegral $ length tag_pairs)
text_ptr
(fromIntegral text_len)
timestamp
where
withCStringArray :: [B.ByteString] -> (Ptr CString -> IO a) -> IO a
withCStringArray bss f = do
let continuations = map B.useAsCString bss in
runCont (mapM cont continuations) $ \cstrings ->
SV.unsafeWith (SV.fromList cstrings) $ \ptr -> f ptr
sendInt = undefined
sendReal = undefined
...There are seven arguments to the FFI call to c_marquise_send_text. This makes me sad. I’m sure you can see the potential for code reuse here though.
Let’s make this a little nicer with a helper!
-- | Helper that builds a connection, cstring arrays and associated size,
-- then checks the continuation's result for negative one
withConnFieldsValuesLength :: String
-> [(B.ByteString, B.ByteString)]
-> (Ptr F.MarquiseConnection
-> Ptr CString
-> Ptr CString
-> CSize
-> IO CInt)
-> Marquise ()
withConnFieldsValuesLength c_function tag_pairs f = do
connection <- ask
liftIO $ void $
withCStringArray (map fst tag_pairs) $ \fields_ptr ->
withCStringArray (map snd tag_pairs) $ \values_ptr ->
E.throwIfMinus1 c_function $ f connection
fields_ptr
values_ptr
(fromIntegral $ length tag_pairs)
where
withCStringArray :: [B.ByteString] -> (Ptr CString -> IO a) -> IO a
withCStringArray bss f' = do
(runCont . mapM cont) (map B.useAsCString bss) $ \cstrings ->
SV.unsafeWith (SV.fromList cstrings) f'
sendText :: [(B.ByteString, B.ByteString)] -> Word64 -> B.ByteString -> Marquise ()
sendText tag_pairs timestamp text =
withConnFieldsValuesLength "marquise_send_text" tag_pairs $ \c f v l ->
B.useAsCStringLen text $ \(text_ptr, text_len) ->
F.c_marquise_send_text c f v l
text_ptr
(fromIntegral text_len)
timestampOur withConnFieldsValueLenght does exactly what it’s name suggests, runs our code with a connection, tag fields, tag values and number of tags.
And so, sendInt and sendReal become very concise:
sendInt :: [(B.ByteString, B.ByteString)] -> Word64 -> Int64 -> Marquise ()
sendInt tag_pairs timestamp int =
withConnFieldsValuesLength "marquise_send_text" tag_pairs $ \c f v l ->
F.c_marquise_send_int c f v l int timestamp
sendReal :: [(B.ByteString, B.ByteString)] -> Word64 -> Rational -> Marquise ()
sendReal tag_pairs timestamp r =
withConnFieldsValuesLength "marquise_send_real" tag_pairs $ \c f v l ->
F.c_marquise_send_real c f v l (fromRational r) timestampI hated passing c f v l around though, it really bothered me! If I could just partially apply the last to arguments to say, F.c_marquise_send_real, then I would be able to write that bit point free. What I really needed was a rotate6 function, then I’d be able to write:
sendInt :: [(B.ByteString, B.ByteString)] -> Word64 -> Int64 -> Marquise ()
sendInt tag_pairs timestamp int =
withConnFieldsValuesLength "marquise_send_int" tag_pairs $
(rotate6 . rotate6) F.c_marquise_send_int int timestamp
sendReal :: [(B.ByteString, B.ByteString)] -> Word64 -> Rational -> Marquise ()
sendReal tag_pairs timestamp r =
withConnFieldsValuesLength "marquise_send_real" tag_pairs $
(rotate6 . rotate6) F.c_marquise_send_real (fromRational r) timestamp
sendCounter :: [(B.ByteString, B.ByteString)] -> Word64 -> Marquise ()
sendCounter tag_pairs timestamp =
withConnFieldsValuesLength "marquise_send_counter" tag_pairs $
rotate5 F.c_marquise_send_counter timestampYes, this is going to great lengths to remove a small bit of duplication, but I really do think that removing that clutter is worth it. Writing the definitions this way makes it much clearer what the difference between sendReal and sendInt. It’s important to remember that people can’t keep track that many things at once, it hurts their brains. Do you want to write code that hurts people? I suppose I do too sometimes. That’s besides the point.
rotate6 :: (a -> b -> c -> d -> e -> f -> g) -> f -> a -> b -> c -> d -> e -> g
rotate6 = flip . (rotate5 .)
where
rotate5 = flip . (rotate4 .)
rotate4 = flip . (rotate3 .)
rotate3 = flip . (flip .)Easy! You’ll note that we can compose these rotates to do whatever we like. For example:
-- | Reverse three arguments
flip3 :: (a -> b -> c -> d) -> (c -> b -> a -> d)
flip3 = rotate3 . rotate2