tfausak/witch
1
1
Fork 0
mirror of https://github.com/tfausak/witch.git synced 2024-11-22 14:58:13 +03:00
Code Issues Packages Projects Releases Wiki Activity

Fix floating point conversions

Browse Source 
Fixes #39.
This commit is contained in:
Taylor Fausak 2021-11-18 10:39:07 -05:00
parent d312023851
commit 96578de113
2 changed files with 32 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
src/lib/Witch/Instances.hs
View File

@ -17,6 +17,7 @@ import qualified Data.Foldable as Foldable
import qualified Data.Int as Int
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import qualified Data.Ratio as Ratio
@ -32,6 +33,7 @@ import qualified Data.Time.Clock.System as Time
import qualified Data.Time.Clock.TAI as Time
import qualified Data.Word as Word
import qualified GHC.Float as Float
import qualified Numeric
import qualified Numeric.Natural as Natural
import qualified Witch.From as From
import qualified Witch.TryFrom as TryFrom
@ -810,11 +812,7 @@ instance TryFrom.TryFrom Float Natural.Natural where
-- | Uses 'toRational' when the input is not NaN or infinity.
instance TryFrom.TryFrom Float Rational where
tryFrom = Utility.eitherTryFrom $ \s -> if isNaN s
then Left Exception.LossOfPrecision
else if isInfinite s
then if s > 0 then Left Exception.Overflow else Left Exception.Underflow
else Right $ toRational s
tryFrom = Utility.eitherTryFrom realFloatToRational
-- | Uses 'Float.float2Double'.
instance From.From Float Double where
@ -878,11 +876,7 @@ instance TryFrom.TryFrom Double Natural.Natural where
-- | Uses 'toRational' when the input is not NaN or infinity.
instance TryFrom.TryFrom Double Rational where
tryFrom = Utility.eitherTryFrom $ \s -> if isNaN s
then Left Exception.LossOfPrecision
else if isInfinite s
then if s > 0 then Left Exception.Overflow else Left Exception.Underflow
else Right $ toRational s
tryFrom = Utility.eitherTryFrom realFloatToRational
-- | Uses 'Float.double2Float'. This necessarily loses some precision.
instance From.From Double Float where
@ -1249,6 +1243,26 @@ instance From.From Time.NominalDiffTime Time.CalendarDiffTime where
instance From.From Time.ZonedTime Time.UTCTime where
from = Time.zonedTimeToUTC
--
realFloatToRational :: RealFloat s => s -> Either Exception.ArithException Rational
realFloatToRational s
| isNaN s = Left Exception.LossOfPrecision
| isInfinite s = if s > 0 then Left Exception.Overflow else Left Exception.Underflow
| otherwise = Right $ overPositive (uncurry makeRational . uncurry fromDigits . Numeric.floatToDigits 10) s
overPositive :: (Eq a, Num a, Num b) => (a -> b) -> a -> b
overPositive f x = if signum x == -1 then -(f (-x)) else f x
fromDigits :: [Int] -> Int -> (Int, Int)
fromDigits ds e = List.foldl'
(\ (a, n) d -> (a * 10 + d, n - 1))
(0, e)
ds
makeRational :: Int -> Int -> Rational
makeRational d e = toRational d * 10 ^^ toInteger e
fromNonNegativeIntegral
:: (Integral s, Num t) => s -> Either Exception.ArithException t
fromNonNegativeIntegral x =

8
src/test/Main.hs
View File

@ -1266,6 +1266,8 @@ main = runTestTTAndExit $ "Witch" ~:
, f (0 / 0) ~?= Nothing
, f (1 / 0) ~?= Nothing
, f (-1 / 0) ~?= Nothing
, f 0.1 ~?= Just 0.1
, f (-0.1) ~?= Just (-0.1)
]
, "From Float Double" ~:
let f = Witch.from @Float @Double in
@ -1418,6 +1420,8 @@ main = runTestTTAndExit $ "Witch" ~:
, f (0 / 0) ~?= Nothing
, f (1 / 0) ~?= Nothing
, f (-1 / 0) ~?= Nothing
, f 0.1 ~?= Just 0.1
, f (-0.1) ~?= Just (-0.1)
]
, "From Double Float" ~:
let f = Witch.from @Double @Float in
@ -1448,12 +1452,16 @@ main = runTestTTAndExit $ "Witch" ~:
[ f 0 ~?= 0
, f 0.5 ~?= 0.5
, f (-0.5) ~?= (-0.5)
, f 0.1 ~?= 0.1
, f (-0.1) ~?= (-0.1)
]
, "From Rational Double" ~:
let f = Witch.from @Rational @Double in
[ f 0 ~?= 0
, f 0.5 ~?= 0.5
, f (-0.5) ~?= (-0.5)
, f 0.1 ~?= 0.1
, f (-0.1) ~?= (-0.1)
]
, "TryFrom Rational (Fixed a)" ~:
let f = hush . Witch.tryFrom @Rational @Fixed.Deci in