{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif
module Data.Serialize.IEEE754 (
getFloat32le
, getFloat32be
, getFloat64le
, getFloat64be
, putFloat32le
, putFloat32be
, putFloat64le
, putFloat64be
) where
import Data.Word ( Word32, Word64 )
import Data.Serialize.Get
import Data.Serialize.Put
import qualified Data.ByteString.Builder as Builder
import System.IO.Unsafe (unsafeDupablePerformIO)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Storable (peek, poke)
import Foreign.Ptr (castPtr, Ptr)
#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative ( (<$>) )
#endif
getFloat32le :: Get Float
getFloat32le :: Get Float
getFloat32le = Word32 -> Float
wordToFloat (Word32 -> Float) -> Get Word32 -> Get Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
getFloat32be :: Get Float
getFloat32be :: Get Float
getFloat32be = Word32 -> Float
wordToFloat (Word32 -> Float) -> Get Word32 -> Get Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
getFloat64le :: Get Double
getFloat64le :: Get Double
getFloat64le = Word64 -> Double
wordToDouble (Word64 -> Double) -> Get Word64 -> Get Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
getFloat64be :: Get Double
getFloat64be :: Get Double
getFloat64be = Word64 -> Double
wordToDouble (Word64 -> Double) -> Get Word64 -> Get Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be
putFloat32le :: Float -> Put
putFloat32le :: Float -> Put
putFloat32le = Putter Builder
putBuilder Putter Builder -> (Float -> Builder) -> Float -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Builder
Builder.floatLE
putFloat32be :: Float -> Put
putFloat32be :: Float -> Put
putFloat32be = Putter Builder
putBuilder Putter Builder -> (Float -> Builder) -> Float -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Builder
Builder.floatBE
putFloat64le :: Double -> Put
putFloat64le :: Double -> Put
putFloat64le = Putter Builder
putBuilder Putter Builder -> (Double -> Builder) -> Double -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Builder
Builder.doubleLE
putFloat64be :: Double -> Put
putFloat64be :: Double -> Put
putFloat64be = Putter Builder
putBuilder Putter Builder -> (Double -> Builder) -> Double -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Builder
Builder.doubleBE
{-# INLINE wordToFloat #-}
wordToFloat :: Word32 -> Float
wordToFloat :: Word32 -> Float
wordToFloat Word32
w = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO (IO Float -> Float) -> IO Float -> Float
forall a b. (a -> b) -> a -> b
$ (Ptr Word32 -> IO Float) -> IO Float
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO Float) -> IO Float)
-> (Ptr Word32 -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \(Ptr Word32
ptr :: Ptr Word32) -> do
Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word32
ptr Word32
w
Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word32 -> Ptr Float
forall a b. Ptr a -> Ptr b
castPtr Ptr Word32
ptr)
{-# INLINE wordToDouble #-}
wordToDouble :: Word64 -> Double
wordToDouble :: Word64 -> Double
wordToDouble Word64
w = IO Double -> Double
forall a. IO a -> a
unsafeDupablePerformIO (IO Double -> Double) -> IO Double -> Double
forall a b. (a -> b) -> a -> b
$ (Ptr Word64 -> IO Double) -> IO Double
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word64 -> IO Double) -> IO Double)
-> (Ptr Word64 -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \(Ptr Word64
ptr :: Ptr Word64) -> do
Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word64
ptr Word64
w
Ptr Double -> IO Double
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word64 -> Ptr Double
forall a b. Ptr a -> Ptr b
castPtr Ptr Word64
ptr)