BitSet.hs

module Foreign.Extra.BitSet
  ( fromBitSet
  , toBitSet
  ) where

import Data.Bits (Bits, (.&.), (.|.), complement)
import Data.Set (Set, empty, insert, toList)

fromBitSet :: (Ord h, Bits c, Num c) => [(h, c)] -> (c -> h) -> c -> Set h
fromBitSet spec unknown bits
  | unmatched == 0 = matched
  | otherwise = insert (unknown unmatched) matched
  where
    (matched, unmatched) = foldr test (empty, bits) spec
    test (h, v) (m, um)
      | v == v .&. um = (insert h m, um .&. complement v)
      | otherwise     = (m, um)

toBitSet ::(Eq h, Bits c, Num c) => [(h, c)] -> (h -> Bool) -> (h -> c) -> Set h -> c
toBitSet spec isUnknown unUnknown = foldr (.|.) 0 . map f . toList
  where
    f h
      | isUnknown h = unUnknown h
      | otherwise = case h `lookup` spec of
          Just c -> c
          Nothing -> error "toBitSet"