Polymorphic Gray code generator

Gray.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Data.Gray where

import Control.Applicative

class Binary b where zero :: b
                     one :: b

instance Binary Bool where zero = False
                           one = True

instance Binary Char where zero = '0'
                           one = '1'

newtype Bin a = Bin {unBin :: a} deriving Num

instance Num a => Binary (Bin a) where zero = 0
                                       one = 1

grayBits :: (Integral i, Alternative a, Binary b) => i -> a [[b]]
grayBits 1 = pure [[zero], [one]]
grayBits n
  | n > 1 =
    let grayBits' = grayBits $ n - 1
    in
      liftA2 (++)
             (map (zero:) <$> grayBits')
             (map (one:) . reverse <$> grayBits')
  | otherwise = empty

grayN :: (Integral i, Alternative a, Binary b) => i -> a [[b]]
grayN n = take (fromIntegral n)
      <$> grayBits (ceiling $ logBase 2 $ fromIntegral n)