{-# 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.Profunctor (Profunctor, dimap)

-- | 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 (Money num -> Money num -> Bool
(Money num -> Money num -> Bool)
-> (Money num -> Money num -> Bool) -> Eq (Money num)
forall num. Eq num => Money num -> Money num -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall num. Eq num => Money num -> Money num -> Bool
== :: Money num -> Money num -> Bool
$c/= :: forall num. Eq num => Money num -> Money num -> Bool
/= :: Money num -> Money num -> Bool
Eq, Eq (Money num)
Eq (Money num) =>
(Money num -> Money num -> Ordering)
-> (Money num -> Money num -> Bool)
-> (Money num -> Money num -> Bool)
-> (Money num -> Money num -> Bool)
-> (Money num -> Money num -> Bool)
-> (Money num -> Money num -> Money num)
-> (Money num -> Money num -> Money num)
-> Ord (Money num)
Money num -> Money num -> Bool
Money num -> Money num -> Ordering
Money num -> Money num -> Money num
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall num. Ord num => Eq (Money num)
forall num. Ord num => Money num -> Money num -> Bool
forall num. Ord num => Money num -> Money num -> Ordering
forall num. Ord num => Money num -> Money num -> Money num
$ccompare :: forall num. Ord num => Money num -> Money num -> Ordering
compare :: Money num -> Money num -> Ordering
$c< :: forall num. Ord num => Money num -> Money num -> Bool
< :: Money num -> Money num -> Bool
$c<= :: forall num. Ord num => Money num -> Money num -> Bool
<= :: Money num -> Money num -> Bool
$c> :: forall num. Ord num => Money num -> Money num -> Bool
> :: Money num -> Money num -> Bool
$c>= :: forall num. Ord num => Money num -> Money num -> Bool
>= :: Money num -> Money num -> Bool
$cmax :: forall num. Ord num => Money num -> Money num -> Money num
max :: Money num -> Money num -> Money num
$cmin :: forall num. Ord num => Money num -> Money num -> Money num
min :: Money num -> Money num -> Money num
Ord)

instance Show num => Show (Money num) where
  show :: Money num -> String
show (Money num
m) = Char
'$'Char -> ShowS
forall a. a -> [a] -> [a]
: num -> String
forall a. Show a => a -> String
show num
m

instance Num a => Semigroup (Money a) where
  Money a
m <> :: Money a -> Money a -> Money a
<> Money a
n = a -> Money a
forall num. num -> Money num
Money (a
m a -> a -> a
forall a. Num a => a -> a -> a
+ a
n)

instance Num a => Monoid (Money a) where
  mappend :: Money a -> Money a -> Money a
mappend = Money a -> Money a -> Money a
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: Money a
mempty = a -> Money a
forall num. num -> Money num
Money a
0

instance Functor Money where
  fmap :: forall a b. (a -> b) -> Money a -> Money b
fmap a -> b
f (Money a
n) = b -> Money b
forall num. num -> Money num
Money (a -> b
f a
n)

instance Foldable Money where
  foldMap :: forall m a. Monoid m => (a -> m) -> Money a -> m
foldMap a -> m
f (Money a
n) = a -> m
f a
n

instance Traversable Money where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Money a -> f (Money b)
traverse a -> f b
f (Money a
n) = (b -> Money b) -> f b -> f (Money b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Money b
forall num. num -> Money num
Money (a -> f b
f a
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 :: forall a b (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p a (f b) -> p (Money a) (f (Money b))
money = (Money a -> a)
-> (f b -> f (Money b)) -> p a (f b) -> p (Money a) (f (Money b))
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (\(Money a
a) -> a
a) ((b -> Money b) -> f b -> f (Money b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Money b
forall num. num -> Money num
Money)

-- | Add money to money. A synonym for @<>@.
infixl 6 $+$
($+$) :: Num a => Money a -> Money a -> Money a
$+$ :: forall a. Num a => Money a -> Money a -> Money a
($+$) = Money a -> Money a -> Money a
forall a. Semigroup a => a -> a -> a
(<>)

-- | Subtract money from money
infixl 6 $-$
($-$) :: Num a => Money a -> Money a -> Money a
$-$ :: forall a. Num a => Money a -> Money a -> Money a
($-$) (Money a
m) (Money a
n) = a -> Money a
forall num. num -> Money num
Money (a
m a -> a -> a
forall a. Num a => a -> a -> a
- a
n)

-- | Multiply a scalar by money
infixl 7 *$
(*$) :: Num a => a -> Money a -> Money a
*$ :: forall a. Num a => a -> Money a -> Money a
(*$) a
x (Money a
m) = a -> Money a
forall num. num -> Money num
Money (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
m)

-- | Multiply money by a scalar
infixl 7 $*
($*) :: Num a => Money a -> a -> Money a
$* :: forall a. Num a => Money a -> a -> Money a
($*) = (a -> Money a -> Money a) -> Money a -> a -> Money a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Money a -> Money a
forall a. Num a => a -> Money a -> Money a
(*$)

-- | Divide money by a scalar
infixl 7 $/
($/) :: Fractional a => Money a -> a -> Money a
$/ :: forall a. Fractional a => Money a -> a -> Money a
($/) (Money a
m) a
x = a -> Money a
forall num. num -> Money num
Money (a
ma -> a -> a
forall a. Fractional a => a -> a -> a
/a
x)

-- | Divide money by money
infixl 7 $/$
($/$) :: Fractional a => Money a -> Money a -> a
$/$ :: forall a. Fractional a => Money a -> Money a -> a
($/$) (Money a
n) (Money a
m) = a
n a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
m

-- | Raise money to a non-negative integral power
infixr 8 $^
($^) :: (Num a, Integral b) => Money a -> b -> Money a
$^ :: forall a b. (Num a, Integral b) => Money a -> b -> Money a
($^) (Money a
m) b
x = a -> Money a
forall num. num -> Money num
Money (a
m a -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ b
x)

-- | Raise money to an integral power
infixr 8 $^^
($^^) :: (Fractional a, Integral b) => Money a -> b -> Money a
$^^ :: forall a b. (Fractional a, Integral b) => Money a -> b -> Money a
($^^) (Money a
m) b
x = a -> Money a
forall num. num -> Money num
Money (a
m a -> b -> a
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ b
x)

-- | Raise money to a floating-point power
infixr 8 $**
($**) :: Floating a => Money a -> a -> Money a
$** :: forall a. Floating a => Money a -> a -> Money a
($**) (Money a
m) a
x = a -> Money a
forall num. num -> Money num
Money (a
m a -> a -> a
forall a. Floating a => a -> a -> a
** a
x)