BitFields.hs

import Control.Monad.State
import Data.Word
import Data.Bits

-- maybe make this an operator?
getField :: (Bits a) => a -> a -> a
getField value mask = flip evalState (mask, value, 0) $ do
  sequence $ replicate (bitSize value) (get >>= setMaskBit)
  (_, _, result) <- get
  return result

setMaskBit :: (Bits a) => (a, a, a) -> State (a, a, a) ()
setMaskBit (mask, value, result) = put (shiftL mask 1, shiftL value 1, case testBit mask highestBit of 
                                     True -> assignBit lowerestBit (shiftL result 1) (testBit value highestBit)
                                     False -> result )
  where
    highestBit = (bitSize value - 1)
    lowerestBit = 0 

assignBit :: (Bits a) => Int -> a -> Bool -> a
assignBit n a True = setBit a n
assignBit n a False = clearBit a n

upper = bin 1111111100000000
lower = bin 0000000011111111

test :: Word16
test = 14382 `getField` upper

bin :: (Num a) => Integer -> a
bin x = case x `divMod` 10 of 
  (0, 0) -> 0
  (d, 0) -> 2 * (bin d)
  (d, 1) -> 1 + 2 * (bin d)
  (d, _) -> error (show x ++ ", is not a binary number")