-
Notifications
You must be signed in to change notification settings - Fork 1
/
Money.hs
108 lines (87 loc) · 2.63 KB
/
Money.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
{-# LANGUAGE RankNTypes #-}
-- | A data type for monetary values, with associated operations and
-- only sensible instances.
module Data.Money
(
Money(Money)
-- * Optics
, money
-- * Operators
, ($+$)
, ($-$)
, (*$)
, ($*)
, ($/)
, ($/$)
, ($^)
, ($^^)
, ($**)
) where
import Data.Functor (Functor (fmap))
import Data.Foldable (Foldable (foldMap))
import Data.Monoid (Monoid, mempty, mappend)
import Data.Profunctor (Profunctor, dimap)
import Data.Semigroup (Semigroup, (<>))
import Data.Traversable (Traversable (traverse))
-- | A newtype for monetary values represented as type @num@.
--
-- The 'Semigroup' instance allows amounts of money to be added together.
--
-- Any 'Num' instances present are hidden, as operations like multiplying
-- money by money don't make any sense.
newtype Money num =
Money num
deriving (Eq, Ord)
instance Show num => Show (Money num) where
show (Money m) = '$': show m
instance Num a => Semigroup (Money a) where
Money m <> Money n = Money (m + n)
instance Num a => Monoid (Money a) where
mappend = (<>)
mempty = Money 0
instance Functor Money where
fmap f (Money n) = Money (f n)
instance Foldable Money where
foldMap f (Money n) = f n
instance Traversable Money where
traverse f (Money n) = fmap Money (f n)
type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)
-- | The raw numeric value inside monetary value
money :: Iso (Money a) (Money b) a b
money = dimap (\(Money a) -> a) (fmap Money)
-- | Add money to money. A synonym for @<>@.
infixl 6 $+$
($+$) :: Num a => Money a -> Money a -> Money a
($+$) = (<>)
-- | Subtract money from money
infixl 6 $-$
($-$) :: Num a => Money a -> Money a -> Money a
($-$) (Money m) (Money n) = Money (m - n)
-- | Multiply a scalar by money
infixr 7 *$
(*$) :: Num a => a -> Money a -> Money a
(*$) x (Money m) = Money (x * m)
-- | Multiply money by a scalar
infixl 7 $*
($*) :: Num a => Money a -> a -> Money a
($*) = flip (*$)
-- | Divide money by a scalar
infixl 7 $/
($/) :: Fractional a => Money a -> a -> Money a
($/) (Money m) x = Money (m/x)
-- | Divide money by money
infixl 7 $/$
($/$) :: Fractional a => Money a -> Money a -> a
($/$) (Money n) (Money m) = n / m
-- | Raise money to a non-negative integral power
infixr 8 $^
($^) :: (Num a, Integral b) => Money a -> b -> Money a
($^) (Money m) x = Money (m ^ x)
-- | Raise money to an integral power
infixr 8 $^^
($^^) :: (Fractional a, Integral b) => Money a -> b -> Money a
($^^) (Money m) x = Money (m ^^ x)
-- | Raise money to a floating-point power
infixr 8 $**
($**) :: Floating a => Money a -> a -> Money a
($**) (Money m) x = Money (m ** x)