9674066405

Committed 26 Jun 2024 04:42AM UTC coverage: 96.078% (+1.6%) from 94.444%

Build # 9674066405

Build Type

push

github

Committed by

web-flow

Commit Message

Initial pre-release

- Added:
- Basic functionality exposed via `Decimal (m :: Type) (s :: Nat)` type
  - Test suite
  - Benchmark suite

Run Details

5 of 6 branches covered (83.33%)

Branch coverage included in aggregate %.

14 of 14 new or added lines in 1 file covered. (100.0%)

1 existing line in 1 file now uncovered.

44 of 45 relevant lines covered (97.78%)

7682.27 hits per line

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

96.08

/src/Data/Fixed/Decimal.hs

{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Decimal types of fixed precision and scale
--   which can use any 'Integral' type to store mantissa
module Data.Fixed.Decimal
(
    module Data.Fixed.Decimal.Class,
    Decimal(..)
) where

import Data.Char (isDigit)
import Data.Fixed.Decimal.Class
import Data.Kind (Type)
import Data.List (elemIndex)
import Data.Maybe (fromMaybe)
import Data.Ratio (denominator, numerator, (%))
import GHC.TypeLits (KnownNat, Nat, natVal, type (^))

-- | Decimal type of fixed precision and scale which uses:
--
--   * 'm': 'Integral' type to store mantissa
--   * 's': Type-level number 'Nat' to define scale (fractional part size)
--
newtype Decimal (m :: Type) (s :: Nat) = Decimal {
    mantissa :: m
} 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 _ =
        fromIntegral $ natVal @s undefined
    decimal m e =
        Decimal $ fromIntegral m * (10 ^ (scale @(Decimal m s) undefined + e))

type Scale10 (s :: Nat) = 10 ^ s

scale10 :: forall s i m. (KnownNat (10 ^ s), Integral i) => (Decimal m s) -> i
scale10 _ =
    fromInteger $ natVal @(Scale10 s) undefined


instance (Show m, Integral m, KnownNat s) => Show (Decimal m s) where
    show (Decimal 0) =
        "0"
    show dl@(Decimal dm) =
        let ds = gof (scale dl) (reverse . sabs . show $ dm) []
        in if dm < 0 then '-' : ds else ds
        where
            sabs ('-': ds) =
                ds
            sabs ds =
                ds

            gof 0 ds [] =
                goi ds []
            gof 0 ds rs =
                goi ds ('.' : rs)
            gof i ('0' : ds) [] =
                gof (pred i) ds [] 
            gof i (d : ds) rs =
                gof (pred i) ds (d : rs)
            gof i [] rs =
                gof (pred i) [] ('0' : rs)

            goi [] rs@('.' : _) =
                '0' : rs
            goi [] rs =
                rs
            goi (d : ds') rs =
                goi ds' (d : rs)


instance (Integral m, Read m, KnownNat s) => Read (Decimal m s) where
    readsPrec p s =
        let (ds, s') = spanD False s
            lds = length ds - 1
            i = ((lds) -) . fromMaybe lds . elemIndex '.' $ s
            mrss = readsPrec p . filter (/= '.') $ ds
        in fmap (\(m, rs) -> (Decimal (m * (10 ^ (scale (undefined :: Decimal m s) - i))), rs ++ s')) mrss
        where
            spanD _ cs@[] =
                (cs, cs)
            spanD d cs@(c : cs')
                | isDigit c || c == '-' || c == '.' && not d =
                    let (bs, as) = spanD (d || c == '.') cs'
                    in (c : bs, as)
                | otherwise =
                    ([], cs)                


instance (Integral m, KnownNat s, KnownNat (10 ^ 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 $ l * r `quot` scale10 d

    abs (Decimal m) =
        Decimal $ abs m

    signum d@(Decimal m) =
        Decimal $ scale10 d * signum m

    fromInteger i =
        Decimal $ scale10 (undefined :: Decimal m s) * fromInteger i


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

    (Decimal l) / d@(Decimal r) =
        Decimal $ scale10 d * l `quot` r
    
instance (Bounded m) => Bounded (Decimal m s) where
    minBound =
        Decimal $ minBound @m
    maxBound =
        Decimal $ maxBound @m


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

instance (Enum m, Integral m, KnownNat s, KnownNat (10 ^ s)) => Enum (Decimal m s) where
    fromEnum d@(Decimal m) =
        fromEnum $ m `quot` (scale10  d)
    toEnum =
        fromIntegral
    enumFrom =
        iterate (+1)
    enumFromThen x1 x2 =
        let dx = x2 - x1 in iterate (+dx) x1
    enumFromTo x1 x2 =
        takeWhile (<= x2) $ enumFrom x1
    enumFromThenTo x1 x2 x3 =
        takeWhile (<= x3) $ enumFromThen x1 x2

1	{-# LANGUAGE FlexibleContexts #-}
2	{-# LANGUAGE ScopedTypeVariables #-}
3	{-# LANGUAGE TypeFamilies #-}
4	{-# LANGUAGE TypeOperators #-}
5	{-# LANGUAGE UndecidableInstances #-}
6
7	-- \| Decimal types of fixed precision and scale
8	-- which can use any 'Integral' type to store mantissa
9	module Data.Fixed.Decimal
10	(
11	module Data.Fixed.Decimal.Class,
12	Decimal(..)
13	) where
14
15	import Data.Char (isDigit)
16	import Data.Fixed.Decimal.Class
17	import Data.Kind (Type)
18	import Data.List (elemIndex)
19	import Data.Maybe (fromMaybe)
20	import Data.Ratio (denominator, numerator, (%))
21	import GHC.TypeLits (KnownNat, Nat, natVal, type (^))
22
23	-- \| Decimal type of fixed precision and scale which uses:
24	--
25	-- * 'm': 'Integral' type to store mantissa
26	-- * 's': Type-level number 'Nat' to define scale (fractional part size)
27	--
28	newtype Decimal (m :: Type) (s :: Nat) = Decimal {
29	mantissa :: m	404✔
30	} deriving (Eq, Ord)
31
32
33	instance (Integral m, KnownNat s) => FixedDecimal (Decimal m s) where
34	type Scale (Decimal m s) = s
35	type Precision (Decimal m s) = m
36	scale _ =
37	fromIntegral $ natVal @s undefined	11,810✔
38	decimal m e =
39	Decimal $ fromIntegral m * (10 ^ (scale @(Decimal m s) undefined + e))	400✔
40
41	type Scale10 (s :: Nat) = 10 ^ s
42
43	scale10 :: forall s i m. (KnownNat (10 ^ s), Integral i) => (Decimal m s) -> i
44	scale10 _ =
45	fromInteger $ natVal @(Scale10 s) undefined	10,410✔
46
47
48	instance (Show m, Integral m, KnownNat s) => Show (Decimal m s) where
49	show (Decimal 0) =
50	"0"	532✔
51	show dl@(Decimal dm) =
52	let ds = gof (scale dl) (reverse . sabs . show $ dm) []	3,944✔
53	in if dm < 0 then '-' : ds else ds	3,945✔
54	where
55	sabs ('-': ds) =
56	ds	1,907✔
57	sabs ds =
58	ds	2,037✔
59
60	gof 0 ds [] =
61	goi ds []	1,853✔
62	gof 0 ds rs =
63	goi ds ('.' : rs)	2,091✔
64	gof i ('0' : ds) [] =
65	gof (pred i) ds []	53,528✔
66	gof i (d : ds) rs =
67	gof (pred i) ds (d : rs)	9,556✔
68	gof i [] rs =
69	gof (pred i) [] ('0' : rs)	6✔
70
71	goi [] rs@('.' : _) =
72	'0' : rs	589✔
73	goi [] rs =
74	rs	3,352✔
75	goi (d : ds') rs =
76	goi ds' (d : rs)	15,486✔
77
78
79	instance (Integral m, Read m, KnownNat s) => Read (Decimal m s) where
80	readsPrec p s =
81	let (ds, s') = spanD False s	7,084✔
82	lds = length ds - 1	7,080✔
83	i = ((lds) -) . fromMaybe lds . elemIndex '.' $ s	7,077✔
84	mrss = readsPrec p . filter (/= '.') $ ds	7,083✔
85	in fmap (\(m, rs) -> (Decimal (m * (10 ^ (scale (undefined :: Decimal m s) - i))), rs ++ s')) mrss	7,084✔
86	where
87	spanD _ cs@[] =
88	(cs, cs)	7,072✔
89	spanD d cs@(c : cs')
90	\| isDigit c \|\| c == '-' \|\| c == '.' && not d =	51,475✔
91	let (bs, as) = spanD (d \|\| c == '.') cs'	51,505✔
92	in (c : bs, as)	51,524✔
93	\| otherwise =	8!
94	([], cs)	8✔
95
96
97	instance (Integral m, KnownNat s, KnownNat (10 ^ s)) => Num (Decimal m s) where
98	(Decimal l) + (Decimal r) =
99	Decimal $ l + r	14,215✔
100
101	(Decimal l) - (Decimal r) =
102	Decimal $ l - r	150✔
103
104	(Decimal l) * d@(Decimal r) =
105	Decimal $ l * r `quot` scale10 d	1,200✔
106
107	abs (Decimal m) =
108	Decimal $ abs m	400✔
109
110	signum d@(Decimal m) =
111	Decimal $ scale10 d * signum m	400✔
112
113	fromInteger i =
114	Decimal $ scale10 (undefined :: Decimal m s) * fromInteger i	2,209✔
115
116
117	instance (Integral m, KnownNat s, KnownNat (10 ^ s)) => Fractional (Decimal m s) where
118	fromRational r =
119	fromInteger (numerator r) / fromInteger (denominator r)	417✔
120
121	(Decimal l) / d@(Decimal r) =
122	Decimal $ scale10 d * l `quot` r	1,617✔
123
124	instance (Bounded m) => Bounded (Decimal m s) where
125	minBound =
UNCOV 126	Decimal $ minBound @m	×
127	maxBound =
128	Decimal $ maxBound @m	4✔
129
130
131	instance (Integral m, KnownNat s, KnownNat (10 ^ s)) => Real (Decimal m s) where
132	toRational d@(Decimal m) =
133	(fromIntegral m) % (scale10 d)	4,598✔
134
135	instance (Enum m, Integral m, KnownNat s, KnownNat (10 ^ s)) => Enum (Decimal m s) where
136	fromEnum d@(Decimal m) =
137	fromEnum $ m `quot` (scale10 d)	400✔
138	toEnum =
139	fromIntegral	400✔
140	enumFrom =
141	iterate (+1)	218✔
142	enumFromThen x1 x2 =
143	let dx = x2 - x1 in iterate (+dx) x1	203✔
144	enumFromTo x1 x2 =
145	takeWhile (<= x2) $ enumFrom x1	218✔
146	enumFromThenTo x1 x2 x3 =
147	takeWhile (<= x3) $ enumFromThen x1 x2	203✔

EduardSergeev / fixed-decimal / 9674066405

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