{-# LANGUAGE GADTs, TypeOperators #-}

-- | 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 :: forall (n :: * -> *) (m :: * -> *).
(Applicative n, InputParsing m, ParserInput m ~ Bits) =>
Format m n Bits Bool
bit = Format{
   parse :: m Bool
parse = forall a. [a] -> a
head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). InputParsing m => m (ParserInput m)
anyToken,
   serialize :: Bool -> n Bits
serialize = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])}

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

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