git.iko.soy/streamly
on cf63b4e help sign in
streamly/src/Streamly/Internal/Data/Binary/Decode.hs
278 lines 7.8 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 : experimental
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
38import qualified Streamly.Internal.Data.Parser.ParserK.Type as PRK
40-- | A value of type '()' is encoded as @0@ in binary encoding.
41--
42-- @
43-- 0 ==> ()
44-- @
45--
46-- /Pre-release/
47--
48{-# INLINE unit #-}
49unit :: MonadCatch m => Parser m Word8 ()
50unit = eqWord8 0 *> PR.yield ()
52{-# INLINE word8ToBool #-}
53word8ToBool :: Word8 -> Either String Bool
54word8ToBool 0 = Right False
55word8ToBool 1 = Right True
56word8ToBool w = Left ("Invalid Bool encoding " ++ Prelude.show w)
58-- | A value of type 'Bool' is encoded as follows in binary encoding.
59--
60-- @
61-- 0 ==> False
62-- 1 ==> True
63-- @
64--
65-- /Pre-release/
66--
67{-# INLINE bool #-}
68bool :: MonadCatch m => Parser m Word8 Bool
69bool = PR.either word8ToBool
71{-# INLINE word8ToOrdering #-}
72word8ToOrdering :: Word8 -> Either String Ordering
73word8ToOrdering 0 = Right LT
74word8ToOrdering 1 = Right EQ
75word8ToOrdering 2 = Right GT
76word8ToOrdering w = Left ("Invalid Ordering encoding " ++ Prelude.show w)
78-- | A value of type 'Ordering' is encoded as follows in binary encoding.
79--
80-- @
81-- 0 ==> LT
82-- 1 ==> EQ
83-- 2 ==> GT
84-- @
85--
86-- /Pre-release/
87--
88{-# INLINE ordering #-}
89ordering :: MonadCatch m => Parser m Word8 Ordering
90ordering = PR.either word8ToOrdering
92-- XXX should go in a Word8 parser module?
93-- | Accept the input byte only if it is equal to the specified value.
94--
95-- /Pre-release/
96--
97{-# INLINE eqWord8 #-}
98eqWord8 :: MonadCatch m => Word8 -> Parser m Word8 Word8
99eqWord8 b = PR.satisfy (== b)
101-- | Accept any byte.
102--
103-- /Pre-release/
104--
105{-# INLINE word8 #-}
106word8 :: MonadCatch m => Parser m Word8 Word8
107word8 = PR.satisfy (const True)
109-- | Big endian (MSB first) Word16
110{-# INLINE word16beD #-}
111word16beD :: MonadCatch m => PRD.Parser m Word8 Word16
112word16beD = PRD.Parser step initial extract
114 where
116 initial = return $ PRD.IPartial Nothing'
118 step Nothing' a =
119 -- XXX We can use a non-failing parser or a fold so that we do not
120 -- have to buffer for backtracking which is inefficient.
121 return $ PRD.Continue 0 (Just' (fromIntegral a `unsafeShiftL` 8))
122 step (Just' w) a =
123 return $ PRD.Done 0 (w .|. fromIntegral a)
125 extract _ = throwM $ PRD.ParseError "word16be: end of input"
127-- | Parse two bytes as a 'Word16', the first byte is the MSB of the Word16 and
128-- second byte is the LSB (big endian representation).
129--
130-- /Pre-release/
131--
132{-# INLINE word16be #-}
133word16be :: MonadCatch m => Parser m Word8 Word16
134word16be = PRK.toParserK word16beD
136-- | Little endian (LSB first) Word16
137{-# INLINE word16leD #-}
138word16leD :: MonadCatch m => PRD.Parser m Word8 Word16
139word16leD = PRD.Parser step initial extract
141 where
143 initial = return $ PRD.IPartial Nothing'
145 step Nothing' a =
146 return $ PRD.Continue 0 (Just' (fromIntegral a))
147 step (Just' w) a =
148 return $ PRD.Done 0 (w .|. fromIntegral a `unsafeShiftL` 8)
150 extract _ = throwM $ PRD.ParseError "word16le: end of input"
152-- | Parse two bytes as a 'Word16', the first byte is the LSB of the Word16 and
153-- second byte is the MSB (little endian representation).
154--
155-- /Pre-release/
156--
157{-# INLINE word16le #-}
158word16le :: MonadCatch m => Parser m Word8 Word16
159word16le = PRK.toParserK word16leD
161-- | Big endian (MSB first) Word32
162{-# INLINE word32beD #-}
163word32beD :: MonadCatch m => PRD.Parser m Word8 Word32
164word32beD = PRD.Parser step initial extract
166 where
168 initial = return $ PRD.IPartial $ Tuple' 0 24
170 step (Tuple' w sh) a = return $
171 if sh /= 0
172 then
173 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)
174 in PRD.Continue 0 (Tuple' w1 (sh - 8))
175 else PRD.Done 0 (w .|. fromIntegral a)
177 extract _ = throwM $ PRD.ParseError "word32beD: end of input"
179-- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32
180-- and last byte is the LSB (big endian representation).
181--
182-- /Pre-release/
183--
184{-# INLINE word32be #-}
185word32be :: MonadCatch m => Parser m Word8 Word32
186word32be = PRK.toParserK word32beD
188-- | Little endian (LSB first) Word32
189{-# INLINE word32leD #-}
190word32leD :: MonadCatch m => PRD.Parser m Word8 Word32
191word32leD = PRD.Parser step initial extract
193 where
195 initial = return $ PRD.IPartial $ Tuple' 0 0
197 step (Tuple' w sh) a = return $
198 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)
199 in if sh /= 24
200 then PRD.Continue 0 (Tuple' w1 (sh + 8))
201 else PRD.Done 0 w1
203 extract _ = throwM $ PRD.ParseError "word32leD: end of input"
205-- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32
206-- and last byte is the LSB (big endian representation).
207--
208-- /Pre-release/
209--
210{-# INLINE word32le #-}
211word32le :: MonadCatch m => Parser m Word8 Word32
212word32le = PRK.toParserK word32leD
214-- | Big endian (MSB first) Word64
215{-# INLINE word64beD #-}
216word64beD :: MonadCatch m => PRD.Parser m Word8 Word64
217word64beD = PRD.Parser step initial extract
219 where
221 initial = return $ PRD.IPartial $ Tuple' 0 56
223 step (Tuple' w sh) a = return $
224 if sh /= 0
225 then
226 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)
227 in PRD.Continue 0 (Tuple' w1 (sh - 8))
228 else PRD.Done 0 (w .|. fromIntegral a)
230 extract _ = throwM $ PRD.ParseError "word64beD: end of input"
232-- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64
233-- and last byte is the LSB (big endian representation).
234--
235-- /Pre-release/
236--
237{-# INLINE word64be #-}
238word64be :: MonadCatch m => Parser m Word8 Word64
239word64be = PRK.toParserK word64beD
241-- | Little endian (LSB first) Word64
242{-# INLINE word64leD #-}
243word64leD :: MonadCatch m => PRD.Parser m Word8 Word64
244word64leD = PRD.Parser step initial extract
246 where
248 initial = return $ PRD.IPartial $ Tuple' 0 0
250 step (Tuple' w sh) a = return $
251 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)
252 in if sh /= 56
253 then PRD.Continue 0 (Tuple' w1 (sh + 8))
254 else PRD.Done 0 w1
256 extract _ = throwM $ PRD.ParseError "word64leD: end of input"
258-- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64
259-- and last byte is the LSB (big endian representation).
260--
261-- /Pre-release/
262--
263{-# INLINE word64le #-}
264word64le :: MonadCatch m => Parser m Word8 Word64
265word64le = PRK.toParserK word64leD
267-------------------------------------------------------------------------------
268-- Host byte order
269-------------------------------------------------------------------------------
271-- | Parse eight bytes as a 'Word64' in the host byte order.
272--
273-- /Pre-release/
274--
275{-# INLINE word64host #-}
276word64host :: (MonadIO m, MonadCatch m) => Parser m Word8 Word64
277word64host =
278 fmap (flip A.unsafeIndex 0 . A.unsafeCast) $ PR.takeEQ 8 (A.writeN 8)