Get.hs 22.3 KB
Newer Older
1
{-# LANGUAGE CPP, RankNTypes, MagicHash, BangPatterns #-}
dterei's avatar
dterei committed
2
{-# LANGUAGE Trustworthy #-}
3

4
5
6
7
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
#include "MachDeps.h"
#endif

Don Stewart's avatar
Don Stewart committed
8
9
-----------------------------------------------------------------------------
-- |
10
-- Module      : Data.Binary.Get
11
-- Copyright   : Lennart Kolmodin
Don Stewart's avatar
Don Stewart committed
12
-- License     : BSD3-style (see LICENSE)
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
13
--
Lennart Kolmodin's avatar
Lennart Kolmodin committed
14
-- Maintainer  : Lennart Kolmodin <kolmodin@gmail.com>
Don Stewart's avatar
mergeo    
Don Stewart committed
15
16
-- Stability   : experimental
-- Portability : portable to Hugs and GHC.
17
--
Lennart Kolmodin's avatar
Lennart Kolmodin committed
18
-- The 'Get' monad. A monad for efficiently building structures from
19
-- encoded lazy ByteStrings.
Don Stewart's avatar
Don Stewart committed
20
--
21
22
-- Primitives are available to decode words of various sizes, both big and
-- little endian.
Lennart Kolmodin's avatar
Lennart Kolmodin committed
23
--
24
25
-- Let's decode binary data representing illustrated here.
-- In this example the values are in little endian.
Lennart Kolmodin's avatar
Lennart Kolmodin committed
26
--
27
28
29
30
31
32
-- > +------------------+--------------+-----------------+
-- > | 32 bit timestamp | 32 bit price | 16 bit quantity |
-- > +------------------+--------------+-----------------+
--
-- A corresponding Haskell value looks like this:
--
33
-- @
34
35
36
37
38
--data Trade = Trade
--  { timestamp :: !'Word32'
--  , price     :: !'Word32'
--  , qty       :: !'Word16'
--  } deriving ('Show')
39
-- @
40
41
42
43
--
-- The fields in @Trade@ are marked as strict (using @!@) since we don't need
-- laziness here. In practise, you would probably consider using the UNPACK
-- pragma as well.
brady.ouren's avatar
brady.ouren committed
44
-- <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#unpack-pragma>
45
46
--
-- Now, let's have a look at a decoder for this format.
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
47
--
48
-- @
49
50
51
52
53
54
--getTrade :: 'Get' Trade
--getTrade = do
--  timestamp <- 'getWord32le'
--  price     <- 'getWord32le'
--  quantity  <- 'getWord16le'
--  return '$!' Trade timestamp price quantity
55
-- @
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
56
--
57
58
-- Or even simpler using applicative style:
--
59
-- @
60
61
--getTrade' :: 'Get' Trade
--getTrade' = Trade '<$>' 'getWord32le' '<*>' 'getWord32le' '<*>' 'getWord16le'
62
-- @
63
64
65
66
67
68
69
--
-- There are two kinds of ways to execute this decoder, the lazy input
-- method and the incremental input method. Here we will use the lazy
-- input method.
--
-- Let's first define a function that decodes many @Trade@s.
--
70
-- @
71
72
73
74
75
76
77
78
--getTrades :: Get [Trade]
--getTrades = do
--  empty <- 'isEmpty'
--  if empty
--    then return []
--    else do trade <- getTrade
--            trades <- getTrades
--            return (trade:trades)
79
-- @
80
81
82
--
-- Finally, we run the decoder:
--
83
-- @
84
85
--lazyIOExample :: IO [Trade]
--lazyIOExample = do
86
87
88
--  input <- BL.readFile \"trades.bin\"
--  return ('runGet' getTrades input)
-- @
89
90
91
92
93
94
--
-- This decoder has the downside that it will need to read all the input before
-- it can return. On the other hand, it will not return anything until
-- it knows it could decode without any decoder errors.
--
-- You could also refactor to a left-fold, to decode in a more streaming fashion,
Mikhail Glushenkov's avatar
Typo.    
Mikhail Glushenkov committed
95
-- and get the following decoder. It will start to return data without knowing
96
97
-- that it can decode all input.
--
98
-- @
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
--incrementalExample :: BL.ByteString -> [Trade]
--incrementalExample input0 = go decoder input0
--  where
--    decoder = 'runGetIncremental' getTrade
--    go :: 'Decoder' Trade -> BL.ByteString -> [Trade]
--    go ('Done' leftover _consumed trade) input =
--      trade : go decoder (BL.chunk leftover input)
--    go ('Partial' k) input                     =
--      go (k . takeHeadChunk $ input) (dropHeadChunk input)
--    go ('Fail' _leftover _consumed msg) _input =
--      error msg
--
--takeHeadChunk :: BL.ByteString -> Maybe BS.ByteString
--takeHeadChunk lbs =
--  case lbs of
--    (BL.Chunk bs _) -> Just bs
--    _ -> Nothing
--
--dropHeadChunk :: BL.ByteString -> BL.ByteString
--dropHeadChunk lbs =
--  case lbs of
--    (BL.Chunk _ lbs') -> lbs'
--    _ -> BL.Empty
122
-- @
123
--
124
-- The @lazyIOExample@ uses lazy I/O to read the file from the disk, which is
125
126
-- not suitable in all applications, and certainly not if you need to read
-- from a socket which has higher likelihood to fail. To address these needs,
127
128
-- use the incremental input method like in @incrementalExample@.
-- For an example of how to read incrementally from a Handle,
Alec Theriault's avatar
Alec Theriault committed
129
-- see the implementation of 'Data.Binary.decodeFileOrFail'.
Don Stewart's avatar
Don Stewart committed
130
131
-----------------------------------------------------------------------------

132

133
134
module Data.Binary.Get (

Lennart Kolmodin's avatar
Lennart Kolmodin committed
135
    -- * The Get monad
136
      Get
Lennart Kolmodin's avatar
Lennart Kolmodin committed
137
138
139

    -- * The lazy input interface
    -- $lazyinterface
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
140
    , runGet
tibbe's avatar
tibbe committed
141
142
    , runGetOrFail
    , ByteOffset
143

Lennart Kolmodin's avatar
Lennart Kolmodin committed
144
145
146
147
148
149
150
151
    -- * The incremental input interface
    -- $incrementalinterface
    , Decoder(..)
    , runGetIncremental

    -- ** Providing input
    , pushChunk
    , pushChunks
152
    , pushEndOfInput
153

Lennart Kolmodin's avatar
Lennart Kolmodin committed
154
    -- * Decoding
Lennart Kolmodin's avatar
Lennart Kolmodin committed
155
    , skip
Lennart Kolmodin's avatar
Lennart Kolmodin committed
156
    , isEmpty
157
    , bytesRead
158
    , isolate
Lennart Kolmodin's avatar
Lennart Kolmodin committed
159
    , lookAhead
Lennart Kolmodin's avatar
Lennart Kolmodin committed
160
    , lookAheadM
Lennart Kolmodin's avatar
Lennart Kolmodin committed
161
    , lookAheadE
Lennart Kolmodin's avatar
Lennart Kolmodin committed
162
    , label
163
164

    -- ** ByteStrings
165
    , getByteString
166
    , getLazyByteString
167
168
    , getLazyByteStringNul
    , getRemainingLazyByteString
Don Stewart's avatar
Don Stewart committed
169

Lennart Kolmodin's avatar
Lennart Kolmodin committed
170
    -- ** Decoding Words
Lennart Kolmodin's avatar
Lennart Kolmodin committed
171
172
173
    , getWord8

    -- *** Big-endian decoding
kolmodin@dtek.chalmers.se's avatar
kolmodin@dtek.chalmers.se committed
174
175
    , getWord16be
    , getWord32be
Don Stewart's avatar
Don Stewart committed
176
    , getWord64be
177

Lennart Kolmodin's avatar
Lennart Kolmodin committed
178
    -- *** Little-endian decoding
Don Stewart's avatar
Don Stewart committed
179
    , getWord16le
kolmodin@dtek.chalmers.se's avatar
kolmodin@dtek.chalmers.se committed
180
181
    , getWord32le
    , getWord64le
182

Lennart Kolmodin's avatar
Lennart Kolmodin committed
183
    -- *** Host-endian, unaligned decoding
184
185
186
187
188
    , getWordhost
    , getWord16host
    , getWord32host
    , getWord64host

Lennart Kolmodin's avatar
Lennart Kolmodin committed
189
    -- ** Decoding Ints
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
    , getInt8

    -- *** Big-endian decoding
    , getInt16be
    , getInt32be
    , getInt64be

    -- *** Little-endian decoding
    , getInt16le
    , getInt32le
    , getInt64le

    -- *** Host-endian, unaligned decoding
    , getInthost
    , getInt16host
    , getInt32host
    , getInt64host

208
209
210
211
212
213
214
215
    -- ** Decoding Floats/Doubles
    , getFloatbe
    , getFloatle
    , getFloathost
    , getDoublebe
    , getDoublele
    , getDoublehost

Lennart Kolmodin's avatar
Lennart Kolmodin committed
216
    -- * Deprecated functions
tibbe's avatar
tibbe committed
217
    , runGetState -- DEPRECATED
Lennart Kolmodin's avatar
Lennart Kolmodin committed
218
219
    , remaining -- DEPRECATED
    , getBytes -- DEPRECATED
220
    ) where
221
222
223
#if ! MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
kolmodin@dtek.chalmers.se's avatar
kolmodin@dtek.chalmers.se committed
224

225
import Foreign
kolmodin@dtek.chalmers.se's avatar
kolmodin@dtek.chalmers.se committed
226
import qualified Data.ByteString as B
227
import qualified Data.ByteString.Unsafe as B
228
import qualified Data.ByteString.Lazy as L
229
import qualified Data.ByteString.Lazy.Internal as L
230

Lennart Kolmodin's avatar
Lennart Kolmodin committed
231
import Data.Binary.Get.Internal hiding ( Decoder(..), runGetIncremental )
232
233
import qualified Data.Binary.Get.Internal as I

234
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
235
-- needed for (# unboxing #) with magic hash
Moritz Angermann's avatar
Moritz Angermann committed
236
import GHC.Base hiding ( narrowWord16#, extendWord16# )
kolmodin@dtek.chalmers.se's avatar
kolmodin@dtek.chalmers.se committed
237
import GHC.Word
Don Stewart's avatar
Don Stewart committed
238
#endif
kolmodin@dtek.chalmers.se's avatar
kolmodin@dtek.chalmers.se committed
239

240
-- needed for casting words to float/double
241
import Data.Binary.FloatCast (wordToFloat, wordToDouble)
242

Moritz Angermann's avatar
Moritz Angermann committed
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
#if MIN_VERSION_base(4,16,0)
import GHC.Exts ( extendWord16#, narrowWord16# )
#else
extendWord16#, extendWord32# :: Word# -> Word#
narrowWord16#, narrowWord32# :: Word# -> Word#
extendWord16# w = w
extendWord32# w = w
narrowWord16# w = w
narrowWord32# w = w
{-# INLINE narrowWord16# #-}
{-# INLINE extendWord16# #-}
{-# INLINE narrowWord32# #-}
{-# INLINE extendWord32# #-}
#endif

Lennart Kolmodin's avatar
Lennart Kolmodin committed
258
-- $lazyinterface
tibbe's avatar
tibbe committed
259
260
261
-- The lazy interface consumes a single lazy 'L.ByteString'. It's the easiest
-- interface to get started with, but it doesn't support interleaving I\/O and
-- parsing, unless lazy I/O is used.
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
262
--
263
264
-- There is no way to provide more input other than the initial data. To be
-- able to incrementally give more data, see the incremental input interface.
Lennart Kolmodin's avatar
Lennart Kolmodin committed
265
266

-- $incrementalinterface
tibbe's avatar
tibbe committed
267
268
269
270
-- The incremental interface gives you more control over how input is
-- provided during parsing. This lets you e.g. interleave parsing and
-- I\/O.
--
Lennart Kolmodin's avatar
Lennart Kolmodin committed
271
-- The incremental interface consumes a strict 'B.ByteString' at a time, each
272
-- being part of the total amount of input. If your decoder needs more input to
Lennart Kolmodin's avatar
Lennart Kolmodin committed
273
274
-- finish it will return a 'Partial' with a continuation.
-- If there is no more input, provide it 'Nothing'.
tibbe's avatar
tibbe committed
275
--
Lennart Kolmodin's avatar
Lennart Kolmodin committed
276
277
278
279
280
-- 'Fail' will be returned if it runs into an error, together with a message,
-- the position and the remaining input.
-- If it succeeds it will return 'Done' with the resulting value,
-- the position and the remaining input.

Lennart Kolmodin's avatar
Lennart Kolmodin committed
281
-- | A decoder procuced by running a 'Get' monad.
tibbe's avatar
tibbe committed
282
data Decoder a = Fail !B.ByteString {-# UNPACK #-} !ByteOffset String
283
              -- ^ The decoder ran into an error. The decoder either used
tibbe's avatar
tibbe committed
284
285
              -- 'fail' or was not provided enough input. Contains any
              -- unconsumed input and the number of bytes consumed.
Lennart Kolmodin's avatar
Lennart Kolmodin committed
286
              | Partial (Maybe B.ByteString -> Decoder a)
287
              -- ^ The decoder has consumed the available input and needs
288
              -- more to continue. Provide 'Just' if more input is available
Lennart Kolmodin's avatar
Lennart Kolmodin committed
289
              -- and 'Nothing' otherwise, and you will get a new 'Decoder'.
tibbe's avatar
tibbe committed
290
              | Done !B.ByteString {-# UNPACK #-} !ByteOffset a
291
              -- ^ The decoder has successfully finished. Except for the
tibbe's avatar
tibbe committed
292
293
              -- output value you also get any unused input as well as the
              -- number of bytes consumed.
294

Lennart Kolmodin's avatar
Lennart Kolmodin committed
295
-- | Run a 'Get' monad. See 'Decoder' for what to do next, like providing
296
-- input, handling decoder errors and to get the output value.
Lennart Kolmodin's avatar
Lennart Kolmodin committed
297
298
-- Hint: Use the helper functions 'pushChunk', 'pushChunks' and
-- 'pushEndOfInput'.
Lennart Kolmodin's avatar
Lennart Kolmodin committed
299
300
runGetIncremental :: Get a -> Decoder a
runGetIncremental = calculateOffset . I.runGetIncremental
301

Lennart Kolmodin's avatar
Lennart Kolmodin committed
302
calculateOffset :: I.Decoder a -> Decoder a
Lennart Kolmodin's avatar
Lennart Kolmodin committed
303
calculateOffset r0 = go r0 0
304
305
306
307
  where
  go r !acc = case r of
                I.Done inp a -> Done inp (acc - fromIntegral (B.length inp)) a
                I.Fail inp s -> Fail inp (acc - fromIntegral (B.length inp)) s
308
                I.Partial k ->
309
310
                    Partial $ \ms ->
                      case ms of
311
312
                        Nothing -> go (k Nothing) acc
                        Just i -> go (k ms) (acc + fromIntegral (B.length i))
313
                I.BytesRead unused k ->
314
                    go (k $! (acc - unused)) acc
315

316
-- | DEPRECATED. Provides compatibility with previous versions of this library.
Mikhail Glushenkov's avatar
Typo.    
Mikhail Glushenkov committed
317
-- Run a 'Get' monad and return a tuple with three values.
Lennart Kolmodin's avatar
Lennart Kolmodin committed
318
319
-- The first value is the result of the decoder. The second and third are the
-- unused input, and the number of consumed bytes.
320
{-# DEPRECATED runGetState "Use runGetIncremental instead. This function will be removed." #-}
tibbe's avatar
tibbe committed
321
runGetState :: Get a -> L.ByteString -> ByteOffset -> (a, L.ByteString, ByteOffset)
322
runGetState g lbs0 pos' = go (runGetIncremental g) lbs0
323
  where
324
325
  go (Done s pos a) lbs = (a, L.chunk s lbs, pos+pos')
  go (Partial k) lbs = go (k (takeHeadChunk lbs)) (dropHeadChunk lbs)
326
327
  go (Fail _ pos msg) _ =
    error ("Data.Binary.Get.runGetState at position " ++ show pos ++ ": " ++ msg)
328
329
330
331
332
333
334
335
336
337
338
339

takeHeadChunk :: L.ByteString -> Maybe B.ByteString
takeHeadChunk lbs =
  case lbs of
    (L.Chunk bs _) -> Just bs
    _ -> Nothing

dropHeadChunk :: L.ByteString -> L.ByteString
dropHeadChunk lbs =
  case lbs of
    (L.Chunk _ lbs') -> lbs'
    _ -> L.Empty
340

tibbe's avatar
tibbe committed
341
342
343
344
-- | Run a 'Get' monad and return 'Left' on failure and 'Right' on
-- success. In both cases any unconsumed input and the number of bytes
-- consumed is returned. In the case of failure, a human-readable
-- error message is included as well.
Oleg Grenrus's avatar
Oleg Grenrus committed
345
--
Alec Theriault's avatar
Alec Theriault committed
346
-- @since 0.6.4.0
tibbe's avatar
tibbe committed
347
348
runGetOrFail :: Get a -> L.ByteString
             -> Either (L.ByteString, ByteOffset, String) (L.ByteString, ByteOffset, a)
349
runGetOrFail g lbs0 = feedAll (runGetIncremental g) lbs0
tibbe's avatar
tibbe committed
350
  where
351
352
353
  feedAll (Done bs pos x) lbs = Right (L.chunk bs lbs, pos, x)
  feedAll (Partial k) lbs = feedAll (k (takeHeadChunk lbs)) (dropHeadChunk lbs)
  feedAll (Fail x pos msg) xs = Left (L.chunk x xs, pos, msg)
tibbe's avatar
tibbe committed
354
355
356

-- | An offset, counted in bytes.
type ByteOffset = Int64
357

358
-- | The simplest interface to run a 'Get' decoder. If the decoder runs into
tibbe's avatar
tibbe committed
359
-- an error, calls 'fail', or runs out of input, it will call 'error'.
360
runGet :: Get a -> L.ByteString -> a
361
runGet g lbs0 = feedAll (runGetIncremental g) lbs0
362
  where
363
364
  feedAll (Done _ _ x) _ = x
  feedAll (Partial k) lbs = feedAll (k (takeHeadChunk lbs)) (dropHeadChunk lbs)
365
366
367
  feedAll (Fail _ pos msg) _ =
    error ("Data.Binary.Get.runGet at position " ++ show pos ++ ": " ++ msg)

368

Lennart Kolmodin's avatar
Lennart Kolmodin committed
369
370
-- | Feed a 'Decoder' with more input. If the 'Decoder' is 'Done' or 'Fail' it
-- will add the input to 'B.ByteString' of unconsumed input.
371
372
--
-- @
373
--    'runGetIncremental' myParser \`pushChunk\` myInput1 \`pushChunk\` myInput2
374
-- @
Lennart Kolmodin's avatar
Lennart Kolmodin committed
375
376
pushChunk :: Decoder a -> B.ByteString -> Decoder a
pushChunk r inp =
377
  case r of
378
    Done inp0 p a -> Done (inp0 `B.append` inp) p a
379
    Partial k -> k (Just inp)
380
    Fail inp0 p s -> Fail (inp0 `B.append` inp) p s
381

382

383
-- | Feed a 'Decoder' with more input. If the 'Decoder' is 'Done' or 'Fail' it
Alec Theriault's avatar
Alec Theriault committed
384
-- will add the input to 'L.ByteString' of unconsumed input.
385
386
--
-- @
387
--    'runGetIncremental' myParser \`pushChunks\` myLazyByteString
388
-- @
Lennart Kolmodin's avatar
Lennart Kolmodin committed
389
390
pushChunks :: Decoder a -> L.ByteString -> Decoder a
pushChunks r0 = go r0 . L.toChunks
391
392
  where
  go r [] = r
393
394
395
  go (Done inp pos a) xs = Done (B.concat (inp:xs)) pos a
  go (Fail inp pos s) xs = Fail (B.concat (inp:xs)) pos s
  go (Partial k) (x:xs) = go (k (Just x)) xs
396

Lennart Kolmodin's avatar
Lennart Kolmodin committed
397
-- | Tell a 'Decoder' that there is no more input. This passes 'Nothing' to a
Lennart Kolmodin's avatar
Lennart Kolmodin committed
398
-- 'Partial' decoder, otherwise returns the decoder unchanged.
399
400
pushEndOfInput :: Decoder a -> Decoder a
pushEndOfInput r =
401
  case r of
402
    Done _ _ _ -> r
403
    Partial k -> k Nothing
404
    Fail _ _ _ -> r
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
405

406
407
408
409
-- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available.
skip :: Int -> Get ()
skip n = withInputChunks (fromIntegral n) consumeBytes (const ()) failOnEOF

410
411
412
-- | An efficient get method for lazy ByteStrings. Fails if fewer than @n@
-- bytes are left in the input.
getLazyByteString :: Int64 -> Get L.ByteString
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
getLazyByteString n0 = withInputChunks n0 consumeBytes L.fromChunks failOnEOF

consumeBytes :: Consume Int64
consumeBytes n str
  | fromIntegral (B.length str) >= n = Right (B.splitAt (fromIntegral n) str)
  | otherwise = Left (n - fromIntegral (B.length str))

consumeUntilNul :: Consume ()
consumeUntilNul _ str =
  case B.break (==0) str of
    (want, rest) | B.null rest -> Left ()
                 | otherwise -> Right (want, B.drop 1 rest)

consumeAll :: Consume ()
consumeAll _ _ = Left ()

resumeOnEOF :: [B.ByteString] -> Get L.ByteString
resumeOnEOF = return . L.fromChunks
431
432
433
434
435

-- | Get a lazy ByteString that is terminated with a NUL byte.
-- The returned string does not contain the NUL byte. Fails
-- if it reaches the end of input without finding a NUL.
getLazyByteStringNul :: Get L.ByteString
436
getLazyByteStringNul = withInputChunks () consumeUntilNul L.fromChunks failOnEOF
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
437

438
439
440
441
-- | Get the remaining bytes as a lazy ByteString.
-- Note that this can be an expensive function to use as it forces reading
-- all input and keeping the string in-memory.
getRemainingLazyByteString :: Get L.ByteString
442
getRemainingLazyByteString = withInputChunks () consumeAll L.fromChunks resumeOnEOF
443

Don Stewart's avatar
Don Stewart committed
444
445
446
------------------------------------------------------------------------
-- Primtives

447
-- helper, get a raw Ptr onto a strict ByteString copied out of the
448
-- underlying lazy byteString.
449
450

getPtr :: Storable a => Int -> Get a
451
getPtr n = readNWith n peek
452
{-# INLINE getPtr #-}
453

Don Stewart's avatar
Don Stewart committed
454
-- | Read a Word8 from the monad state
455
getWord8 :: Get Word8
456
getWord8 = readN 1 B.unsafeHead
457
{-# INLINE[2] getWord8 #-}
kolmodin@dtek.chalmers.se's avatar
kolmodin@dtek.chalmers.se committed
458

Khudyakov's avatar
Khudyakov committed
459
-- | Read an Int8 from the monad state
460
461
462
463
464
getInt8 :: Get Int8
getInt8 = fromIntegral <$> getWord8
{-# INLINE getInt8 #-}


465
466
467
468
469
470
471
472
-- force GHC to inline getWordXX
{-# RULES
"getWord8/readN" getWord8 = readN 1 B.unsafeHead
"getWord16be/readN" getWord16be = readN 2 word16be
"getWord16le/readN" getWord16le = readN 2 word16le
"getWord32be/readN" getWord32be = readN 4 word32be
"getWord32le/readN" getWord32le = readN 4 word32le
"getWord64be/readN" getWord64be = readN 8 word64be
473
"getWord64le/readN" getWord64le = readN 8 word64le #-}
474

Don Stewart's avatar
Don Stewart committed
475
-- | Read a Word16 in big endian format
476
getWord16be :: Get Word16
477
478
479
480
getWord16be = readN 2 word16be

word16be :: B.ByteString -> Word16
word16be = \s ->
481
482
        (fromIntegral (s `B.unsafeIndex` 0) `shiftl_w16` 8) .|.
        (fromIntegral (s `B.unsafeIndex` 1))
483
{-# INLINE[2] getWord16be #-}
484
{-# INLINE word16be #-}
485

Don Stewart's avatar
Don Stewart committed
486
-- | Read a Word16 in little endian format
487
getWord16le :: Get Word16
488
489
490
491
getWord16le = readN 2 word16le

word16le :: B.ByteString -> Word16
word16le = \s ->
492
              (fromIntegral (s `B.unsafeIndex` 1) `shiftl_w16` 8) .|.
493
              (fromIntegral (s `B.unsafeIndex` 0) )
494
{-# INLINE[2] getWord16le #-}
495
{-# INLINE word16le #-}
kolmodin@dtek.chalmers.se's avatar
kolmodin@dtek.chalmers.se committed
496

Don Stewart's avatar
Don Stewart committed
497
-- | Read a Word32 in big endian format
498
getWord32be :: Get Word32
499
500
501
502
getWord32be = readN 4 word32be

word32be :: B.ByteString -> Word32
word32be = \s ->
503
              (fromIntegral (s `B.unsafeIndex` 0) `shiftl_w32` 24) .|.
504
505
506
              (fromIntegral (s `B.unsafeIndex` 1) `shiftl_w32` 16) .|.
              (fromIntegral (s `B.unsafeIndex` 2) `shiftl_w32`  8) .|.
              (fromIntegral (s `B.unsafeIndex` 3) )
507
{-# INLINE[2] getWord32be #-}
508
{-# INLINE word32be #-}
kolmodin@dtek.chalmers.se's avatar
kolmodin@dtek.chalmers.se committed
509

Don Stewart's avatar
Don Stewart committed
510
-- | Read a Word32 in little endian format
511
getWord32le :: Get Word32
512
513
514
515
getWord32le = readN 4 word32le

word32le :: B.ByteString -> Word32
word32le = \s ->
516
              (fromIntegral (s `B.unsafeIndex` 3) `shiftl_w32` 24) .|.
517
518
519
              (fromIntegral (s `B.unsafeIndex` 2) `shiftl_w32` 16) .|.
              (fromIntegral (s `B.unsafeIndex` 1) `shiftl_w32`  8) .|.
              (fromIntegral (s `B.unsafeIndex` 0) )
520
{-# INLINE[2] getWord32le #-}
521
{-# INLINE word32le #-}
kolmodin@dtek.chalmers.se's avatar
kolmodin@dtek.chalmers.se committed
522

Don Stewart's avatar
Don Stewart committed
523
-- | Read a Word64 in big endian format
524
getWord64be :: Get Word64
525
526
527
528
getWord64be = readN 8 word64be

word64be :: B.ByteString -> Word64
word64be = \s ->
529
              (fromIntegral (s `B.unsafeIndex` 0) `shiftl_w64` 56) .|.
530
531
532
533
534
535
536
              (fromIntegral (s `B.unsafeIndex` 1) `shiftl_w64` 48) .|.
              (fromIntegral (s `B.unsafeIndex` 2) `shiftl_w64` 40) .|.
              (fromIntegral (s `B.unsafeIndex` 3) `shiftl_w64` 32) .|.
              (fromIntegral (s `B.unsafeIndex` 4) `shiftl_w64` 24) .|.
              (fromIntegral (s `B.unsafeIndex` 5) `shiftl_w64` 16) .|.
              (fromIntegral (s `B.unsafeIndex` 6) `shiftl_w64`  8) .|.
              (fromIntegral (s `B.unsafeIndex` 7) )
537
{-# INLINE[2] getWord64be #-}
538
{-# INLINE word64be #-}
kolmodin@dtek.chalmers.se's avatar
kolmodin@dtek.chalmers.se committed
539

Don Stewart's avatar
Don Stewart committed
540
-- | Read a Word64 in little endian format
541
getWord64le :: Get Word64
542
543
544
545
getWord64le = readN 8 word64le

word64le :: B.ByteString -> Word64
word64le = \s ->
546
              (fromIntegral (s `B.unsafeIndex` 7) `shiftl_w64` 56) .|.
547
548
549
550
551
552
553
              (fromIntegral (s `B.unsafeIndex` 6) `shiftl_w64` 48) .|.
              (fromIntegral (s `B.unsafeIndex` 5) `shiftl_w64` 40) .|.
              (fromIntegral (s `B.unsafeIndex` 4) `shiftl_w64` 32) .|.
              (fromIntegral (s `B.unsafeIndex` 3) `shiftl_w64` 24) .|.
              (fromIntegral (s `B.unsafeIndex` 2) `shiftl_w64` 16) .|.
              (fromIntegral (s `B.unsafeIndex` 1) `shiftl_w64`  8) .|.
              (fromIntegral (s `B.unsafeIndex` 0) )
554
{-# INLINE[2] getWord64le #-}
555
{-# INLINE word64le #-}
kolmodin@dtek.chalmers.se's avatar
kolmodin@dtek.chalmers.se committed
556

557

Lennart Kolmodin's avatar
Lennart Kolmodin committed
558
-- | Read an Int16 in big endian format.
559
560
561
562
getInt16be :: Get Int16
getInt16be = fromIntegral <$> getWord16be
{-# INLINE getInt16be #-}

Lennart Kolmodin's avatar
Lennart Kolmodin committed
563
-- | Read an Int32 in big endian format.
564
565
566
567
getInt32be :: Get Int32
getInt32be =  fromIntegral <$> getWord32be
{-# INLINE getInt32be #-}

Lennart Kolmodin's avatar
Lennart Kolmodin committed
568
-- | Read an Int64 in big endian format.
569
570
571
572
573
getInt64be :: Get Int64
getInt64be = fromIntegral <$> getWord64be
{-# INLINE getInt64be #-}


Lennart Kolmodin's avatar
Lennart Kolmodin committed
574
-- | Read an Int16 in little endian format.
575
576
577
578
getInt16le :: Get Int16
getInt16le = fromIntegral <$> getWord16le
{-# INLINE getInt16le #-}

Lennart Kolmodin's avatar
Lennart Kolmodin committed
579
-- | Read an Int32 in little endian format.
580
581
582
583
getInt32le :: Get Int32
getInt32le =  fromIntegral <$> getWord32le
{-# INLINE getInt32le #-}

Lennart Kolmodin's avatar
Lennart Kolmodin committed
584
-- | Read an Int64 in little endian format.
585
586
587
588
589
getInt64le :: Get Int64
getInt64le = fromIntegral <$> getWord64le
{-# INLINE getInt64le #-}


590
591
592
593
594
595
596
------------------------------------------------------------------------
-- Host-endian reads

-- | /O(1)./ Read a single native machine word. The word is read in
-- host order, host endian form, for the machine you're on. On a 64 bit
-- machine the Word is an 8 byte value, on a 32 bit machine, 4 bytes.
getWordhost :: Get Word
597
getWordhost = getPtr (sizeOf (undefined :: Word))
598
{-# INLINE getWordhost #-}
599

Don Stewart's avatar
docs    
Don Stewart committed
600
-- | /O(1)./ Read a 2 byte Word16 in native host order and host endianness.
601
getWord16host :: Get Word16
602
getWord16host = getPtr (sizeOf (undefined :: Word16))
603
{-# INLINE getWord16host #-}
604

Don Stewart's avatar
docs    
Don Stewart committed
605
-- | /O(1)./ Read a Word32 in native host order and host endianness.
606
getWord32host :: Get Word32
607
getWord32host = getPtr  (sizeOf (undefined :: Word32))
608
{-# INLINE getWord32host #-}
609

610
-- | /O(1)./ Read a Word64 in native host order and host endianess.
611
getWord64host   :: Get Word64
612
getWord64host = getPtr  (sizeOf (undefined :: Word64))
613
{-# INLINE getWord64host #-}
614

615
616
617
618
619
620
621
622
623
624
625
-- | /O(1)./ Read a single native machine word in native host
-- order. It works in the same way as 'getWordhost'.
getInthost :: Get Int
getInthost = getPtr (sizeOf (undefined :: Int))
{-# INLINE getInthost #-}

-- | /O(1)./ Read a 2 byte Int16 in native host order and host endianness.
getInt16host :: Get Int16
getInt16host = getPtr (sizeOf (undefined :: Int16))
{-# INLINE getInt16host #-}

Khudyakov's avatar
Khudyakov committed
626
-- | /O(1)./ Read an Int32 in native host order and host endianness.
627
628
629
630
getInt32host :: Get Int32
getInt32host = getPtr  (sizeOf (undefined :: Int32))
{-# INLINE getInt32host #-}

Khudyakov's avatar
Khudyakov committed
631
-- | /O(1)./ Read an Int64 in native host order and host endianess.
632
633
634
635
636
getInt64host   :: Get Int64
getInt64host = getPtr  (sizeOf (undefined :: Int64))
{-# INLINE getInt64host #-}


637
638
639
------------------------------------------------------------------------
-- Double/Float reads

640
-- | Read a 'Float' in big endian IEEE-754 format.
641
642
643
644
getFloatbe :: Get Float
getFloatbe = wordToFloat <$> getWord32be
{-# INLINE getFloatbe #-}

645
-- | Read a 'Float' in little endian IEEE-754 format.
646
647
648
649
getFloatle :: Get Float
getFloatle = wordToFloat <$> getWord32le
{-# INLINE getFloatle #-}

650
-- | Read a 'Float' in IEEE-754 format and host endian.
651
652
653
654
getFloathost :: Get Float
getFloathost = wordToFloat <$> getWord32host
{-# INLINE getFloathost #-}

655
-- | Read a 'Double' in big endian IEEE-754 format.
656
657
658
659
getDoublebe :: Get Double
getDoublebe = wordToDouble <$> getWord64be
{-# INLINE getDoublebe #-}

660
-- | Read a 'Double' in little endian IEEE-754 format.
661
662
663
664
getDoublele :: Get Double
getDoublele = wordToDouble <$> getWord64le
{-# INLINE getDoublele #-}

665
-- | Read a 'Double' in IEEE-754 format and host endian.
666
667
668
669
getDoublehost :: Get Double
getDoublehost = wordToDouble <$> getWord64host
{-# INLINE getDoublehost #-}

670
671
------------------------------------------------------------------------
-- Unchecked shifts
Don Stewart's avatar
Don Stewart committed
672

673
674
675
shiftl_w16 :: Word16 -> Int -> Word16
shiftl_w32 :: Word32 -> Int -> Word32
shiftl_w64 :: Word64 -> Int -> Word64
676

677
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
Moritz Angermann's avatar
Moritz Angermann committed
678
679
shiftl_w16 (W16# w) (I# i) = W16# (narrowWord16# ((extendWord16# w) `uncheckedShiftL#`   i))
shiftl_w32 (W32# w) (I# i) = W32# (narrowWord32# ((extendWord32# w) `uncheckedShiftL#`   i))
680
681

#if WORD_SIZE_IN_BITS < 64
682
683
shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)

684
685
686
687
#else
shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)
#endif

Don Stewart's avatar
Don Stewart committed
688
#else
689
690
691
shiftl_w16 = shiftL
shiftl_w32 = shiftL
shiftl_w64 = shiftL
Don Stewart's avatar
Don Stewart committed
692
#endif