{-# LANGUAGE GADTs #-}

-- | This module exports the primitives and combinators for constructing formats with sub- or cross-byte
-- components. See @test/MBR.hs@ for an example of its use.
--
-- >>> testParse (bigEndianBytesOf $ pair (count 5 bit) (count 3 bit)) (ByteString.pack [9])
-- Right [(([False,False,False,False,True],[False,False,True]),"")]

module Construct.Bits
  (Bits, bit,
   -- * The combinators for converting between 'Bits' and 'ByteString' input streams
   bigEndianBitsOf, bigEndianBytesOf, littleEndianBitsOf, littleEndianBytesOf) where

import Data.Bits (setBit, testBit)
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.List as List
import Data.Word (Word8)
import Text.Parser.Input (InputParsing (ParserInput, anyToken))

import Construct
import Construct.Classes
import Construct.Internal

-- | The list of bits
type Bits = [Bool]

bit :: (Applicative n, InputParsing m, ParserInput m ~ Bits) => Format m n Bits Bool
bigEndianBitsOf :: (InputParsing (m Bits), InputParsing (m ByteString), InputMappableParsing m, Functor n,
                    ParserInput (m Bits) ~ Bits, ParserInput (m ByteString) ~ ByteString) =>
                   Format (m ByteString) n ByteString a -> Format (m Bits) n Bits a
bigEndianBytesOf :: (InputParsing (m Bits), InputParsing (m ByteString), InputMappableParsing m, Functor n,
                     ParserInput (m Bits) ~ Bits, ParserInput (m ByteString) ~ ByteString) =>
                    Format (m Bits) n Bits a -> Format (m ByteString) n ByteString a
littleEndianBitsOf :: (InputParsing (m Bits), InputParsing (m ByteString), InputMappableParsing m, Functor n,
                       ParserInput (m Bits) ~ Bits, ParserInput (m ByteString) ~ ByteString) =>
                      Format (m ByteString) n ByteString a -> Format (m Bits) n Bits a
littleEndianBytesOf :: (InputParsing (m Bits), InputParsing (m ByteString), InputMappableParsing m, Functor n,
                        ParserInput (m Bits) ~ Bits, ParserInput (m ByteString) ~ ByteString) =>
                       Format (m Bits) n Bits a -> Format (m ByteString) n ByteString a

-- | The primitive format of a single bit
--
-- >>> testParse bit [True, False, False, True]
-- Right [(True,[False,False,True])]
bit :: Format m n Bits Bool
bit = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m Bool
parse = Bits -> Bool
forall a. [a] -> a
head (Bits -> Bool) -> m Bits -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bits
forall (m :: * -> *). InputParsing m => m (ParserInput m)
anyToken,
   serialize :: Bool -> n Bits
serialize = Bits -> n Bits
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bits -> n Bits) -> (Bool -> Bits) -> Bool -> n Bits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bits -> Bits
forall a. a -> [a] -> [a]
:[])}

bigEndianBitsOf :: Format (m ByteString) n ByteString a -> Format (m Bits) n Bits a
bigEndianBitsOf = (ByteString -> Maybe Bits)
-> (Bits -> Maybe ByteString)
-> Format (m ByteString) n ByteString a
-> Format (m Bits) n Bits a
forall s t (m :: * -> * -> *) (n :: * -> *) a.
(Monoid s, Monoid t, InputParsing (m s), InputParsing (m t),
 s ~ ParserInput (m s), t ~ ParserInput (m t),
 InputMappableParsing m, Functor n) =>
(s -> Maybe t)
-> (t -> Maybe s) -> Format (m s) n s a -> Format (m t) n t a
mapMaybeSerialized (Bits -> Maybe Bits
forall a. a -> Maybe a
Just (Bits -> Maybe Bits)
-> (ByteString -> Bits) -> ByteString -> Maybe Bits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bits
enumerateFromMostSignificant) Bits -> Maybe ByteString
collectFromMostSignificant
bigEndianBytesOf :: Format (m Bits) n Bits a -> Format (m ByteString) n ByteString a
bigEndianBytesOf = (Bits -> Maybe ByteString)
-> (ByteString -> Maybe Bits)
-> Format (m Bits) n Bits a
-> Format (m ByteString) n ByteString a
forall s t (m :: * -> * -> *) (n :: * -> *) a.
(Monoid s, Monoid t, InputParsing (m s), InputParsing (m t),
 s ~ ParserInput (m s), t ~ ParserInput (m t),
 InputMappableParsing m, Functor n) =>
(s -> Maybe t)
-> (t -> Maybe s) -> Format (m s) n s a -> Format (m t) n t a
mapMaybeSerialized Bits -> Maybe ByteString
collectFromMostSignificant (Bits -> Maybe Bits
forall a. a -> Maybe a
Just (Bits -> Maybe Bits)
-> (ByteString -> Bits) -> ByteString -> Maybe Bits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bits
enumerateFromMostSignificant)
littleEndianBitsOf :: Format (m ByteString) n ByteString a -> Format (m Bits) n Bits a
littleEndianBitsOf = (ByteString -> Maybe Bits)
-> (Bits -> Maybe ByteString)
-> Format (m ByteString) n ByteString a
-> Format (m Bits) n Bits a
forall s t (m :: * -> * -> *) (n :: * -> *) a.
(Monoid s, Monoid t, InputParsing (m s), InputParsing (m t),
 s ~ ParserInput (m s), t ~ ParserInput (m t),
 InputMappableParsing m, Functor n) =>
(s -> Maybe t)
-> (t -> Maybe s) -> Format (m s) n s a -> Format (m t) n t a
mapMaybeSerialized (Bits -> Maybe Bits
forall a. a -> Maybe a
Just (Bits -> Maybe Bits)
-> (ByteString -> Bits) -> ByteString -> Maybe Bits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bits
enumerateFromLeastSignificant) Bits -> Maybe ByteString
collectFromLeastSignificant
littleEndianBytesOf :: Format (m Bits) n Bits a -> Format (m ByteString) n ByteString a
littleEndianBytesOf = (Bits -> Maybe ByteString)
-> (ByteString -> Maybe Bits)
-> Format (m Bits) n Bits a
-> Format (m ByteString) n ByteString a
forall s t (m :: * -> * -> *) (n :: * -> *) a.
(Monoid s, Monoid t, InputParsing (m s), InputParsing (m t),
 s ~ ParserInput (m s), t ~ ParserInput (m t),
 InputMappableParsing m, Functor n) =>
(s -> Maybe t)
-> (t -> Maybe s) -> Format (m s) n s a -> Format (m t) n t a
mapMaybeSerialized Bits -> Maybe ByteString
collectFromLeastSignificant (Bits -> Maybe Bits
forall a. a -> Maybe a
Just (Bits -> Maybe Bits)
-> (ByteString -> Bits) -> ByteString -> Maybe Bits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bits
enumerateFromLeastSignificant)

collectFromMostSignificant :: Bits -> Maybe ByteString
collectFromLeastSignificant :: Bits -> Maybe ByteString
enumerateFromMostSignificant :: ByteString -> Bits
enumerateFromLeastSignificant :: ByteString -> Bits

collectFromMostSignificant :: Bits -> Maybe ByteString
collectFromMostSignificant Bits
bits = ([Word8] -> ByteString
ByteString.pack ([Word8] -> ByteString)
-> ([Bits] -> [Word8]) -> [Bits] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bits -> Word8) -> [Bits] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Bits -> Word8
toByte) ([Bits] -> ByteString) -> Maybe [Bits] -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bits -> Maybe [Bits]
forall a. [a] -> Maybe [[a]]
splitEach8 Bits
bits
   where toByte :: Bits -> Word8
toByte Bits
octet = (Word8 -> Int -> Word8) -> Word8 -> [Int] -> Word8
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit (Word8
0 :: Word8) (((Bool, Int) -> Int) -> [(Bool, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Int) -> Int
forall a b. (a, b) -> b
snd ([(Bool, Int)] -> [Int]) -> [(Bool, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
$ ((Bool, Int) -> Bool) -> [(Bool, Int)] -> [(Bool, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, Int) -> Bool
forall a b. (a, b) -> a
fst ([(Bool, Int)] -> [(Bool, Int)]) -> [(Bool, Int)] -> [(Bool, Int)]
forall a b. (a -> b) -> a -> b
$ Bits -> [Int] -> [(Bool, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip Bits
octet [Int
7,Int
6..Int
0])
collectFromLeastSignificant :: Bits -> Maybe ByteString
collectFromLeastSignificant Bits
bits = ([Word8] -> ByteString
ByteString.pack ([Word8] -> ByteString)
-> ([Bits] -> [Word8]) -> [Bits] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bits -> Word8) -> [Bits] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Bits -> Word8
toByte) ([Bits] -> ByteString) -> Maybe [Bits] -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bits -> Maybe [Bits]
forall a. [a] -> Maybe [[a]]
splitEach8 Bits
bits
   where toByte :: Bits -> Word8
toByte Bits
octet = (Word8 -> Int -> Word8) -> Word8 -> [Int] -> Word8
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit (Word8
0 :: Word8) (((Bool, Int) -> Int) -> [(Bool, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Int) -> Int
forall a b. (a, b) -> b
snd ([(Bool, Int)] -> [Int]) -> [(Bool, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
$ ((Bool, Int) -> Bool) -> [(Bool, Int)] -> [(Bool, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, Int) -> Bool
forall a b. (a, b) -> a
fst ([(Bool, Int)] -> [(Bool, Int)]) -> [(Bool, Int)] -> [(Bool, Int)]
forall a b. (a -> b) -> a -> b
$ Bits -> [Int] -> [(Bool, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip Bits
octet [Int
0..Int
7])
enumerateFromMostSignificant :: ByteString -> Bits
enumerateFromMostSignificant = (Word8 -> Bits -> Bits) -> Bits -> ByteString -> Bits
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
ByteString.foldr (Bits -> Bits -> Bits
forall a. [a] -> [a] -> [a]
(++) (Bits -> Bits -> Bits) -> (Word8 -> Bits) -> Word8 -> Bits -> Bits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bits
forall a. Bits a => a -> Bits
enumerateByte) []
   where enumerateByte :: a -> Bits
enumerateByte a
b = [a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
b Int
i | Int
i <- [Int
7,Int
6..Int
0]]
enumerateFromLeastSignificant :: ByteString -> Bits
enumerateFromLeastSignificant = (Word8 -> Bits -> Bits) -> Bits -> ByteString -> Bits
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
ByteString.foldr (Bits -> Bits -> Bits
forall a. [a] -> [a] -> [a]
(++) (Bits -> Bits -> Bits) -> (Word8 -> Bits) -> Word8 -> Bits -> Bits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bits
forall a. Bits a => a -> Bits
enumerateByte) []
   where enumerateByte :: a -> Bits
enumerateByte a
b = [a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
b Int
i | Int
i <- [Int
0..Int
7]]

splitEach8 :: [a] -> Maybe [[a]]
splitEach8 :: [a] -> Maybe [[a]]
splitEach8 [] = [[a]] -> Maybe [[a]]
forall a. a -> Maybe a
Just []
splitEach8 [a]
list
   | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
first8 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 = ([a]
first8 [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:) ([[a]] -> [[a]]) -> Maybe [[a]] -> Maybe [[a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> Maybe [[a]]
forall a. [a] -> Maybe [[a]]
splitEach8 [a]
rest
   | Bool
otherwise = Maybe [[a]]
forall a. Maybe a
Nothing
   where ([a]
first8, [a]
rest) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
8 [a]
list