{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Trustworthy      #-}

-- | This module was written based on
--   <http://hackage.haskell.org/package/reinterpret-cast-0.1.0/docs/src/Data-ReinterpretCast-Internal-ImplArray.html>.
--
--   Implements casting via a 1-elemnt STUArray, as described in
--   <http://stackoverflow.com/a/7002812/263061>.
module Util.FloatCast
    ( floatToWord
    , wordToFloat
    , doubleToWord
    , wordToDouble
    ) where

import           Data.Word         ( Word32, Word64 )
import           Data.Array.ST     ( MArray, STUArray, newArray, readArray )
import           Data.Array.Unsafe ( castSTUArray )
import           GHC.ST            ( ST, runST )

-- | Reinterpret-casts a `Float` to a `Word32`.
floatToWord :: Float -> Word32
floatToWord :: Float -> Word32
floatToWord Float
x = (forall s. ST s Word32) -> Word32
forall a. (forall s. ST s a) -> a
runST (Float -> ST s Word32
forall s a b.
(MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) =>
a -> ST s b
cast Float
x)

{-# INLINE floatToWord #-}

-- | Reinterpret-casts a `Word32` to a `Float`.
wordToFloat :: Word32 -> Float
wordToFloat :: Word32 -> Float
wordToFloat Word32
x = (forall s. ST s Float) -> Float
forall a. (forall s. ST s a) -> a
runST (Word32 -> ST s Float
forall s a b.
(MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) =>
a -> ST s b
cast Word32
x)

{-# INLINE wordToFloat #-}

-- | Reinterpret-casts a `Double` to a `Word64`.
doubleToWord :: Double -> Word64
doubleToWord :: Double -> Word64
doubleToWord Double
x = (forall s. ST s Word64) -> Word64
forall a. (forall s. ST s a) -> a
runST (Double -> ST s Word64
forall s a b.
(MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) =>
a -> ST s b
cast Double
x)

{-# INLINE doubleToWord #-}

-- | Reinterpret-casts a `Word64` to a `Double`.
wordToDouble :: Word64 -> Double
wordToDouble :: Word64 -> Double
wordToDouble Word64
x = (forall s. ST s Double) -> Double
forall a. (forall s. ST s a) -> a
runST (Word64 -> ST s Double
forall s a b.
(MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) =>
a -> ST s b
cast Word64
x)

{-# INLINE wordToDouble #-}

cast :: (MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) => a -> ST s b
cast :: a -> ST s b
cast a
x = (Int, Int) -> a -> ST s (STUArray s Int a)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0 :: Int, Int
0) a
x ST s (STUArray s Int a)
-> (STUArray s Int a -> ST s (STUArray s Int b))
-> ST s (STUArray s Int b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STUArray s Int a -> ST s (STUArray s Int b)
forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
castSTUArray ST s (STUArray s Int b) -> (STUArray s Int b -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (STUArray s Int b -> Int -> ST s b)
-> Int -> STUArray s Int b -> ST s b
forall a b c. (a -> b -> c) -> b -> a -> c
flip STUArray s Int b -> Int -> ST s b
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Int
0

{-# INLINE cast #-}