-- | Gray code is a binary numeral system where two successive numbers
-- differ in only one bit.
--
-- This module provides an interface to encode/decode numbers
-- represented as lists of @Bool@.
--
-- Algorithm:
--   Haupt, R.L. and Haupt, S.E., Practical Genetic Algorithms,
--   Second ed. (2004),  5.4. Gray Codes.
module Codec.Binary.Gray.List
    ( gray, binary
    , toList, toList', fromList
    , showBits
    ) where

import Data.Bits (Bits, testBit, bitSize, shiftR, isSigned)

boolXOR :: Bool -> Bool -> Bool
boolXOR p q = (p && not q) || (not p && q)

-- | Take a list of bits (most significant last) in binary encoding
-- and convert them to Gray code.
gray :: [Bool] -> [Bool]
gray (b:c:bs) = b `boolXOR` c : gray (c:bs)
gray [b] = [b]
gray [] = []

-- | Take a list of bits in Gray code and convert them to binary encoding
-- (most significant bit last).
binary :: [Bool] -> [Bool]
binary = foldr go []
  where go c [] = [c]
        go c bs@(b:_) = b `boolXOR` c : bs

-- | Convert a number to a list of bits in usual binary encoding (most
-- significant bit last). Truncates unset major bits.
-- 
-- This function is undefined for negative numbers of types that do not
-- have fixed bitsize, like 'Integer'.
toList :: (Bits b) => b -> [Bool]
toList 0 = []
toList i
  | isSigned i && signum i == (-1) =
      let b = map not . toList $ negate i - 1
      in  b ++ (take (bitSize i - length b) $ repeat True) -- pad major bits
  | otherwise        =
      let rest = toList $ shiftR i 1  -- works only for positive i
      in  (testBit i 0 : rest)

-- | Convert a number to a list of bits in usual binary encoding (most
-- significant bit last).
--
-- Like 'toList', but returns all unset major bits too. So the length
-- of the output is always the same length as @bitSize i@.
toList' :: (Bits b) => b -> [Bool]
toList' i = map (testBit i) [0..bitSize i - 1]

-- | Convert a list of bits in binary encoding to a number.
fromList :: (Bits b) => [Bool] -> b
fromList = sum . map fst . filter snd . zip (map (2^) [0..])

-- | Render a list of bits as a string of @0@s and @1@s.
showBits :: [Bool] -> String
showBits [] = "0"
showBits bs = map (\b -> if b then '1' else '0') . reverse $ bs