@@ -0,0 +1,125 @@
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
9+-- Parsers for binary encoded basic Haskell data types.
11+module Streamly.Internal.Data.Binary.Decode
21+import Control.Monad.Catch (MonadCatch, throwM)
22+import Data.Bits ((.|.), unsafeShiftL)
23+import Data.Word (Word8, Word16)
24+import Streamly.Internal.Data.Parser (Parser)
26+import qualified Streamly.Internal.Data.Parser as PR
27+import qualified Streamly.Internal.Data.Parser.ParserD as PRD
28+import qualified Streamly.Internal.Data.Parser.ParserK.Types as PRK
30+-- | A value of type '()' is encoded as @0@ in binary encoding.
39+unit :: MonadCatch m => Parser m Word8 ()
40+unit = eqWord8 0 *> PR.yield ()
42+{-# INLINE word8ToBool #-}
43+word8ToBool :: Word8 -> Either String Bool
44+word8ToBool 0 = Right False
45+word8ToBool 1 = Right True
46+word8ToBool w = Left ("Invalid Bool encoding " ++ Prelude.show w)
48+-- | A value of type 'Bool' is encoded as follows in binary encoding.
58+bool :: MonadCatch m => Parser m Word8 Bool
59+bool = PR.either word8ToBool
61+{-# INLINE word8ToOrdering #-}
62+word8ToOrdering :: Word8 -> Either String Ordering
63+word8ToOrdering 0 = Right LT
64+word8ToOrdering 1 = Right EQ
65+word8ToOrdering 2 = Right GT
66+word8ToOrdering w = Left ("Invalid Ordering encoding " ++ Prelude.show w)
68+-- | A value of type 'Ordering' is encoded as follows in binary encoding.
78+{-# INLINE ordering #-}
79+ordering :: MonadCatch m => Parser m Word8 Ordering
80+ordering = PR.either word8ToOrdering
82+-- XXX should go in a Word8 parser module?
83+-- | Accept the input byte only if it is equal to the specified value.
87+{-# INLINE eqWord8 #-}
88+eqWord8 :: MonadCatch m => Word8 -> Parser m Word8 Word8
89+eqWord8 b = PR.satisfy (== b)
96+word8 :: MonadCatch m => Parser m Word8 Word8
97+word8 = PR.satisfy (const True)
99+-- | Big endian (MSB first) Word16
100+{-# INLINE word16beD #-}
101+word16beD :: MonadCatch m => PRD.Parser m Word8 Word16
102+word16beD = PRD.Parser step initial extract
106+ initial = return Nothing
109+ -- XXX We can use a non-failing parser or a fold so that we do not
110+ -- have to buffer for backtracking which is inefficient.
111+ return $ PRD.Continue 0 (Just (fromIntegral a `unsafeShiftL` 8))
113+ return $ PRD.Done 0 (w .|. fromIntegral a)
115+ extract Nothing = throwM $ PRD.ParseError "word16beD: end of input"
116+ extract (Just _) = error "word16beD: unreachable state"
118+-- | Parse two bytes as a 'Word16', the first byte is the MSB of the Word16 and
119+-- second byte is the LSB (big endian representation).
123+{-# INLINE word16be #-}
124+word16be :: MonadCatch m => Parser m Word8 Word16
125+word16be = PRK.toParserK word16beD