Functora.Round fix for non-positive numbers

Author: functora

pub/functora/src/round/Functora/Round.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE MultiWayIf #-}
+
 -- |
 -- Module: Functora.Round
 --
@@ -132,12 +134,15 @@ dpRound n f
 -- 0 % 1
 sdRound :: (RealFrac a) => Natural -> a -> a
 sdRound sd' f =
-  if m < 0
-    then dpRound sd gZ / 10 ^^ pZ
-    else case compare n 0 of
-      EQ -> dpRound n f
-      GT -> dpRound n f
-      LT -> 10 ^^ p * fromInteger (round g)
+  if
+    | f == 0 -> f
+    | f < 0 -> negate . sdRound sd' $ abs f
+    | m < 0 -> dpRound sd gZ / 10 ^^ pZ
+    | otherwise ->
+        case compare n 0 of
+          EQ -> dpRound n f
+          GT -> dpRound n f
+          LT -> 10 ^^ p * fromInteger (round g)
   where
     sd = toInteger sd'
 

pub/functora/src/test/Functora/RoundSpec.hs

@@ -4,7 +4,7 @@ import Data.Fixed (E12, Fixed)
 --
 -- NOTE : Round functions will fail for FixNonNeg because of impl details.
 --
-import Functora.Prelude (Fix, throw, throwString, try)
+import Functora.Prelude (E30, Fix, throw, throwString, try)
 import Functora.Round (dpRound, sdRound)
 import Numeric.Natural (Natural)
 import System.Exit (ExitCode (..))
@@ -29,12 +29,14 @@ spec = do
         "src/round/Functora/Round.hs"
       ]
 
-  mkRoundSpec @(Fixed E12) "dpRound/Fixed" dpRound dpRoundTestData
+  mkRoundSpec @(Fixed E30) "dpRound/Fixed/E30" dpRound dpRoundTestData
+  mkRoundSpec @(Fixed E12) "dpRound/Fixed/E12" dpRound dpRoundTestData
   mkRoundSpec @Rational "dpRound/Rational" dpRound dpRoundTestData
   mkRoundSpec @Double "dpRound/Double" dpRound dpRoundTestData
   mkRoundSpec @Fix "dpRound/Fix" dpRound dpRoundTestData
 
-  mkRoundSpec @(Fixed E12) "sdRound/Fixed" sdRound sdRoundTestData
+  mkRoundSpec @(Fixed E30) "sdRound/Fixed/E30" sdRound sdRoundTestData
+  mkRoundSpec @(Fixed E12) "sdRound/Fixed/E12" sdRound sdRoundTestData
   mkRoundSpec @Rational "sdRound/Rational" sdRound sdRoundTestData
   mkRoundSpec @Double "sdRound/Double" sdRound sdRoundTestData
   mkRoundSpec @Fix "sdRound/Fix" sdRound sdRoundTestData
@@ -173,7 +175,54 @@ dpRoundTestData =
     (6, 1.23456789, 1.234568),
     (6, 0.123456789, 0.123457),
     (6, 0.0123456789, 0.012346),
-    (6, 0.00123456789, 0.001235)
+    (6, 0.00123456789, 0.001235),
+    (6, 0, 0),
+    (2, -123456789.0, -123456789.0),
+    (2, -1234.56789, -1234.57),
+    (2, -123.456789, -123.46),
+    (2, -12.3456789, -12.35),
+    (2, -1.23456789, -1.23),
+    (2, -0.123456789, -0.12),
+    (2, -0.0123456789, -0.01),
+    (2, -0.00123456789, -0.00),
+    (3, -123456789.0, -123456789.0),
+    (3, -1234.56789, -1234.568),
+    (3, -123.456789, -123.457),
+    (3, -12.3456789, -12.346),
+    (3, -1.23456789, -1.235),
+    (3, -0.123456789, -0.123),
+    (3, -0.0123456789, -0.012),
+    (3, -0.00123456789, -0.001),
+    (3, -0.000123456789, -0.000),
+    (4, -123456789.0, -123456789.0),
+    (4, -1234.56789, -1234.5679),
+    (4, -123.456789, -123.4568),
+    (4, -12.3456789, -12.3457),
+    (4, -1.23456789, -1.2346),
+    (4, -0.123456789, -0.1235),
+    (4, -0.0123456789, -0.0123),
+    (4, -0.00123456789, -0.0012),
+    (4, -0.000123456789, -0.0001),
+    (4, -0.0000123456789, -0.0000),
+    (5, -123456789.0, -123456789.0),
+    (5, -1234.56789, -1234.56789),
+    (5, -123.456789, -123.45679),
+    (5, -12.3456789, -12.34568),
+    (5, -1.23456789, -1.23457),
+    (5, -0.123456789, -0.12346),
+    (5, -0.0123456789, -0.01235),
+    (5, -0.00123456789, -0.00123),
+    (5, -0.000123456789, -0.00012),
+    (5, -0.0000123456789, -0.00001),
+    (5, -0.00000123456789, -0.0),
+    (6, -123456789.0, -123456789.0),
+    (6, -1234.56789, -1234.56789),
+    (6, -123.456789, -123.456789),
+    (6, -12.3456789, -12.345679),
+    (6, -1.23456789, -1.234568),
+    (6, -0.123456789, -0.123457),
+    (6, -0.0123456789, -0.012346),
+    (6, -0.00123456789, -0.001235)
   ]
 
 -- | Every element is a tuple (significantDigits, beforeRound, afterRound)
@@ -211,5 +260,39 @@ sdRoundTestData =
     (7, 123.456789, 123.4568),
     (7, 12.3456789, 12.34568),
     (7, 1.23456789, 1.234568),
-    (7, 0.123456789, 0.1234568)
+    (7, 0.123456789, 0.1234568),
+    (7, 0, 0),
+    (4, -123456789.0, -123500000.0),
+    (4, -1234.56789, -1235.0),
+    (4, -123.456789, -123.5),
+    (4, -12.3456789, -12.35),
+    (4, -1.23456789, -1.235),
+    (4, -0.123456789, -0.1235),
+    (4, -0.0123456789, -0.01235),
+    (4, -0.00123456789, -0.001235),
+    (4, -0.000123456789, -0.0001235),
+    (5, -123456789.0, -123460000.0),
+    (5, -1234.56789, -1234.6),
+    (5, -123.456789, -123.46),
+    (5, -12.3456789, -12.346),
+    (5, -1.23456789, -1.2346),
+    (5, -0.123456789, -0.12346),
+    (5, -0.0123456789, -0.012346),
+    (5, -0.00123456789, -0.0012346),
+    (5, -0.000123456789, -0.00012346),
+    (6, -123456789.0, -123457000.0),
+    (6, -1234.56789, -1234.57),
+    (6, -123.456789, -123.457),
+    (6, -12.3456789, -12.3457),
+    (6, -1.23456789, -1.23457),
+    (6, -0.123456789, -0.123457),
+    (6, -0.0123456789, -0.0123457),
+    (6, -0.00123456789, -0.00123457),
+    (6, -0.000123456789, -0.000123457),
+    (7, -123456789.0, -123456800.0),
+    (7, -1234.56789, -1234.568),
+    (7, -123.456789, -123.4568),
+    (7, -12.3456789, -12.34568),
+    (7, -1.23456789, -1.234568),
+    (7, -0.123456789, -0.1234568)
   ]