-- | Conversions from 'Natural'.
module Unwitch.Convert.Natural
  ( -- * Conversions
    toWord8
  , toWord16
  , toWord32
  , toWord64
  , toWord
  , toInt8
  , toInt16
  , toInt32
  , toInt64
  , toInt
  , toInteger
  , toFloat
  , toDouble
#ifdef __GLASGOW_HASKELL__
  , toCInt
#endif
#ifdef __GLASGOW_HASKELL__
  -- * Unboxed conversions
  -- $unboxed
  , toWord8#
  , toWord16#
  , toWord32#
  , toWord64#
  , toWord#
  , toInt8#
  , toInt16#
  , toInt32#
  , toInt64#
  , toInt#
  , toFloat#
  , toDouble#
#endif
  )
where

import           Unwitch.Errors
import           Unwitch.Constant
import qualified Data.Bits as Bits
import           Data.Word
import           Data.Int
import           Numeric.Natural (Natural)
import           Prelude hiding (toInteger)
#ifdef __GLASGOW_HASKELL__
import           Foreign.C.Types (CInt(CInt))
import           GHC.Exts (Int(..), Word(..), Float(..), Double(..),
                           word2Int#,
                           wordToWord8#, word8ToWord#,
                           wordToWord16#, word16ToWord#,
                           wordToWord32#, word32ToWord#,
                           wordToWord64#,
                           intToInt8#,
                           intToInt16#,
                           intToInt32#,
                           intToInt64#,
                           int2Float#, int2Double#,
                           eqWord#, leWord#, (>=#))
import           GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..))
import           GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..))
import           GHC.Num.Natural (naturalToWordMaybe#)
#endif

#ifdef __GLASGOW_HASKELL__
-- $unboxed
-- These use GHC unboxed types and unboxed sums for zero-allocation
-- failure handling. Requires the @MagicHash@, @UnboxedSums@ and
-- @UnboxedTuples@ language extensions.
-- See the <https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/primitives.html GHC manual on unboxed types>.
#endif

toWord8 :: Natural -> Maybe Word8
toWord8 :: Natural -> Maybe Word8
toWord8 = Natural -> Maybe Word8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

toWord16 :: Natural -> Maybe Word16
toWord16 :: Natural -> Maybe Word16
toWord16 = Natural -> Maybe Word16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

toWord32 :: Natural -> Maybe Word32
toWord32 :: Natural -> Maybe Word32
toWord32 = Natural -> Maybe Word32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

toWord64 :: Natural -> Maybe Word64
toWord64 :: Natural -> Maybe Word64
toWord64 = Natural -> Maybe Word64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

toWord :: Natural -> Maybe Word
toWord :: Natural -> Maybe Word
toWord = Natural -> Maybe Word
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

toInt8 :: Natural -> Maybe Int8
toInt8 :: Natural -> Maybe Int8
toInt8 = Natural -> Maybe Int8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

toInt16 :: Natural -> Maybe Int16
toInt16 :: Natural -> Maybe Int16
toInt16 = Natural -> Maybe Int16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

toInt32 :: Natural -> Maybe Int32
toInt32 :: Natural -> Maybe Int32
toInt32 = Natural -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

toInt64 :: Natural -> Maybe Int64
toInt64 :: Natural -> Maybe Int64
toInt64 = Natural -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

toInt :: Natural -> Maybe Int
toInt :: Natural -> Maybe Int
toInt = Natural -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

toInteger :: Natural -> Integer
toInteger :: Natural -> Integer
toInteger = Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

#ifdef __GLASGOW_HASKELL__
-- | Narrowing conversion via Int32, fails if outside Int32 range.
toCInt :: Natural -> Maybe CInt
toCInt :: Natural -> Maybe CInt
toCInt Natural
x = Int32 -> CInt
CInt (Int32 -> CInt) -> Maybe Int32 -> Maybe CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Maybe Int32
toInt32 Natural
x
#endif

-- | Checked conversion, fails if outside exact float integer range (±16777215).
toFloat :: Natural -> Either Overflows Float
toFloat :: Natural -> Either Overflows Float
toFloat Natural
x = if
  | Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
forall a. Num a => a
maxIntegralRepFloat -> Overflows -> Either Overflows Float
forall a b. a -> Either a b
Left Overflows
Overflow
  | Bool
otherwise               -> Float -> Either Overflows Float
forall a b. b -> Either a b
Right (Float -> Either Overflows Float)
-> Float -> Either Overflows Float
forall a b. (a -> b) -> a -> b
$ Natural -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
x

-- | Checked conversion, fails if outside exact double integer range (±9007199254740991).
toDouble :: Natural -> Either Overflows Double
toDouble :: Natural -> Either Overflows Double
toDouble Natural
x = if
  | Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
forall a. Num a => a
maxIntegralRepDouble -> Overflows -> Either Overflows Double
forall a b. a -> Either a b
Left Overflows
Overflow
  | Bool
otherwise                -> Double -> Either Overflows Double
forall a b. b -> Either a b
Right (Double -> Either Overflows Double)
-> Double -> Either Overflows Double
forall a b. (a -> b) -> a -> b
$ Natural -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
x

#ifdef __GLASGOW_HASKELL__
-- | Via naturalToWordMaybe#, then narrow and roundtrip at Word#
toWord8# :: Natural -> (# Word8 | (# #) #)
toWord8# :: Natural -> (# Word8 | (# #) #)
toWord8# Natural
nat = case Natural -> (# (# #) | Word# #)
naturalToWordMaybe# Natural
nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | Word#
w# #) ->
    let n# :: Word8#
n# = Word# -> Word8#
wordToWord8# Word#
w#
    in case Word8# -> Word#
word8ToWord# Word8#
n# Word# -> Word# -> Int#
`eqWord#` Word#
w# of
      Int#
1# -> (# Word8# -> Word8
W8# Word8#
n# | #)
      Int#
_  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, then narrow
toWord16# :: Natural -> (# Word16 | (# #) #)
toWord16# :: Natural -> (# Word16 | (# #) #)
toWord16# Natural
nat = case Natural -> (# (# #) | Word# #)
naturalToWordMaybe# Natural
nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | Word#
w# #) ->
    let n# :: Word16#
n# = Word# -> Word16#
wordToWord16# Word#
w#
    in case Word16# -> Word#
word16ToWord# Word16#
n# Word# -> Word# -> Int#
`eqWord#` Word#
w# of
      Int#
1# -> (# Word16# -> Word16
W16# Word16#
n# | #)
      Int#
_  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, then narrow
toWord32# :: Natural -> (# Word32 | (# #) #)
toWord32# :: Natural -> (# Word32 | (# #) #)
toWord32# Natural
nat = case Natural -> (# (# #) | Word# #)
naturalToWordMaybe# Natural
nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | Word#
w# #) ->
    let n# :: Word32#
n# = Word# -> Word32#
wordToWord32# Word#
w#
    in case Word32# -> Word#
word32ToWord# Word32#
n# Word# -> Word# -> Int#
`eqWord#` Word#
w# of
      Int#
1# -> (# Word32# -> Word32
W32# Word32#
n# | #)
      Int#
_  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, then widen to Word64
toWord64# :: Natural -> (# Word64 | (# #) #)
toWord64# :: Natural -> (# Word64 | (# #) #)
toWord64# Natural
nat = case Natural -> (# (# #) | Word# #)
naturalToWordMaybe# Natural
nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | Word#
w# #) -> (# Word64# -> Word64
W64# (Word# -> Word64#
wordToWord64# Word#
w#) | #)

-- | Via naturalToWordMaybe#
toWord# :: Natural -> (# Word | (# #) #)
toWord# :: Natural -> (# Word | (# #) #)
toWord# Natural
nat = case Natural -> (# (# #) | Word# #)
naturalToWordMaybe# Natural
nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | Word#
w# #) -> (# Word# -> Word
W# Word#
w# | #)

-- | Via naturalToWordMaybe#, check upper bound for Int8
toInt8# :: Natural -> (# Int8 | (# #) #)
toInt8# :: Natural -> (# Int8 | (# #) #)
toInt8# Natural
nat = case Natural -> (# (# #) | Word# #)
naturalToWordMaybe# Natural
nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | Word#
w# #) -> case Word# -> Word# -> Int#
leWord# Word#
w# Word#
127## of
    Int#
1# -> (# Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# (Word# -> Int#
word2Int# Word#
w#)) | #)
    Int#
_  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, check upper bound for Int16
toInt16# :: Natural -> (# Int16 | (# #) #)
toInt16# :: Natural -> (# Int16 | (# #) #)
toInt16# Natural
nat = case Natural -> (# (# #) | Word# #)
naturalToWordMaybe# Natural
nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | Word#
w# #) -> case Word# -> Word# -> Int#
leWord# Word#
w# Word#
32767## of
    Int#
1# -> (# Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# (Word# -> Int#
word2Int# Word#
w#)) | #)
    Int#
_  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, check upper bound for Int32
toInt32# :: Natural -> (# Int32 | (# #) #)
toInt32# :: Natural -> (# Int32 | (# #) #)
toInt32# Natural
nat = case Natural -> (# (# #) | Word# #)
naturalToWordMaybe# Natural
nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | Word#
w# #) -> case Word# -> Word# -> Int#
leWord# Word#
w# Word#
2147483647## of
    Int#
1# -> (# Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# (Word# -> Int#
word2Int# Word#
w#)) | #)
    Int#
_  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, check fits in non-negative Int64
toInt64# :: Natural -> (# Int64 | (# #) #)
toInt64# :: Natural -> (# Int64 | (# #) #)
toInt64# Natural
nat = case Natural -> (# (# #) | Word# #)
naturalToWordMaybe# Natural
nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | Word#
w# #) ->
    let i# :: Int#
i# = Word# -> Int#
word2Int# Word#
w#
    in case Int#
i# Int# -> Int# -> Int#
>=# Int#
0# of
      Int#
1# -> (# Int64# -> Int64
I64# (Int# -> Int64#
intToInt64# Int#
i#) | #)
      Int#
_  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, check fits in non-negative Int
toInt# :: Natural -> (# Int | (# #) #)
toInt# :: Natural -> (# Int | (# #) #)
toInt# Natural
nat = case Natural -> (# (# #) | Word# #)
naturalToWordMaybe# Natural
nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | Word#
w# #) ->
    let i# :: Int#
i# = Word# -> Int#
word2Int# Word#
w#
    in case Int#
i# Int# -> Int# -> Int#
>=# Int#
0# of
      Int#
1# -> (# Int# -> Int
I# Int#
i# | #)
      Int#
_  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, bounds-checked float
toFloat# :: Natural -> (# Overflows | Float #)
toFloat# :: Natural -> (# Overflows | Float #)
toFloat# Natural
nat = case Natural -> (# (# #) | Word# #)
naturalToWordMaybe# Natural
nat of
  (# (# #) | #) -> (# Overflows
Overflow | #)
  (# | Word#
w# #) -> case Word# -> Word# -> Int#
leWord# Word#
w# Word#
16777215## of
    Int#
1# -> (# | Float# -> Float
F# (Int# -> Float#
int2Float# (Word# -> Int#
word2Int# Word#
w#)) #)
    Int#
_  -> (# Overflows
Overflow | #)

-- | Via naturalToWordMaybe#, bounds-checked double
toDouble# :: Natural -> (# Overflows | Double #)
toDouble# :: Natural -> (# Overflows | Double #)
toDouble# Natural
nat = case Natural -> (# (# #) | Word# #)
naturalToWordMaybe# Natural
nat of
  (# (# #) | #) -> (# Overflows
Overflow | #)
  (# | Word#
w# #) -> case Word# -> Word# -> Int#
leWord# Word#
w# Word#
9007199254740991## of
    Int#
1# -> (# | Double# -> Double
D# (Int# -> Double#
int2Double# (Word# -> Int#
word2Int# Word#
w#)) #)
    Int#
_  -> (# Overflows
Overflow | #)
#endif