@@ -0,0 +1,125 @@
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.
10+
11+module Streamly.Internal.Data.Binary.Decode
12+ ( unit
13+ , bool
14+ , ordering
15+ , eqWord8
16+ , word8
17+ , word16be
18+ )
19+where
20+
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)
25+
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
29+
30+-- | A value of type '()' is encoded as @0@ in binary encoding.
31+--
32+-- @
33+-- 0 ==> ()
34+-- @
35+--
36+-- /Internal/
37+--
38+{-# INLINE unit #-}
39+unit :: MonadCatch m => Parser m Word8 ()
40+unit = eqWord8 0 *> PR.yield ()
41+
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)
47+
48+-- | A value of type 'Bool' is encoded as follows in binary encoding.
49+--
50+-- @
51+-- 0 ==> False
52+-- 1 ==> True
53+-- @
54+--
55+-- /Internal/
56+--
57+{-# INLINE bool #-}
58+bool :: MonadCatch m => Parser m Word8 Bool
59+bool = PR.either word8ToBool
60+
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)
67+
68+-- | A value of type 'Ordering' is encoded as follows in binary encoding.
69+--
70+-- @
71+-- 0 ==> LT
72+-- 1 ==> EQ
73+-- 2 ==> GT
74+-- @
75+--
76+-- /Internal/
77+--
78+{-# INLINE ordering #-}
79+ordering :: MonadCatch m => Parser m Word8 Ordering
80+ordering = PR.either word8ToOrdering
81+
82+-- XXX should go in a Word8 parser module?
83+-- | Accept the input byte only if it is equal to the specified value.
84+--
85+-- /Internal/
86+--
87+{-# INLINE eqWord8 #-}
88+eqWord8 :: MonadCatch m => Word8 -> Parser m Word8 Word8
89+eqWord8 b = PR.satisfy (== b)
90+
91+-- | Accept any byte.
92+--
93+-- /Internal/
94+--
95+{-# INLINE word8 #-}
96+word8 :: MonadCatch m => Parser m Word8 Word8
97+word8 = PR.satisfy (const True)
98+
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
103+
104+ where
105+
106+ initial = return Nothing
107+
108+ step Nothing a =
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))
112+ step (Just w) a =
113+ return $ PRD.Done 0 (w .|. fromIntegral a)
114+
115+ extract Nothing = throwM $ PRD.ParseError "word16beD: end of input"
116+ extract (Just _) = error "word16beD: unreachable state"
117+
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).
120+--
121+-- /Internal/
122+--
123+{-# INLINE word16be #-}
124+word16be :: MonadCatch m => Parser m Word8 Word16
125+word16be = PRK.toParserK word16beD