module Codec.Binary.Gray.List
( gray, binary
, toList, toList', fromList
, showBits
) where
import Data.Bits (FiniteBits, Bits, testBit, finiteBitSize, bitSizeMaybe, shiftR, isSigned)
boolXOR :: Bool -> Bool -> Bool
boolXOR p q = (p && not q) || (not p && q)
gray :: [Bool] -> [Bool]
gray (b:c:bs) = b `boolXOR` c : gray (c:bs)
gray [b] = [b]
gray [] = []
binary :: [Bool] -> [Bool]
binary = foldr go []
where go c [] = [c]
go c bs@(b:_) = b `boolXOR` c : bs
toList :: (Bits b, Num b) => b -> [Bool]
toList 0 = []
toList i =
let mbSize = bitSizeMaybe i
isNegative = isSigned i && signum i == (1)
in case (mbSize, isNegative) of
(Just _, False) -> positiveToList i
(Just size, True) -> negativeToList size i
(Nothing, False) -> positiveToList i
(Nothing, True) -> []
where
positiveToList i =
let rest = toList $ shiftR i 1
in (testBit i 0 : rest)
negativeToList bsize i =
let b = map not . toList $ negate i 1
in b ++ (take (bsize length b) $ repeat True)
toList' :: (FiniteBits b, Num b) => b -> [Bool]
toList' i = map (testBit i) [0..finiteBitSize i 1]
fromList :: (Bits b, Num b) => [Bool] -> b
fromList = sum . map fst . filter snd . zip (map (2^) [0..])
showBits :: [Bool] -> String
showBits [] = "0"
showBits bs = map (\b -> if b then '1' else '0') . reverse $ bs