-- | Conversions from 'Float'.
module Unwitch.Convert.Float
  ( toDouble
  , toRational
  , toInteger
  , toInt8
  , toInt16
  , toInt32
  , toInt64
  , toInt
  , toWord8
  , toWord16
  , toWord32
  , toWord64
  , toWord
  , toNatural
#ifdef __GLASGOW_HASKELL__
  , toCInt
#endif
  , ViaIntegerErrors(..)
  , IntegerErrors(..)
  , RationalErrors(..)
  )
where

import           Data.Bifunctor(first)
import           Unwitch.Constant
import           Unwitch.Convert.Ratio(unwrapIfDenominatorOne)
import qualified Prelude
import           Unwitch.Errors
import           Prelude hiding (toRational, toInteger)
import qualified Unwitch.Convert.Integer as Integer
import Data.Word
import Data.Int
import Numeric.Natural (Natural)
#ifdef __GLASGOW_HASKELL__
import Foreign.C.Types (CInt(CInt))
#endif

toDouble :: Float -> Double
toDouble :: Float -> Double
toDouble = Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

data IntegerErrors = IntegerFlow Integer Overflows
                   | RationalConversion RationalErrors
                   | DenomNotOne Rational
  deriving (Int -> IntegerErrors -> ShowS
[IntegerErrors] -> ShowS
IntegerErrors -> String
(Int -> IntegerErrors -> ShowS)
-> (IntegerErrors -> String)
-> ([IntegerErrors] -> ShowS)
-> Show IntegerErrors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntegerErrors -> ShowS
showsPrec :: Int -> IntegerErrors -> ShowS
$cshow :: IntegerErrors -> String
show :: IntegerErrors -> String
$cshowList :: [IntegerErrors] -> ShowS
showList :: [IntegerErrors] -> ShowS
Show, IntegerErrors -> IntegerErrors -> Bool
(IntegerErrors -> IntegerErrors -> Bool)
-> (IntegerErrors -> IntegerErrors -> Bool) -> Eq IntegerErrors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntegerErrors -> IntegerErrors -> Bool
== :: IntegerErrors -> IntegerErrors -> Bool
$c/= :: IntegerErrors -> IntegerErrors -> Bool
/= :: IntegerErrors -> IntegerErrors -> Bool
Eq)

data ViaIntegerErrors = MkInteger IntegerErrors
                      | BitConversionFailed Integer
  deriving (Int -> ViaIntegerErrors -> ShowS
[ViaIntegerErrors] -> ShowS
ViaIntegerErrors -> String
(Int -> ViaIntegerErrors -> ShowS)
-> (ViaIntegerErrors -> String)
-> ([ViaIntegerErrors] -> ShowS)
-> Show ViaIntegerErrors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ViaIntegerErrors -> ShowS
showsPrec :: Int -> ViaIntegerErrors -> ShowS
$cshow :: ViaIntegerErrors -> String
show :: ViaIntegerErrors -> String
$cshowList :: [ViaIntegerErrors] -> ShowS
showList :: [ViaIntegerErrors] -> ShowS
Show, ViaIntegerErrors -> ViaIntegerErrors -> Bool
(ViaIntegerErrors -> ViaIntegerErrors -> Bool)
-> (ViaIntegerErrors -> ViaIntegerErrors -> Bool)
-> Eq ViaIntegerErrors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ViaIntegerErrors -> ViaIntegerErrors -> Bool
== :: ViaIntegerErrors -> ViaIntegerErrors -> Bool
$c/= :: ViaIntegerErrors -> ViaIntegerErrors -> Bool
/= :: ViaIntegerErrors -> ViaIntegerErrors -> Bool
Eq)

-- | Converts via 'Integer', fails if not a whole number or out of range.
toInt8 :: Float -> Either ViaIntegerErrors Int8
toInt8 :: Float -> Either ViaIntegerErrors Int8
toInt8 = (Integer -> Maybe Int8) -> Float -> Either ViaIntegerErrors Int8
forall a.
(Integer -> Maybe a) -> Float -> Either ViaIntegerErrors a
toViaInteger Integer -> Maybe Int8
Integer.toInt8


-- | Converts via 'Integer', fails if not a whole number or out of range.
toInt16 :: Float -> Either ViaIntegerErrors Int16
toInt16 :: Float -> Either ViaIntegerErrors Int16
toInt16 = (Integer -> Maybe Int16) -> Float -> Either ViaIntegerErrors Int16
forall a.
(Integer -> Maybe a) -> Float -> Either ViaIntegerErrors a
toViaInteger Integer -> Maybe Int16
Integer.toInt16


-- | Converts via 'Integer', fails if not a whole number or out of range.
toInt32 :: Float -> Either ViaIntegerErrors Int32
toInt32 :: Float -> Either ViaIntegerErrors Int32
toInt32 = (Integer -> Maybe Int32) -> Float -> Either ViaIntegerErrors Int32
forall a.
(Integer -> Maybe a) -> Float -> Either ViaIntegerErrors a
toViaInteger Integer -> Maybe Int32
Integer.toInt32


-- | Converts via 'Integer', fails if not a whole number or out of range.
toInt64 :: Float -> Either ViaIntegerErrors Int64
toInt64 :: Float -> Either ViaIntegerErrors Int64
toInt64 = (Integer -> Maybe Int64) -> Float -> Either ViaIntegerErrors Int64
forall a.
(Integer -> Maybe a) -> Float -> Either ViaIntegerErrors a
toViaInteger Integer -> Maybe Int64
Integer.toInt64


-- | Converts via 'Integer', fails if not a whole number or out of range.
toInt :: Float -> Either ViaIntegerErrors Int
toInt :: Float -> Either ViaIntegerErrors Int
toInt = (Integer -> Maybe Int) -> Float -> Either ViaIntegerErrors Int
forall a.
(Integer -> Maybe a) -> Float -> Either ViaIntegerErrors a
toViaInteger Integer -> Maybe Int
Integer.toInt


-- | Converts via 'Integer', fails if not a whole number or out of range.
toWord8 :: Float -> Either ViaIntegerErrors Word8
toWord8 :: Float -> Either ViaIntegerErrors Word8
toWord8 = (Integer -> Maybe Word8) -> Float -> Either ViaIntegerErrors Word8
forall a.
(Integer -> Maybe a) -> Float -> Either ViaIntegerErrors a
toViaInteger Integer -> Maybe Word8
Integer.toWord8


-- | Converts via 'Integer', fails if not a whole number or out of range.
toWord16 :: Float -> Either ViaIntegerErrors Word16
toWord16 :: Float -> Either ViaIntegerErrors Word16
toWord16 = (Integer -> Maybe Word16)
-> Float -> Either ViaIntegerErrors Word16
forall a.
(Integer -> Maybe a) -> Float -> Either ViaIntegerErrors a
toViaInteger Integer -> Maybe Word16
Integer.toWord16

-- | Converts via 'Integer', fails if not a whole number or out of range.
toWord32 :: Float -> Either ViaIntegerErrors Word32
toWord32 :: Float -> Either ViaIntegerErrors Word32
toWord32 = (Integer -> Maybe Word32)
-> Float -> Either ViaIntegerErrors Word32
forall a.
(Integer -> Maybe a) -> Float -> Either ViaIntegerErrors a
toViaInteger Integer -> Maybe Word32
Integer.toWord32

-- | Converts via 'Integer', fails if not a whole number or out of range.
toWord64 :: Float -> Either ViaIntegerErrors Word64
toWord64 :: Float -> Either ViaIntegerErrors Word64
toWord64 = (Integer -> Maybe Word64)
-> Float -> Either ViaIntegerErrors Word64
forall a.
(Integer -> Maybe a) -> Float -> Either ViaIntegerErrors a
toViaInteger Integer -> Maybe Word64
Integer.toWord64

-- | Converts via 'Integer', fails if not a whole number or out of range.
toWord :: Float -> Either ViaIntegerErrors Word
toWord :: Float -> Either ViaIntegerErrors Word
toWord = (Integer -> Maybe Word) -> Float -> Either ViaIntegerErrors Word
forall a.
(Integer -> Maybe a) -> Float -> Either ViaIntegerErrors a
toViaInteger Integer -> Maybe Word
Integer.toWord

-- | Converts via 'Integer', fails if not a whole number, out of range, or negative.
toNatural :: Float -> Either ViaIntegerErrors Natural
toNatural :: Float -> Either ViaIntegerErrors Natural
toNatural Float
float = do
  Integer
integer <- (IntegerErrors -> ViaIntegerErrors)
-> Either IntegerErrors Integer -> Either ViaIntegerErrors Integer
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first IntegerErrors -> ViaIntegerErrors
MkInteger (Either IntegerErrors Integer -> Either ViaIntegerErrors Integer)
-> Either IntegerErrors Integer -> Either ViaIntegerErrors Integer
forall a b. (a -> b) -> a -> b
$ Float -> Either IntegerErrors Integer
toInteger Float
float
  case Integer -> Either Overflows Natural
Integer.toNatural Integer
integer of
    Left Overflows
err -> ViaIntegerErrors -> Either ViaIntegerErrors Natural
forall a b. a -> Either a b
Left (ViaIntegerErrors -> Either ViaIntegerErrors Natural)
-> ViaIntegerErrors -> Either ViaIntegerErrors Natural
forall a b. (a -> b) -> a -> b
$ IntegerErrors -> ViaIntegerErrors
MkInteger (IntegerErrors -> ViaIntegerErrors)
-> IntegerErrors -> ViaIntegerErrors
forall a b. (a -> b) -> a -> b
$ Integer -> Overflows -> IntegerErrors
IntegerFlow Integer
integer Overflows
err
    Right Natural
n -> Natural -> Either ViaIntegerErrors Natural
forall a b. b -> Either a b
Right Natural
n

#ifdef __GLASGOW_HASKELL__
-- | Converts via 'Integer', fails if not a whole number or out of range.
toCInt :: Float -> Either ViaIntegerErrors CInt
toCInt :: Float -> Either ViaIntegerErrors CInt
toCInt Float
x = Int32 -> CInt
CInt (Int32 -> CInt)
-> Either ViaIntegerErrors Int32 -> Either ViaIntegerErrors CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> Either ViaIntegerErrors Int32
toInt32 Float
x
#endif

-- | Convert via 'Integer' then narrow, combining errors.
toViaInteger :: (Integer -> Maybe a) -> Float -> Either ViaIntegerErrors a
toViaInteger :: forall a.
(Integer -> Maybe a) -> Float -> Either ViaIntegerErrors a
toViaInteger Integer -> Maybe a
fun Float
x = do
  Integer
integer <- (IntegerErrors -> ViaIntegerErrors)
-> Either IntegerErrors Integer -> Either ViaIntegerErrors Integer
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first IntegerErrors -> ViaIntegerErrors
MkInteger (Either IntegerErrors Integer -> Either ViaIntegerErrors Integer)
-> Either IntegerErrors Integer -> Either ViaIntegerErrors Integer
forall a b. (a -> b) -> a -> b
$ Float -> Either IntegerErrors Integer
toInteger Float
x
  Either ViaIntegerErrors a
-> (a -> Either ViaIntegerErrors a)
-> Maybe a
-> Either ViaIntegerErrors a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ViaIntegerErrors -> Either ViaIntegerErrors a
forall a b. a -> Either a b
Left (ViaIntegerErrors -> Either ViaIntegerErrors a)
-> ViaIntegerErrors -> Either ViaIntegerErrors a
forall a b. (a -> b) -> a -> b
$ Integer -> ViaIntegerErrors
BitConversionFailed Integer
integer) a -> Either ViaIntegerErrors a
forall a b. b -> Either a b
Right (Maybe a -> Either ViaIntegerErrors a)
-> Maybe a -> Either ViaIntegerErrors a
forall a b. (a -> b) -> a -> b
$ Integer -> Maybe a
fun Integer
integer

-- | Converts to 'Integer', fails if NaN, infinite, or has a fractional part.
toInteger :: Float -> Either IntegerErrors Integer
toInteger :: Float -> Either IntegerErrors Integer
toInteger Float
float = do
  Rational
rational <- (RationalErrors -> IntegerErrors)
-> Either RationalErrors Rational -> Either IntegerErrors Rational
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first RationalErrors -> IntegerErrors
RationalConversion (Either RationalErrors Rational -> Either IntegerErrors Rational)
-> Either RationalErrors Rational -> Either IntegerErrors Rational
forall a b. (a -> b) -> a -> b
$ Float -> Either RationalErrors Rational
toRational Float
float
  Integer
integer <- Either IntegerErrors Integer
-> (Integer -> Either IntegerErrors Integer)
-> Maybe Integer
-> Either IntegerErrors Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IntegerErrors -> Either IntegerErrors Integer
forall a b. a -> Either a b
Left (IntegerErrors -> Either IntegerErrors Integer)
-> IntegerErrors -> Either IntegerErrors Integer
forall a b. (a -> b) -> a -> b
$ Rational -> IntegerErrors
DenomNotOne Rational
rational) Integer -> Either IntegerErrors Integer
forall a b. b -> Either a b
Right (Maybe Integer -> Either IntegerErrors Integer)
-> Maybe Integer -> Either IntegerErrors Integer
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe Integer
forall a. (Eq a, Num a) => Ratio a -> Maybe a
unwrapIfDenominatorOne Rational
rational
  if
    | Integer
integer Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< -Integer
forall a. Num a => a
maxIntegralRepFloat -> IntegerErrors -> Either IntegerErrors Integer
forall a b. a -> Either a b
Left (IntegerErrors -> Either IntegerErrors Integer)
-> IntegerErrors -> Either IntegerErrors Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Overflows -> IntegerErrors
IntegerFlow Integer
integer Overflows
Underflow
    | Integer
integer Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
forall a. Num a => a
maxIntegralRepFloat -> IntegerErrors -> Either IntegerErrors Integer
forall a b. a -> Either a b
Left (IntegerErrors -> Either IntegerErrors Integer)
-> IntegerErrors -> Either IntegerErrors Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Overflows -> IntegerErrors
IntegerFlow Integer
integer Overflows
Overflow
    | Bool
otherwise -> Integer -> Either IntegerErrors Integer
forall a b. b -> Either a b
Right Integer
integer

data RationalErrors = IsNan
                    | IsInf Overflows
  deriving (Int -> RationalErrors -> ShowS
[RationalErrors] -> ShowS
RationalErrors -> String
(Int -> RationalErrors -> ShowS)
-> (RationalErrors -> String)
-> ([RationalErrors] -> ShowS)
-> Show RationalErrors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RationalErrors -> ShowS
showsPrec :: Int -> RationalErrors -> ShowS
$cshow :: RationalErrors -> String
show :: RationalErrors -> String
$cshowList :: [RationalErrors] -> ShowS
showList :: [RationalErrors] -> ShowS
Show, RationalErrors -> RationalErrors -> Bool
(RationalErrors -> RationalErrors -> Bool)
-> (RationalErrors -> RationalErrors -> Bool) -> Eq RationalErrors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RationalErrors -> RationalErrors -> Bool
== :: RationalErrors -> RationalErrors -> Bool
$c/= :: RationalErrors -> RationalErrors -> Bool
/= :: RationalErrors -> RationalErrors -> Bool
Eq)

toRational :: Float -> Either RationalErrors Rational
toRational :: Float -> Either RationalErrors Rational
toRational Float
float = if
  | Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
float      -> RationalErrors -> Either RationalErrors Rational
forall a b. a -> Either a b
Left RationalErrors
IsNan
  | Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
float -> if
      | Float
float Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 -> RationalErrors -> Either RationalErrors Rational
forall a b. a -> Either a b
Left (RationalErrors -> Either RationalErrors Rational)
-> RationalErrors -> Either RationalErrors Rational
forall a b. (a -> b) -> a -> b
$ Overflows -> RationalErrors
IsInf Overflows
Overflow
      | Bool
otherwise  -> RationalErrors -> Either RationalErrors Rational
forall a b. a -> Either a b
Left (RationalErrors -> Either RationalErrors Rational)
-> RationalErrors -> Either RationalErrors Rational
forall a b. (a -> b) -> a -> b
$ Overflows -> RationalErrors
IsInf Overflows
Underflow
  | Bool
True              -> Rational -> Either RationalErrors Rational
forall a b. b -> Either a b
Right (Rational -> Either RationalErrors Rational)
-> Rational -> Either RationalErrors Rational
forall a b. (a -> b) -> a -> b
$ Float -> Rational
forall a. Real a => a -> Rational
Prelude.toRational Float
float