git.iko.soy/streamly
on 2ca80e7 help sign in
streamly/src/Streamly/Internal/Data/Binary/Decode.hs
280 lines 7.7 kB history raw
1-- |
2-- Module : Streamly.Internal.Data.Binary.Decode
3-- Copyright : (c) 2020 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : pre-release
7-- Portability : GHC
8--
9-- Parsers for binary encoded basic Haskell data types.
11module Streamly.Internal.Data.Binary.Decode
12 ( unit
13 , bool
14 , ordering
15 , eqWord8
16 , word8
17 , word16be
18 , word16le
19 , word32be
20 , word32le
21 , word64be
22 , word64le
23 , word64host
24 )
25where
27import Control.Monad.IO.Class (MonadIO)
28import Data.Bits ((.|.), unsafeShiftL)
29import Data.Word (Word8, Word16, Word32, Word64)
30import Streamly.Internal.Data.Parser (Parser)
31import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))
32import Streamly.Internal.Data.Tuple.Strict (Tuple' (..))
34import qualified Streamly.Data.Array.Unboxed as A
35import qualified Streamly.Internal.Data.Array.Unboxed as A
36 (unsafeIndex, castUnsafe)
37import qualified Streamly.Internal.Data.Parser as PR
38 (fromPure, either, satisfy, takeEQ)
39import qualified Streamly.Internal.Data.Parser.ParserD as PRD
40 (Parser(..), Initial(..), Step(..), toParserK)
42-- | A value of type '()' is encoded as @0@ in binary encoding.
43--
44-- @
45-- 0 ==> ()
46-- @
47--
48-- /Pre-release/
49--
50{-# INLINE unit #-}
51unit :: Monad m => Parser m Word8 ()
52unit = eqWord8 0 *> PR.fromPure ()
54{-# INLINE word8ToBool #-}
55word8ToBool :: Word8 -> Either String Bool
56word8ToBool 0 = Right False
57word8ToBool 1 = Right True
58word8ToBool w = Left ("Invalid Bool encoding " ++ Prelude.show w)
60-- | A value of type 'Bool' is encoded as follows in binary encoding.
61--
62-- @
63-- 0 ==> False
64-- 1 ==> True
65-- @
66--
67-- /Pre-release/
68--
69{-# INLINE bool #-}
70bool :: Monad m => Parser m Word8 Bool
71bool = PR.either word8ToBool
73{-# INLINE word8ToOrdering #-}
74word8ToOrdering :: Word8 -> Either String Ordering
75word8ToOrdering 0 = Right LT
76word8ToOrdering 1 = Right EQ
77word8ToOrdering 2 = Right GT
78word8ToOrdering w = Left ("Invalid Ordering encoding " ++ Prelude.show w)
80-- | A value of type 'Ordering' is encoded as follows in binary encoding.
81--
82-- @
83-- 0 ==> LT
84-- 1 ==> EQ
85-- 2 ==> GT
86-- @
87--
88-- /Pre-release/
89--
90{-# INLINE ordering #-}
91ordering :: Monad m => Parser m Word8 Ordering
92ordering = PR.either word8ToOrdering
94-- XXX should go in a Word8 parser module?
95-- | Accept the input byte only if it is equal to the specified value.
96--
97-- /Pre-release/
98--
99{-# INLINE eqWord8 #-}
100eqWord8 :: Monad m => Word8 -> Parser m Word8 Word8
101eqWord8 b = PR.satisfy (== b)
103-- | Accept any byte.
104--
105-- /Pre-release/
106--
107{-# INLINE word8 #-}
108word8 :: Monad m => Parser m Word8 Word8
109word8 = PR.satisfy (const True)
111-- | Big endian (MSB first) Word16
112{-# INLINE word16beD #-}
113word16beD :: Monad m => PRD.Parser m Word8 Word16
114word16beD = PRD.Parser step initial extract
116 where
118 initial = return $ PRD.IPartial Nothing'
120 step Nothing' a =
121 -- XXX We can use a non-failing parser or a fold so that we do not
122 -- have to buffer for backtracking which is inefficient.
123 return $ PRD.Continue 0 (Just' (fromIntegral a `unsafeShiftL` 8))
124 step (Just' w) a =
125 return $ PRD.Done 0 (w .|. fromIntegral a)
127 extract _ = return $ PRD.Error "word16be: end of input"
129-- | Parse two bytes as a 'Word16', the first byte is the MSB of the Word16 and
130-- second byte is the LSB (big endian representation).
131--
132-- /Pre-release/
133--
134{-# INLINE word16be #-}
135word16be :: Monad m => Parser m Word8 Word16
136word16be = PRD.toParserK word16beD
138-- | Little endian (LSB first) Word16
139{-# INLINE word16leD #-}
140word16leD :: Monad m => PRD.Parser m Word8 Word16
141word16leD = PRD.Parser step initial extract
143 where
145 initial = return $ PRD.IPartial Nothing'
147 step Nothing' a =
148 return $ PRD.Continue 0 (Just' (fromIntegral a))
149 step (Just' w) a =
150 return $ PRD.Done 0 (w .|. fromIntegral a `unsafeShiftL` 8)
152 extract _ = return $ PRD.Error "word16le: end of input"
154-- | Parse two bytes as a 'Word16', the first byte is the LSB of the Word16 and
155-- second byte is the MSB (little endian representation).
156--
157-- /Pre-release/
158--
159{-# INLINE word16le #-}
160word16le :: Monad m => Parser m Word8 Word16
161word16le = PRD.toParserK word16leD
163-- | Big endian (MSB first) Word32
164{-# INLINE word32beD #-}
165word32beD :: Monad m => PRD.Parser m Word8 Word32
166word32beD = PRD.Parser step initial extract
168 where
170 initial = return $ PRD.IPartial $ Tuple' 0 24
172 step (Tuple' w sh) a = return $
173 if sh /= 0
174 then
175 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)
176 in PRD.Continue 0 (Tuple' w1 (sh - 8))
177 else PRD.Done 0 (w .|. fromIntegral a)
179 extract _ = return $ PRD.Error "word32beD: end of input"
181-- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32
182-- and last byte is the LSB (big endian representation).
183--
184-- /Pre-release/
185--
186{-# INLINE word32be #-}
187word32be :: Monad m => Parser m Word8 Word32
188word32be = PRD.toParserK word32beD
190-- | Little endian (LSB first) Word32
191{-# INLINE word32leD #-}
192word32leD :: Monad m => PRD.Parser m Word8 Word32
193word32leD = PRD.Parser step initial extract
195 where
197 initial = return $ PRD.IPartial $ Tuple' 0 0
199 step (Tuple' w sh) a = return $
200 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)
201 in if sh /= 24
202 then PRD.Continue 0 (Tuple' w1 (sh + 8))
203 else PRD.Done 0 w1
205 extract _ = return $ PRD.Error "word32leD: end of input"
207-- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32
208-- and last byte is the LSB (big endian representation).
209--
210-- /Pre-release/
211--
212{-# INLINE word32le #-}
213word32le :: Monad m => Parser m Word8 Word32
214word32le = PRD.toParserK word32leD
216-- | Big endian (MSB first) Word64
217{-# INLINE word64beD #-}
218word64beD :: Monad m => PRD.Parser m Word8 Word64
219word64beD = PRD.Parser step initial extract
221 where
223 initial = return $ PRD.IPartial $ Tuple' 0 56
225 step (Tuple' w sh) a = return $
226 if sh /= 0
227 then
228 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)
229 in PRD.Continue 0 (Tuple' w1 (sh - 8))
230 else PRD.Done 0 (w .|. fromIntegral a)
232 extract _ = return $ PRD.Error "word64beD: end of input"
234-- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64
235-- and last byte is the LSB (big endian representation).
236--
237-- /Pre-release/
238--
239{-# INLINE word64be #-}
240word64be :: Monad m => Parser m Word8 Word64
241word64be = PRD.toParserK word64beD
243-- | Little endian (LSB first) Word64
244{-# INLINE word64leD #-}
245word64leD :: Monad m => PRD.Parser m Word8 Word64
246word64leD = PRD.Parser step initial extract
248 where
250 initial = return $ PRD.IPartial $ Tuple' 0 0
252 step (Tuple' w sh) a = return $
253 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)
254 in if sh /= 56
255 then PRD.Continue 0 (Tuple' w1 (sh + 8))
256 else PRD.Done 0 w1
258 extract _ = return $ PRD.Error "word64leD: end of input"
260-- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64
261-- and last byte is the LSB (big endian representation).
262--
263-- /Pre-release/
264--
265{-# INLINE word64le #-}
266word64le :: Monad m => Parser m Word8 Word64
267word64le = PRD.toParserK word64leD
269-------------------------------------------------------------------------------
270-- Host byte order
271-------------------------------------------------------------------------------
273-- | Parse eight bytes as a 'Word64' in the host byte order.
274--
275-- /Pre-release/
276--
277{-# INLINE word64host #-}
278word64host :: MonadIO m => Parser m Word8 Word64
279word64host =
280 fmap (A.unsafeIndex 0 . A.castUnsafe) $ PR.takeEQ 8 (A.writeN 8)