9673682813

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

Build # 9673682813

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%)

15342.04 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	809✔
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	23,632✔
38	decimal m e =
39	Decimal $ fromIntegral m * (10 ^ (scale @(Decimal m s) undefined + e))	800✔
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	20,877✔
46
47
48	instance (Show m, Integral m, KnownNat s) => Show (Decimal m s) where
49	show (Decimal 0) =
50	"0"	1,034✔
51	show dl@(Decimal dm) =
52	let ds = gof (scale dl) (reverse . sabs . show $ dm) []	7,842✔
53	in if dm < 0 then '-' : ds else ds	7,842✔
54	where
55	sabs ('-': ds) =
56	ds	3,717✔
57	sabs ds =
58	ds	4,121✔
59
60	gof 0 ds [] =
61	goi ds []	3,809✔
62	gof 0 ds rs =
63	goi ds ('.' : rs)	4,033✔
64	gof i ('0' : ds) [] =
65	gof (pred i) ds []	108,436✔
66	gof i (d : ds) rs =
67	gof (pred i) ds (d : rs)	19,874✔
68	gof i [] rs =
69	gof (pred i) [] ('0' : rs)	1✔
70
71	goi [] rs@('.' : _) =
72	'0' : rs	1,167✔
73	goi [] rs =
74	rs	6,672✔
75	goi (d : ds') rs =
76	goi ds' (d : rs)	28,177✔
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	14,213✔
82	lds = length ds - 1	14,195✔
83	i = ((lds) -) . fromMaybe lds . elemIndex '.' $ s	14,203✔
84	mrss = readsPrec p . filter (/= '.') $ ds	14,213✔
85	in fmap (\(m, rs) -> (Decimal (m * (10 ^ (scale (undefined :: Decimal m s) - i))), rs ++ s')) mrss	14,221✔
86	where
87	spanD _ cs@[] =
88	(cs, cs)	14,187✔
89	spanD d cs@(c : cs')
90	\| isDigit c \|\| c == '-' \|\| c == '.' && not d =	102,865✔
91	let (bs, as) = spanD (d \|\| c == '.') cs'	102,857✔
92	in (c : bs, as)	102,854✔
93	\| otherwise =	16!
94	([], cs)	16✔
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	28,343✔
100
101	(Decimal l) - (Decimal r) =
102	Decimal $ l - r	295✔
103
104	(Decimal l) * d@(Decimal r) =
105	Decimal $ l * r `quot` scale10 d	2,400✔
106
107	abs (Decimal m) =
108	Decimal $ abs m	800✔
109
110	signum d@(Decimal m) =
111	Decimal $ scale10 d * signum m	800✔
112
113	fromInteger i =
114	Decimal $ scale10 (undefined :: Decimal m s) * fromInteger i	4,418✔
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)	834✔
120
121	(Decimal l) / d@(Decimal r) =
122	Decimal $ scale10 d * l `quot` r	3,234✔
123
124	instance (Bounded m) => Bounded (Decimal m s) where
125	minBound =
UNCOV 126	Decimal $ minBound @m	×
127	maxBound =
128	Decimal $ maxBound @m	8✔
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)	9,243✔
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)	800✔
138	toEnum =
139	fromIntegral	800✔
140	enumFrom =
141	iterate (+1)	422✔
142	enumFromThen x1 x2 =
143	let dx = x2 - x1 in iterate (+dx) x1	445✔
144	enumFromTo x1 x2 =
145	takeWhile (<= x2) $ enumFrom x1	422✔
146	enumFromThenTo x1 x2 x3 =
147	takeWhile (<= x3) $ enumFromThen x1 x2	445✔

EduardSergeev / fixed-decimal / 9673682813

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