Fixed point numbers wip

Author: functora

pub/functora/src/prelude/Functora/Prelude.hs

@@ -119,6 +119,12 @@ module Functora.Prelude
     dropAround,
     dropWhileEnd,
     AscOrDesc (..),
+
+    -- * FixedPoint
+    -- $fixedPoint
+    Fix (..),
+    FixNonNeg,
+    mkFixNonNeg,
     E30,
 
     -- * DerivingVia
@@ -1152,11 +1158,70 @@ data AscOrDesc
       Bounded
     )
 
+-- $fixedPoint
+-- Fixed point numbers.
+
 data E30
 
 instance HasResolution E30 where
   resolution = const 1_0000000000_0000000000_0000000000
 
+newtype Fix = Fix
+  { unFix :: Fixed E30
+  }
+  deriving stock
+    ( Eq,
+      Ord,
+      Show,
+      Data,
+      Generic
+    )
+  deriving newtype
+    ( Num,
+      Real,
+      Fractional,
+      RealFrac
+    )
+
+newtype FixNonNeg = FixNonNeg
+  { unFixNonNeg :: Fixed E30
+  }
+  deriving stock
+    ( Eq,
+      Ord,
+      Show,
+      Data,
+      Generic
+    )
+
+mkFixNonNeg :: Fixed E30 -> FixNonNeg
+mkFixNonNeg x =
+  if x >= 0
+    then FixNonNeg x
+    else error $ "Underflow " <> inspect x
+
+instance Num FixNonNeg where
+  lhs + rhs = mkFixNonNeg $ unFixNonNeg lhs + unFixNonNeg rhs
+  lhs - rhs = mkFixNonNeg $ unFixNonNeg lhs - unFixNonNeg rhs
+  lhs * rhs = mkFixNonNeg $ unFixNonNeg lhs * unFixNonNeg rhs
+  negate = mkFixNonNeg . negate . unFixNonNeg
+  abs = mkFixNonNeg . abs . unFixNonNeg
+  signum = mkFixNonNeg . signum . unFixNonNeg
+  fromInteger = mkFixNonNeg . Prelude.fromInteger @(Fixed E30)
+
+instance Real FixNonNeg where
+  toRational = toRational . unFixNonNeg
+
+instance Fractional FixNonNeg where
+  fromRational = mkFixNonNeg . fromRational
+  lhs / rhs = mkFixNonNeg $ unFixNonNeg lhs / unFixNonNeg rhs
+
+instance RealFrac FixNonNeg where
+  properFraction x =
+    (lhs, mkFixNonNeg rhs)
+    where
+      (lhs, rhs) = properFraction $ unFixNonNeg x
+
 -- $derivingVia
 -- Newtypes to simplify deriving via.
 -- We have to expose default constructors/accessors

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

@@ -1,7 +1,10 @@
 module Functora.RoundSpec (spec) where
 
 import Data.Fixed (E12, Fixed)
-import Functora.Prelude (throw, throwString, try)
+--
+-- NOTE : Round functions will fail for FixNonNeg because of impl details.
+--
+import Functora.Prelude (Fix, throw, throwString, try)
 import Functora.Round (dpRound, sdRound)
 import Numeric.Natural (Natural)
 import System.Exit (ExitCode (..))
@@ -29,10 +32,12 @@ spec = do
   mkRoundSpec @(Fixed E12) "dpRound/Fixed" 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 @Rational "sdRound/Rational" sdRound sdRoundTestData
   mkRoundSpec @Double "sdRound/Double" sdRound sdRoundTestData
+  mkRoundSpec @Fix "sdRound/Fix" sdRound sdRoundTestData
 
 --
 -- Tasty