9434827044

Committed 09 Jun 2024 07:15AM UTC coverage: 80.0% (-17.5%) from 97.5%

Build # 9434827044

Build Type

Pull #5

github

Committed by

web-flow

Commit Message

Merge 3b5cc2e1c into d8879e07b

Pull Request Pull Request #5: Generic implementation

Run Details

4 of 8 branches covered (50.0%)

Branch coverage included in aggregate %.

28 of 32 new or added lines in 1 file covered. (87.5%)

28 of 32 relevant lines covered (87.5%)

10701.22 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

80.0

/src/Data/Fixed/Decimal.hs

{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}

module Data.Fixed.Decimal
(
    module Data.Fixed.Decimal.Class,
    Decimal(..)
) where

import Data.Fixed.Decimal.Class
import Data.Kind (Type)
import Data.List (foldl')
import Data.Ratio (denominator, numerator, (%))
import GHC.TypeLits (KnownNat(..), Nat, natVal)


newtype Decimal (p :: Type) (s :: Nat) = Decimal {
    mantissa :: p
} deriving (Eq, Ord)

instance (Integral m, KnownNat s) => FixedDecimal (Decimal m s) where
    type Scale (Decimal m s) = s
    type Precision (Decimal m s) = m
    scale _ =
        fromInteger $ natVal @s undefined
    -- precision _ =
    --     floor @Double @Int . logBase 10 . fromIntegral $ maxBound @m
    decimal m e =
        let ma = normalise $ fromIntegral m * (10 ^ (scale @(Decimal m s) undefined + e + 1))
        in Decimal ma

instance (Show m, Integral m, KnownNat s) => Show (Decimal m s) where
    show (Decimal 0) =
        "0"
    show dm@(Decimal m) =
        fst . foldl' step ([], scale dm) . pad (scale dm + 1) . reverse . show $ m
        where
            step ([], i) '0' | i > 0 =
                ([], i - 1)
            step (ds, i) d | i > 0 =
                (d : ds, i - 1)
            step ([], 0) d =
                ([d], -1)
            step (ds, 0) d =
                (d : '.' : ds, -1)
            step (ds, i) d  =
                (d : ds, i - 1)
            pad 0 ds =
                ds
            pad i [] =
                '0' : pad (pred i) []
            pad i "-" =
                '0' : pad (pred i) "-"
            pad i (d : ds) =
                d : pad (pred i) ds

normalise :: Integral a => a -> a
normalise i =
    case i `quotRem` 10 of
        (q, r) | abs r < 5 -> q
        (q, _) | q > 0 -> succ q
        (q, _) -> pred q


instance (Integral m, KnownNat s) => Num (Decimal m s) where
    (Decimal l) + (Decimal r) =
        Decimal $ l + r

    (Decimal l) - (Decimal r) =
        Decimal $ l - r

    (Decimal l) * d@(Decimal r) =
        Decimal . normalise $ l * r `div` (10 ^ (scale d - 1))

    abs (Decimal m) =
        Decimal $ abs m

    signum d@(Decimal m) =
        Decimal $ (10 ^ scale d) * signum m

    fromInteger i =
        Decimal $ (10 ^ scale (undefined :: Decimal m s)) * fromInteger i


instance (Show m, Integral m, KnownNat s) => Fractional (Decimal m s) where
  fromRational r =
    fromInteger (numerator r) / fromInteger (denominator r)

  (Decimal l) / d@(Decimal r) =
    -- Decimal . normalise $ 10 * l `div` r
    Decimal . normalise $ (10 ^ (scale d + 1)) * l `div` r
    
instance (Bounded m) => Bounded (Decimal m s) where
    minBound =
        Decimal $ minBound @m
    maxBound =
        Decimal $ maxBound @m


instance (Integral m, KnownNat s) => Real (Decimal m s) where
    toRational d@(Decimal m) =
        fromIntegral m % (10 ^ scale d)

1	{-# LANGUAGE DataKinds #-}
2	{-# LANGUAGE ScopedTypeVariables #-}
3	{-# LANGUAGE TypeApplications #-}
4	{-# LANGUAGE TypeFamilies #-}
5
6	module Data.Fixed.Decimal
7	(
8	module Data.Fixed.Decimal.Class,
9	Decimal(..)
10	) where
11
12	import Data.Fixed.Decimal.Class
13	import Data.Kind (Type)
14	import Data.List (foldl')
15	import Data.Ratio (denominator, numerator, (%))
16	import GHC.TypeLits (KnownNat(..), Nat, natVal)
17
18
19	newtype Decimal (p :: Type) (s :: Nat) = Decimal {
20	mantissa :: p	1,002✔
21	} deriving (Eq, Ord)
22
23	instance (Integral m, KnownNat s) => FixedDecimal (Decimal m s) where
24	type Scale (Decimal m s) = s
25	type Precision (Decimal m s) = m
26	scale _ =
27	fromInteger $ natVal @s undefined	36,019✔
28	-- precision _ =
29	-- floor @Double @Int . logBase 10 . fromIntegral $ maxBound @m
30	decimal m e =
31	let ma = normalise $ fromIntegral m * (10 ^ (scale @(Decimal m s) undefined + e + 1))	1,000✔
32	in Decimal ma	1,000✔
33
34	instance (Show m, Integral m, KnownNat s) => Show (Decimal m s) where
35	show (Decimal 0) =
36	"0"	1✔
37	show dm@(Decimal m) =
38	fst . foldl' step ([], scale dm) . pad (scale dm + 1) . reverse . show $ m	3,003✔
39	where
40	step ([], i) '0' \| i > 0 =	31,265!
41	([], i - 1)	31,265✔
42	step (ds, i) d \| i > 0 =	50,643✔
43	(d : ds, i - 1)	13,780✔
44	step ([], 0) d =
45	([d], -1)	1,001✔
46	step (ds, 0) d =
47	(d : '.' : ds, -1)	2,002✔
48	step (ds, i) d =
49	(d : ds, i - 1)	33,860✔
50	pad 0 ds =
51	ds	3,003✔
52	pad i [] =
NEW 53	'0' : pad (pred i) []	×
54	pad i "-" =
NEW 55	'0' : pad (pred i) "-"	×
56	pad i (d : ds) =
57	d : pad (pred i) ds	48,048✔
58
59	normalise :: Integral a => a -> a
60	normalise i =
61	case i `quotRem` 10 of	11,002✔
62	(q, r) \| abs r < 5 -> q	11,002!
NEW 63	(q, _) \| q > 0 -> succ q	×
NEW 64	(q, _) -> pred q	×
65
66
67	instance (Integral m, KnownNat s) => Num (Decimal m s) where
68	(Decimal l) + (Decimal r) =
69	Decimal $ l + r	30,529✔
70
71	(Decimal l) - (Decimal r) =
72	Decimal $ l - r	1✔
73
74	(Decimal l) * d@(Decimal r) =
75	Decimal . normalise $ l * r `div` (10 ^ (scale d - 1))	3,000✔
76
77	abs (Decimal m) =
78	Decimal $ abs m	1,000✔
79
80	signum d@(Decimal m) =
81	Decimal $ (10 ^ scale d) * signum m	1,000✔
82
83	fromInteger i =
84	Decimal $ (10 ^ scale (undefined :: Decimal m s)) * fromInteger i	10,007✔
85
86
87	instance (Show m, Integral m, KnownNat s) => Fractional (Decimal m s) where
88	fromRational r =
89	fromInteger (numerator r) / fromInteger (denominator r)	4,002✔
90
91	(Decimal l) / d@(Decimal r) =
92	-- Decimal . normalise $ 10 * l `div` r
93	Decimal . normalise $ (10 ^ (scale d + 1)) * l `div` r	7,002✔
94
95	instance (Bounded m) => Bounded (Decimal m s) where
96	minBound =
97	Decimal $ minBound @m	1✔
98	maxBound =
99	Decimal $ maxBound @m	1✔
100
101
102	instance (Integral m, KnownNat s) => Real (Decimal m s) where
103	toRational d@(Decimal m) =
104	fromIntegral m % (10 ^ scale d)	7,000✔

EduardSergeev / fixed-decimal / 9434827044

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous