-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Binary.Bits
-- Copyright   :  (c) Lennart Kolmodin 2010-2011
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  kolmodin@gmail.com
-- Stability   :  experimental
-- Portability :  portable (should run where the package binary runs)
--
-- Parse and write bits easily. Parsing can be done either in a monadic style, or more
-- efficiently, using the 'Applicative' style. Writing is monadic style only.
-- See "Data.Binary.Bits.Get" and "Data.Binary.Bits.Put", respectively.
-----------------------------------------------------------------------------

module Data.Binary.Bits where

import           Data.Binary.Bits.Get
import           Data.Binary.Bits.Put

import           Data.Word

class BinaryBit a where
  putBits :: Int -> a -> BitPut ()
  getBits :: Int -> BitGet a

instance BinaryBit Bool where
  putBits :: Int -> Bool -> BitPut ()
putBits Int
_ = Bool -> BitPut ()
putBool
  getBits :: Int -> BitGet Bool
getBits Int
_ = BitGet Bool
getBool

instance BinaryBit Word8 where
  putBits :: Int -> Word8 -> BitPut ()
putBits = Int -> Word8 -> BitPut ()
putWord8
  getBits :: Int -> BitGet Word8
getBits = Int -> BitGet Word8
getWord8

instance BinaryBit Word16 where
  putBits :: Int -> Word16 -> BitPut ()
putBits = Int -> Word16 -> BitPut ()
putWord16be
  getBits :: Int -> BitGet Word16
getBits = Int -> BitGet Word16
getWord16be

instance BinaryBit Word32 where
  putBits :: Int -> Word32 -> BitPut ()
putBits = Int -> Word32 -> BitPut ()
putWord32be
  getBits :: Int -> BitGet Word32
getBits = Int -> BitGet Word32
getWord32be

instance BinaryBit Word64 where
  putBits :: Int -> Word64 -> BitPut ()
putBits = Int -> Word64 -> BitPut ()
putWord64be
  getBits :: Int -> BitGet Word64
getBits = Int -> BitGet Word64
getWord64be