core/src/Streamly/Internal/Serialize/FromBytes.hs · streamly

git.iko.soy/streamly

on efe0be3 help sign in

streamly/core/src/Streamly/Internal/Serialize/FromBytes.hs

393 lines 11 kB history raw

1-- |

2-- Module : Streamly.Internal.Serialize.FromBytes

4-- License : BSD-3-Clause

5-- Maintainer : streamly@composewell.com

6-- Portability : GHC

7--

8-- Decode Haskell data types from byte streams.

10module Streamly.Internal.Serialize.FromBytes

11 (

12 -- * Type class

13 FromBytes (..)

15 -- * Decoders

16 , unit

17 , bool

18 , ordering

19 , eqWord8 -- XXX rename to word8Eq

20 , word8

21 , word16be

22 , word16le

23 , word32be

24 , word32le

25 , word64be

26 , word64le

27 , word64host

28 , int8

29 , int16be

30 , int16le

31 , int32be

32 , int32le

33 , int64be

34 , int64le

35 , float32be

36 , float32le

37 , double64be

38 , double64le

39 , charLatin1

40 )

41where

43import Control.Monad.IO.Class (MonadIO)

44import Data.Bits ((.|.), unsafeShiftL)

45import Data.Char (chr)

46import Data.Int (Int8, Int16, Int32, Int64)

47import GHC.Float (castWord32ToFloat, castWord64ToDouble)

48import Data.Word (Word8, Word16, Word32, Word64)

49import Streamly.Internal.Data.Parser (Parser)

50import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))

51import Streamly.Internal.Data.Tuple.Strict (Tuple' (..))

52import qualified Streamly.Data.Array as A

53import qualified Streamly.Internal.Data.Array as A

54 (unsafeIndex, castUnsafe)

55import qualified Streamly.Internal.Data.Parser as PR

56 (fromPure, either, satisfy, takeEQ)

57import qualified Streamly.Internal.Data.Parser as PRD

58 (Parser(..), Initial(..), Step(..))

60-- Note: The () type does not need to have an on-disk representation in theory.

61-- But we use a concrete representation for it so that we count how many ()

62-- types we have. Or when we have an array of units the array a concrete

63-- length.

65-- | A value of type '()' is encoded as @0@ in binary encoding.

66--

67-- @

68-- 0 ==> ()

69-- @

70--

71-- /Pre-release/

72--

73{-# INLINE unit #-}

74unit :: Monad m => Parser Word8 m ()

75unit = eqWord8 0 *> PR.fromPure ()

77{-# INLINE word8ToBool #-}

78word8ToBool :: Word8 -> Either String Bool

79word8ToBool 0 = Right False

80word8ToBool 1 = Right True

81word8ToBool w = Left ("Invalid Bool encoding " ++ Prelude.show w)

83-- | A value of type 'Bool' is encoded as follows in binary encoding.

84--

85-- @

86-- 0 ==> False

87-- 1 ==> True

88-- @

89--

90-- /Pre-release/

91--

92{-# INLINE bool #-}

93bool :: Monad m => Parser Word8 m Bool

94bool = PR.either word8ToBool

96{-# INLINE word8ToOrdering #-}

97word8ToOrdering :: Word8 -> Either String Ordering

98word8ToOrdering 0 = Right LT

99word8ToOrdering 1 = Right EQ

100word8ToOrdering 2 = Right GT

101word8ToOrdering w = Left ("Invalid Ordering encoding " ++ Prelude.show w)

102

103-- | A value of type 'Ordering' is encoded as follows in binary encoding.

104--

105-- @

106-- 0 ==> LT

107-- 1 ==> EQ

108-- 2 ==> GT

109-- @

110--

111-- /Pre-release/

112--

113{-# INLINE ordering #-}

114ordering :: Monad m => Parser Word8 m Ordering

115ordering = PR.either word8ToOrdering

116

117-- XXX should go in a Word8 parser module?

118-- | Accept the input byte only if it is equal to the specified value.

119--

120-- /Pre-release/

121--

122{-# INLINE eqWord8 #-}

123eqWord8 :: Monad m => Word8 -> Parser Word8 m Word8

124eqWord8 b = PR.satisfy (== b)

125

126-- | Accept any byte.

127--

128-- /Pre-release/

129--

130{-# INLINE word8 #-}

131word8 :: Monad m => Parser Word8 m Word8

132word8 = PR.satisfy (const True)

133

134-- | Big endian (MSB first) Word16

135{-# INLINE word16beD #-}

136word16beD :: Monad m => PRD.Parser Word8 m Word16

137word16beD = PRD.Parser step initial extract

138

139 where

140

141 initial = return $ PRD.IPartial Nothing'

142

143 step Nothing' a =

144 -- XXX We can use a non-failing parser or a fold so that we do not

145 -- have to buffer for backtracking which is inefficient.

146 return $ PRD.Continue 0 (Just' (fromIntegral a `unsafeShiftL` 8))

147 step (Just' w) a =

148 return $ PRD.Done 0 (w .|. fromIntegral a)

149

150 extract _ = return $ PRD.Error "word16be: end of input"

151

152-- | Parse two bytes as a 'Word16', the first byte is the MSB of the Word16 and

153-- second byte is the LSB (big endian representation).

154--

155-- /Pre-release/

156--

157{-# INLINE word16be #-}

158word16be :: Monad m => Parser Word8 m Word16

159word16be = word16beD

160

161-- | Little endian (LSB first) Word16

162{-# INLINE word16leD #-}

163word16leD :: Monad m => PRD.Parser Word8 m Word16

164word16leD = PRD.Parser step initial extract

165

166 where

167

168 initial = return $ PRD.IPartial Nothing'

169

170 step Nothing' a =

171 return $ PRD.Continue 0 (Just' (fromIntegral a))

172 step (Just' w) a =

173 return $ PRD.Done 0 (w .|. fromIntegral a `unsafeShiftL` 8)

174

175 extract _ = return $ PRD.Error "word16le: end of input"

176

177-- | Parse two bytes as a 'Word16', the first byte is the LSB of the Word16 and

178-- second byte is the MSB (little endian representation).

179--

180-- /Pre-release/

181--

182{-# INLINE word16le #-}

183word16le :: Monad m => Parser Word8 m Word16

184word16le = word16leD

185

186-- | Big endian (MSB first) Word32

187{-# INLINE word32beD #-}

188word32beD :: Monad m => PRD.Parser Word8 m Word32

189word32beD = PRD.Parser step initial extract

190

191 where

192

193 initial = return $ PRD.IPartial $ Tuple' 0 24

194

195 step (Tuple' w sh) a = return $

196 if sh /= 0

197 then

198 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)

199 in PRD.Continue 0 (Tuple' w1 (sh - 8))

200 else PRD.Done 0 (w .|. fromIntegral a)

201

202 extract _ = return $ PRD.Error "word32beD: end of input"

203

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 word32be #-}

210word32be :: Monad m => Parser Word8 m Word32

211word32be = word32beD

212

213-- | Little endian (LSB first) Word32

214{-# INLINE word32leD #-}

215word32leD :: Monad m => PRD.Parser Word8 m Word32

216word32leD = PRD.Parser step initial extract

217

218 where

219

220 initial = return $ PRD.IPartial $ Tuple' 0 0

221

222 step (Tuple' w sh) a = return $

223 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)

224 in if sh /= 24

225 then PRD.Continue 0 (Tuple' w1 (sh + 8))

226 else PRD.Done 0 w1

227

228 extract _ = return $ PRD.Error "word32leD: end of input"

229

230-- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32

231-- and last byte is the LSB (big endian representation).

232--

233-- /Pre-release/

234--

235{-# INLINE word32le #-}

236word32le :: Monad m => Parser Word8 m Word32

237word32le = word32leD

238

239-- | Big endian (MSB first) Word64

240{-# INLINE word64beD #-}

241word64beD :: Monad m => PRD.Parser Word8 m Word64

242word64beD = PRD.Parser step initial extract

243

244 where

245

246 initial = return $ PRD.IPartial $ Tuple' 0 56

247

248 step (Tuple' w sh) a = return $

249 if sh /= 0

250 then

251 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)

252 in PRD.Continue 0 (Tuple' w1 (sh - 8))

253 else PRD.Done 0 (w .|. fromIntegral a)

254

255 extract _ = return $ PRD.Error "word64beD: end of input"

256

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 word64be #-}

263word64be :: Monad m => Parser Word8 m Word64

264word64be = word64beD

265

266-- | Little endian (LSB first) Word64

267{-# INLINE word64leD #-}

268word64leD :: Monad m => PRD.Parser Word8 m Word64

269word64leD = PRD.Parser step initial extract

270

271 where

272

273 initial = return $ PRD.IPartial $ Tuple' 0 0

274

275 step (Tuple' w sh) a = return $

276 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)

277 in if sh /= 56

278 then PRD.Continue 0 (Tuple' w1 (sh + 8))

279 else PRD.Done 0 w1

280

281 extract _ = return $ PRD.Error "word64leD: end of input"

282

283-- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64

284-- and last byte is the LSB (big endian representation).

285--

286-- /Pre-release/

287--

288{-# INLINE word64le #-}

289word64le :: Monad m => Parser Word8 m Word64

290word64le = word64leD

291

292{-# INLINE int8 #-}

293int8 :: Monad m => Parser Word8 m Int8

294int8 = fromIntegral <$> word8

295

296-- | Parse two bytes as a 'Int16', the first byte is the MSB of the Int16 and

297-- second byte is the LSB (big endian representation).

298--

299-- /Pre-release/

300--

301{-# INLINE int16be #-}

302int16be :: Monad m => Parser Word8 m Int16

303int16be = fromIntegral <$> word16be

304

305-- | Parse two bytes as a 'Int16', the first byte is the LSB of the Int16 and

306-- second byte is the MSB (little endian representation).

307--

308-- /Pre-release/

309--

310{-# INLINE int16le #-}

311int16le :: Monad m => Parser Word8 m Int16

312int16le = fromIntegral <$> word16le

313

314-- | Parse four bytes as a 'Int32', the first byte is the MSB of the Int32

315-- and last byte is the LSB (big endian representation).

316--

317-- /Pre-release/

318--

319{-# INLINE int32be #-}

320int32be :: Monad m => Parser Word8 m Int32

321int32be = fromIntegral <$> word32be

322

323-- | Parse four bytes as a 'Int32', the first byte is the MSB of the Int32

324-- and last byte is the LSB (big endian representation).

325--

326-- /Pre-release/

327--

328{-# INLINE int32le #-}

329int32le :: Monad m => Parser Word8 m Int32

330int32le = fromIntegral <$> word32le

331

332-- | Parse eight bytes as a 'Int64', the first byte is the MSB of the Int64

333-- and last byte is the LSB (big endian representation).

334--

335-- /Pre-release/

336--

337{-# INLINE int64be #-}

338int64be :: Monad m => Parser Word8 m Int64

339int64be = fromIntegral <$> word64be

340

341-- | Parse eight bytes as a 'Int64', the first byte is the MSB of the Int64

342-- and last byte is the LSB (big endian representation).

343--

344-- /Pre-release/

345--

346{-# INLINE int64le #-}

347int64le :: Monad m => Parser Word8 m Int64

348int64le = fromIntegral <$> word64le

349

350{-# INLINE float32be #-}

351float32be :: MonadIO m => Parser Word8 m Float

352float32be = castWord32ToFloat <$> word32be

353

354{-# INLINE float32le #-}

355float32le :: MonadIO m => Parser Word8 m Float

356float32le = castWord32ToFloat <$> word32le

357

358{-# INLINE double64be #-}

359double64be :: MonadIO m => Parser Word8 m Double

360double64be = castWord64ToDouble <$> word64be

361

362{-# INLINE double64le #-}

363double64le :: MonadIO m => Parser Word8 m Double

364double64le = castWord64ToDouble <$> word64le

365

366-- | Accept any byte.

367--

368-- /Pre-release/

369--

370{-# INLINE charLatin1 #-}

371charLatin1 :: Monad m => Parser Word8 m Char

372charLatin1 = fmap (chr . fromIntegral) word8

373

374-------------------------------------------------------------------------------

375-- Host byte order

376-------------------------------------------------------------------------------

377

378-- | Parse eight bytes as a 'Word64' in the host byte order.

379--

380-- /Pre-release/

381--

382{-# INLINE word64host #-}

383word64host :: MonadIO m => Parser Word8 m Word64

384word64host =

385 fmap (A.unsafeIndex 0 . A.castUnsafe) $ PR.takeEQ 8 (A.writeN 8)

386

387-------------------------------------------------------------------------------

388-- Type class

389-------------------------------------------------------------------------------

390

391class FromBytes a where

392 -- | Decode a byte stream to a Haskell type.

393 fromBytes :: Parser Word8 m a