@@ -43,8 +43,8 @@ import GHC.Word
43import GHC.Int
43import GHC.Int
46−data S = S !ByteString -- ^ Input
46+data S = S !ByteString -- Input
47− !Int -- ^ Bit offset (0-7)
47+ !Int -- Bit offset (0-7)
48 deriving (Show)
48 deriving (Show)
50-- | A block that will be read with only one boundry check. Needs to know the
50-- | A block that will be read with only one boundry check. Needs to know the
@@ -60,6 +60,31 @@ instance Applicative Block where
60 (Block i _) *> (Block j q) = Block (i+j) (q . incS i)
60 (Block i _) *> (Block j q) = Block (i+j) (q . incS i)
61 (Block i p) <* (Block j _) = Block (i+j) p
61 (Block i p) <* (Block j _) = Block (i+j) p
63+-- | Get a block. Guaranteed to be done with one single boundry check, and must
64+-- therefore require a statically known number of bits.
65+-- Build blocks using 'bool', 'word8', 'word16be', 'word32be', 'word64be' and 'Applicative'.
68+-- data IPV6Header = IPV6Header {
69+-- ipv6Version :: 'Word8'
70+-- , ipv6TrafficClass :: 'Word8'
71+-- , ipv6FlowLabel :: 'Word32
72+-- , ipv6PayloadLength :: 'Word16'
73+-- , ipv6NextHeader :: 'Word8'
74+-- , ipv6HopLimit :: 'Word8'
75+-- , ipv6SourceAddress :: 'ByteString'
76+-- , ipv6DestinationAddress :: 'ByteString'
79+-- parse = IPV6Header '<$>' 'word8' 4
81+-- '<*>' 'word32be' 24
82+-- '<*>' 'word16be' 16
85+-- '<*>' 'byteString' 16
86+-- '<*>' 'byteString' 16
63block :: Block a -> BitGet a
88block :: Block a -> BitGet a
64block (Block i p) = do
89block (Block i p) = do
65 ensureBits i
90 ensureBits i
@@ -221,7 +246,7 @@ readWord64be n s@(S bs o)
221 | otherwise = error "readWord64be: tried to read more than 64 bits"
246 | otherwise = error "readWord64be: tried to read more than 64 bits"
223------------------------------------------------------------------------
248------------------------------------------------------------------------
224−-- unrolled codensity/state monad
249+
225newtype BitGet a = B { runState :: S -> Get (S,a) }
250newtype BitGet a = B { runState :: S -> Get (S,a) }
227instance Monad BitGet where
252instance Monad BitGet where