Binary.hs

{-# LANGUAGE FlexibleContexts #-}

module Network.AMQP.Binary
    ( getFloat32be, putFloat32be
    , getFloat64be, putFloat64be
    ) where

import qualified Data.Binary.Get      as Bin
import qualified Data.Binary.Put      as Bin
import           GHC.ST               (ST, runST)
import           Data.Binary          (Get, Put)
import           Data.Array.ST        (MArray, STUArray, newArray, readArray)
import           Data.Array.Unsafe    (castSTUArray)

-- NB: Once we drop support for binary < 0.8.4 we can use @binary@'s own {get,put}{Double,Float}be operations

putFloat32be :: Float -> Put
putFloat32be x = Bin.putWord32be (runST (cast x))

putFloat64be :: Double -> Put
putFloat64be x = Bin.putWord64be (runST (cast x))

getFloat32be :: Get Float
getFloat32be = do
  x <- Bin.getWord32be
  return (runST (cast x))

getFloat64be :: Get Double
getFloat64be = do
  x <- Bin.getWord64be
  return (runST (cast x))

-- See https://stackoverflow.com/questions/6976684/converting-ieee-754-floating-point-in-haskell-word32-64-to-and-from-haskell-floa/7002812#7002812

{-# INLINE cast #-}
cast :: (MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) => a -> ST s b
cast x = newArray (0 :: Int, 0) x >>= castSTUArray >>= flip readArray 0