bitwise fiddling in Haskell

corrector.hs

{-
Response to http://lists.samba.org/archive/linux/2013-November/032604.html
and http://lists.samba.org/archive/linux/2013-November/032610.html

Author: Carlo Hamalainen <[email protected]>
-}

import Control.Monad
import Data.Binary.Get
import Data.Bits
import Data.Char
import Data.List.Split
import Data.Maybe
import Data.Word

import qualified Data.ByteString.Lazy as BSL

-- Extract the 2-bit pairs from a word.
pairs :: Word8 -> [Word8]
pairs x = reverse [3 .&. shiftR x (2*i) | i <- [0..3]]

-- Corrector keeps the first bit of each bit pair
-- that is not 0b00 or 0b11.
correctPair 1 = [0]
correctPair 2 = [1]
correctPair _ = []

-- Attempt to assemble a byte from 8 bits.
assembleByte bits = if length bits == 8
                        then Just $ foldl (.|.) 0 [shiftL x n | (x, n) <- zip bits [7,6..0]]
                        else Nothing

-- Assemble as many bytes as possible from a list of bits.
assembleBytes bits = mapMaybe assembleByte (chunksOf 8 bits)

-- Remove bias in a sequence of words.
extractor = assembleBytes . concatMap correctPair . concatMap pairs

main = do
    c <- liftM BSL.unpack $ BSL.getContents
    BSL.putStr $ BSL.pack $ extractor c