module HaskellWorks.Data.Bits.Conversion
( AsBits(..)
, FromBits(..)
, bitsToString
, bitsShows
, fromBitsDiff
, fromBitsDiffN
, stringToBits
)
where
import Data.Bits
import Data.Word
bitsDiff' :: FiniteBits a => a -> Int -> Int -> [Bool] -> [Bool]
bitsDiff' a n len bs
| n < len = testBit a n : bitsDiff' a (n + 1) len bs
| n == len = bs
| otherwise = error "Invalid index"
bits :: AsBits a => a -> [Bool]
bits a = bitsDiff a []
bitsShows' :: [Bool] -> ShowS
bitsShows' [] s = s
bitsShows' (True :bs) s = '1':bitsShows' bs s
bitsShows' (False:bs) s = '0':bitsShows' bs s
bitsShows :: AsBits a => a -> ShowS
bitsShows = bitsShows' . bits
bitsToString :: AsBits a => a -> String
bitsToString bs = bitsShows bs ""
class AsBits a where
bitsDiff :: a -> [Bool] -> [Bool]
class FromBits a where
fromBits1 :: [Bool] -> (Maybe a, [Bool])
instance AsBits Bool where
bitsDiff = (:)
instance AsBits Word8 where
bitsDiff a = bitsDiff' a 0 (finiteBitSize a)
instance AsBits a => AsBits [a] where
bitsDiff [] = id
bitsDiff (x:xs) = bitsDiff x . bitsDiff xs
instance FromBits Bool where
fromBits1 [] = (Nothing, [])
fromBits1 (b:bs) = (Just b, bs)
instance FromBits Word8 where
fromBits1 (a:b:c:d:e:f:g:h:bs) = (,)
(Just $ if a then 0x01 else 0 .|.
if b then 0x02 else 0 .|.
if c then 0x04 else 0 .|.
if d then 0x08 else 0 .|.
if e then 0x10 else 0 .|.
if f then 0x20 else 0 .|.
if g then 0x40 else 0 .|.
if h then 0x80 else 0)
bs
fromBits1 bs = (Nothing, bs)
instance FromBits Word16 where
fromBits1 (a:b:c:d:e:f:g:h:i:j:k:l:m:n:o:p:bs) = (,)
(Just $ if a then 0x0001 else 0 .|.
if b then 0x0002 else 0 .|.
if c then 0x0004 else 0 .|.
if d then 0x0008 else 0 .|.
if e then 0x0010 else 0 .|.
if f then 0x0020 else 0 .|.
if g then 0x0040 else 0 .|.
if h then 0x0080 else 0 .|.
if i then 0x0100 else 0 .|.
if j then 0x0200 else 0 .|.
if k then 0x0400 else 0 .|.
if l then 0x0800 else 0 .|.
if m then 0x1000 else 0 .|.
if n then 0x2000 else 0 .|.
if o then 0x4000 else 0 .|.
if p then 0x8000 else 0)
bs
fromBits1 bs = (Nothing, bs)
fromBitsDiff :: FromBits a => [Bool] -> ([a] -> [a], [Bool])
fromBitsDiff bs = case fromBits1 bs of
(Nothing, rs) -> (id , rs)
(Just a , rs) -> case fromBitsDiff rs of
(f, ss) -> ((a:) . f, ss)
fromBitsDiffN :: FromBits a => Int -> [Bool] -> ([a] -> [a], [Bool])
fromBitsDiffN n bs
| n > 0 = case fromBits1 bs of
(Nothing, rs) -> (id , rs)
(Just a , rs) -> case fromBitsDiffN (n 1) rs of
(f, ss) -> ((a:) . f, ss)
| n == 0 = (id, bs)
| n < 0 = error "Invalid count"
| null bs = (id, [])
| otherwise = error "Error"
stringToBits :: String -> [Bool]
stringToBits [] = []
stringToBits ('1' :xs) = True :stringToBits xs
stringToBits ('0' :xs) = False:stringToBits xs
stringToBits (' ' :xs) = stringToBits xs
stringToBits ('\n':xs) = stringToBits xs
stringToBits (_ :_ ) = error "Invalid bit"