git.iko.soy/streamly
on ffca3ac help sign in
streamly/src/Streamly/Internal/Data/Binary/Decode.hs
277 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.Catch (MonadCatch, throwM)
28import Control.Monad.IO.Class (MonadIO)
29import Data.Bits ((.|.), unsafeShiftL)
30import Data.Word (Word8, Word16, Word32, Word64)
31import Streamly.Internal.Data.Parser (Parser)
32import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))
33import Streamly.Internal.Data.Tuple.Strict (Tuple' (..))
35import qualified Streamly.Internal.Data.Array.Foreign as A
36import qualified Streamly.Internal.Data.Parser as PR
37import qualified Streamly.Internal.Data.Parser.ParserD as PRD
39-- | A value of type '()' is encoded as @0@ in binary encoding.
40--
41-- @
42-- 0 ==> ()
43-- @
44--
45-- /Pre-release/
46--
47{-# INLINE unit #-}
48unit :: MonadCatch m => Parser m Word8 ()
49unit = eqWord8 0 *> PR.fromPure ()
51{-# INLINE word8ToBool #-}
52word8ToBool :: Word8 -> Either String Bool
53word8ToBool 0 = Right False
54word8ToBool 1 = Right True
55word8ToBool w = Left ("Invalid Bool encoding " ++ Prelude.show w)
57-- | A value of type 'Bool' is encoded as follows in binary encoding.
58--
59-- @
60-- 0 ==> False
61-- 1 ==> True
62-- @
63--
64-- /Pre-release/
65--
66{-# INLINE bool #-}
67bool :: MonadCatch m => Parser m Word8 Bool
68bool = PR.either word8ToBool
70{-# INLINE word8ToOrdering #-}
71word8ToOrdering :: Word8 -> Either String Ordering
72word8ToOrdering 0 = Right LT
73word8ToOrdering 1 = Right EQ
74word8ToOrdering 2 = Right GT
75word8ToOrdering w = Left ("Invalid Ordering encoding " ++ Prelude.show w)
77-- | A value of type 'Ordering' is encoded as follows in binary encoding.
78--
79-- @
80-- 0 ==> LT
81-- 1 ==> EQ
82-- 2 ==> GT
83-- @
84--
85-- /Pre-release/
86--
87{-# INLINE ordering #-}
88ordering :: MonadCatch m => Parser m Word8 Ordering
89ordering = PR.either word8ToOrdering
91-- XXX should go in a Word8 parser module?
92-- | Accept the input byte only if it is equal to the specified value.
93--
94-- /Pre-release/
95--
96{-# INLINE eqWord8 #-}
97eqWord8 :: MonadCatch m => Word8 -> Parser m Word8 Word8
98eqWord8 b = PR.satisfy (== b)
100-- | Accept any byte.
101--
102-- /Pre-release/
103--
104{-# INLINE word8 #-}
105word8 :: MonadCatch m => Parser m Word8 Word8
106word8 = PR.satisfy (const True)
108-- | Big endian (MSB first) Word16
109{-# INLINE word16beD #-}
110word16beD :: MonadCatch m => PRD.Parser m Word8 Word16
111word16beD = PRD.Parser step initial extract
113 where
115 initial = return $ PRD.IPartial Nothing'
117 step Nothing' a =
118 -- XXX We can use a non-failing parser or a fold so that we do not
119 -- have to buffer for backtracking which is inefficient.
120 return $ PRD.Continue 0 (Just' (fromIntegral a `unsafeShiftL` 8))
121 step (Just' w) a =
122 return $ PRD.Done 0 (w .|. fromIntegral a)
124 extract _ = throwM $ PRD.ParseError "word16be: end of input"
126-- | Parse two bytes as a 'Word16', the first byte is the MSB of the Word16 and
127-- second byte is the LSB (big endian representation).
128--
129-- /Pre-release/
130--
131{-# INLINE word16be #-}
132word16be :: MonadCatch m => Parser m Word8 Word16
133word16be = PRD.toParserK word16beD
135-- | Little endian (LSB first) Word16
136{-# INLINE word16leD #-}
137word16leD :: MonadCatch m => PRD.Parser m Word8 Word16
138word16leD = PRD.Parser step initial extract
140 where
142 initial = return $ PRD.IPartial Nothing'
144 step Nothing' a =
145 return $ PRD.Continue 0 (Just' (fromIntegral a))
146 step (Just' w) a =
147 return $ PRD.Done 0 (w .|. fromIntegral a `unsafeShiftL` 8)
149 extract _ = throwM $ PRD.ParseError "word16le: end of input"
151-- | Parse two bytes as a 'Word16', the first byte is the LSB of the Word16 and
152-- second byte is the MSB (little endian representation).
153--
154-- /Pre-release/
155--
156{-# INLINE word16le #-}
157word16le :: MonadCatch m => Parser m Word8 Word16
158word16le = PRD.toParserK word16leD
160-- | Big endian (MSB first) Word32
161{-# INLINE word32beD #-}
162word32beD :: MonadCatch m => PRD.Parser m Word8 Word32
163word32beD = PRD.Parser step initial extract
165 where
167 initial = return $ PRD.IPartial $ Tuple' 0 24
169 step (Tuple' w sh) a = return $
170 if sh /= 0
171 then
172 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)
173 in PRD.Continue 0 (Tuple' w1 (sh - 8))
174 else PRD.Done 0 (w .|. fromIntegral a)
176 extract _ = throwM $ PRD.ParseError "word32beD: end of input"
178-- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32
179-- and last byte is the LSB (big endian representation).
180--
181-- /Pre-release/
182--
183{-# INLINE word32be #-}
184word32be :: MonadCatch m => Parser m Word8 Word32
185word32be = PRD.toParserK word32beD
187-- | Little endian (LSB first) Word32
188{-# INLINE word32leD #-}
189word32leD :: MonadCatch m => PRD.Parser m Word8 Word32
190word32leD = PRD.Parser step initial extract
192 where
194 initial = return $ PRD.IPartial $ Tuple' 0 0
196 step (Tuple' w sh) a = return $
197 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)
198 in if sh /= 24
199 then PRD.Continue 0 (Tuple' w1 (sh + 8))
200 else PRD.Done 0 w1
202 extract _ = throwM $ PRD.ParseError "word32leD: end of input"
204-- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32
205-- and last byte is the LSB (big endian representation).
206--
207-- /Pre-release/
208--
209{-# INLINE word32le #-}
210word32le :: MonadCatch m => Parser m Word8 Word32
211word32le = PRD.toParserK word32leD
213-- | Big endian (MSB first) Word64
214{-# INLINE word64beD #-}
215word64beD :: MonadCatch m => PRD.Parser m Word8 Word64
216word64beD = PRD.Parser step initial extract
218 where
220 initial = return $ PRD.IPartial $ Tuple' 0 56
222 step (Tuple' w sh) a = return $
223 if sh /= 0
224 then
225 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)
226 in PRD.Continue 0 (Tuple' w1 (sh - 8))
227 else PRD.Done 0 (w .|. fromIntegral a)
229 extract _ = throwM $ PRD.ParseError "word64beD: end of input"
231-- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64
232-- and last byte is the LSB (big endian representation).
233--
234-- /Pre-release/
235--
236{-# INLINE word64be #-}
237word64be :: MonadCatch m => Parser m Word8 Word64
238word64be = PRD.toParserK word64beD
240-- | Little endian (LSB first) Word64
241{-# INLINE word64leD #-}
242word64leD :: MonadCatch m => PRD.Parser m Word8 Word64
243word64leD = PRD.Parser step initial extract
245 where
247 initial = return $ PRD.IPartial $ Tuple' 0 0
249 step (Tuple' w sh) a = return $
250 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)
251 in if sh /= 56
252 then PRD.Continue 0 (Tuple' w1 (sh + 8))
253 else PRD.Done 0 w1
255 extract _ = throwM $ PRD.ParseError "word64leD: end of input"
257-- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64
258-- and last byte is the LSB (big endian representation).
259--
260-- /Pre-release/
261--
262{-# INLINE word64le #-}
263word64le :: MonadCatch m => Parser m Word8 Word64
264word64le = PRD.toParserK word64leD
266-------------------------------------------------------------------------------
267-- Host byte order
268-------------------------------------------------------------------------------
270-- | Parse eight bytes as a 'Word64' in the host byte order.
271--
272-- /Pre-release/
273--
274{-# INLINE word64host #-}
275word64host :: (MonadIO m, MonadCatch m) => Parser m Word8 Word64
276word64host =
277 fmap (A.unsafeIndex 0 . A.castUnsafe) $ PR.takeEQ 8 (A.writeN 8)