-- | Conversions from 'Double'.
module Unwitch.Convert.Double
  ( toFloat
  , toFixed
  , 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           Data.Fixed (Fixed, HasResolution)
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

-- | Lossy narrowing conversion, may lose precision.
toFloat :: Double -> Float
toFloat :: Double -> Float
toFloat = Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Converts a Double to a Fixed value. Rejects NaN and infinities.
toFixed :: (HasResolution a) => Double -> Either RationalErrors (Fixed a)
toFixed :: forall a.
HasResolution a =>
Double -> Either RationalErrors (Fixed a)
toFixed Double
double = do
  Rational
r <- Double -> Either RationalErrors Rational
toRational Double
double
  Fixed a -> Either RationalErrors (Fixed a)
forall a b. b -> Either a b
Right (Fixed a -> Either RationalErrors (Fixed a))
-> Fixed a -> Either RationalErrors (Fixed a)
forall a b. (a -> b) -> a -> b
$ Rational -> Fixed a
forall a. Fractional a => Rational -> a
Prelude.fromRational Rational
r

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 :: Double -> Either ViaIntegerErrors Int8
toInt8 :: Double -> Either ViaIntegerErrors Int8
toInt8 = (Integer -> Maybe Int8) -> Double -> Either ViaIntegerErrors Int8
forall a.
(Integer -> Maybe a) -> Double -> Either ViaIntegerErrors a
toViaInteger Integer -> Maybe Int8
Integer.toInt8

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

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

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

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

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

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

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

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

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

-- | Converts via 'Integer', fails if not a whole number, out of range, or negative.
toNatural :: Double -> Either ViaIntegerErrors Natural
toNatural :: Double -> Either ViaIntegerErrors Natural
toNatural Double
double = 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
$ Double -> Either IntegerErrors Integer
toInteger Double
double
  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 :: Double -> Either ViaIntegerErrors CInt
toCInt :: Double -> Either ViaIntegerErrors CInt
toCInt Double
x = Int32 -> CInt
CInt (Int32 -> CInt)
-> Either ViaIntegerErrors Int32 -> Either ViaIntegerErrors CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Either ViaIntegerErrors Int32
toInt32 Double
x
#endif

-- | Convert via 'Integer' then narrow, combining errors.
toViaInteger :: (Integer -> Maybe a) -> Double -> Either ViaIntegerErrors a
toViaInteger :: forall a.
(Integer -> Maybe a) -> Double -> Either ViaIntegerErrors a
toViaInteger Integer -> Maybe a
fun Double
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
$ Double -> Either IntegerErrors Integer
toInteger Double
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 :: Double -> Either IntegerErrors Integer
toInteger :: Double -> Either IntegerErrors Integer
toInteger Double
double = 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
$ Double -> Either RationalErrors Rational
toRational Double
double
  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
maxIntegralRepDouble -> 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
maxIntegralRepDouble -> 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 :: Double -> Either RationalErrors Rational
toRational :: Double -> Either RationalErrors Rational
toRational Double
double = if
  | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
double      -> RationalErrors -> Either RationalErrors Rational
forall a b. a -> Either a b
Left RationalErrors
IsNan
  | Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
double -> if
      | Double
double Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
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
$ Double -> Rational
forall a. Real a => a -> Rational
Prelude.toRational Double
double