{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Data.Tax.ATO.CGT
(
CGTEvent(..)
, assessCGTEvents
, CGTAssessment(CGTAssessment)
, CGTNetGainOrLoss(..)
, HasCapitalLossCarryForward(..)
, cgtNetGainOrLoss
, cgtNetGain
, HasCapitalGain(..)
, capitalLoss
, isCapitalGain
, isCapitalLoss
, discountApplicable
, netCapitalGainOrLoss
) where
import Data.Foldable (toList)
import Data.List (partition)
import Control.Lens (Getter, Lens', both, lens, over, to, view)
import Data.Time.Calendar (Day, diffDays)
import Data.Tax
data CGTEvent a = CGTEvent
{ forall a. CGTEvent a -> String
assetDesc :: String
, forall a. CGTEvent a -> a
units :: a
, forall a. CGTEvent a -> Day
acquisitionDate :: Day
, forall a. CGTEvent a -> Money a
acquisitionPrice :: Money a
, forall a. CGTEvent a -> Money a
acquisitionCosts :: Money a
, forall a. CGTEvent a -> Day
disposalDate :: Day
, forall a. CGTEvent a -> Money a
disposalPrice :: Money a
, forall a. CGTEvent a -> Money a
disposalCosts :: Money a
, forall a. CGTEvent a -> Money a
capitalCosts :: Money a
, forall a. CGTEvent a -> Money a
ownershipCosts :: Money a
}
deriving (Int -> CGTEvent a -> ShowS
forall a. Show a => Int -> CGTEvent a -> ShowS
forall a. Show a => [CGTEvent a] -> ShowS
forall a. Show a => CGTEvent a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CGTEvent a] -> ShowS
$cshowList :: forall a. Show a => [CGTEvent a] -> ShowS
show :: CGTEvent a -> String
$cshow :: forall a. Show a => CGTEvent a -> String
showsPrec :: Int -> CGTEvent a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CGTEvent a -> ShowS
Show)
reducedCostBase :: Num a => CGTEvent a -> Money a
reducedCostBase :: forall a. Num a => CGTEvent a -> Money a
reducedCostBase CGTEvent a
event =
(forall a. CGTEvent a -> a
units CGTEvent a
event forall a. Num a => a -> Money a -> Money a
*$ forall a. CGTEvent a -> Money a
acquisitionPrice CGTEvent a
event)
forall a. Num a => Money a -> Money a -> Money a
$+$ forall a. CGTEvent a -> Money a
acquisitionCosts CGTEvent a
event
forall a. Num a => Money a -> Money a -> Money a
$+$ forall a. CGTEvent a -> Money a
disposalCosts CGTEvent a
event
forall a. Num a => Money a -> Money a -> Money a
$+$ forall a. CGTEvent a -> Money a
capitalCosts CGTEvent a
event
costBase :: Num a => CGTEvent a -> Money a
costBase :: forall a. Num a => CGTEvent a -> Money a
costBase CGTEvent a
event = forall a. Num a => CGTEvent a -> Money a
reducedCostBase CGTEvent a
event forall a. Num a => Money a -> Money a -> Money a
$+$ forall a. CGTEvent a -> Money a
ownershipCosts CGTEvent a
event
capitalGain' :: (Num a, Ord a) => CGTEvent a -> Money a
capitalGain' :: forall a. (Num a, Ord a) => CGTEvent a -> Money a
capitalGain' CGTEvent a
event =
forall a. Ord a => a -> a -> a
max forall a. Monoid a => a
mempty (forall a. CGTEvent a -> a
units CGTEvent a
event forall a. Num a => a -> Money a -> Money a
*$ forall a. CGTEvent a -> Money a
disposalPrice CGTEvent a
event forall a. Num a => Money a -> Money a -> Money a
$-$ forall a. Num a => CGTEvent a -> Money a
costBase CGTEvent a
event)
capitalLoss :: (Num a, Ord a) => CGTEvent a -> Money a
capitalLoss :: forall a. (Num a, Ord a) => CGTEvent a -> Money a
capitalLoss CGTEvent a
event = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a b. Iso (Money a) (Money b) a b
money forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$
forall a. Ord a => a -> a -> a
min forall a. Monoid a => a
mempty (forall a. CGTEvent a -> a
units CGTEvent a
event forall a. Num a => a -> Money a -> Money a
*$ forall a. CGTEvent a -> Money a
disposalPrice CGTEvent a
event forall a. Num a => Money a -> Money a -> Money a
$-$ forall a. Num a => CGTEvent a -> Money a
reducedCostBase CGTEvent a
event)
isCapitalGain :: (Num a, Ord a) => CGTEvent a -> Bool
isCapitalGain :: forall a. (Num a, Ord a) => CGTEvent a -> Bool
isCapitalGain = (forall a. Ord a => a -> a -> Bool
> forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Num a, Ord a) => CGTEvent a -> Money a
capitalGain'
isCapitalLoss :: (Num a, Ord a) => CGTEvent a -> Bool
isCapitalLoss :: forall a. (Num a, Ord a) => CGTEvent a -> Bool
isCapitalLoss = (forall a. Ord a => a -> a -> Bool
> forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Num a, Ord a) => CGTEvent a -> Money a
capitalLoss
discountApplicable :: CGTEvent a -> Bool
discountApplicable :: forall a. CGTEvent a -> Bool
discountApplicable CGTEvent a
ev =
Day -> Day -> Integer
diffDays (forall a. CGTEvent a -> Day
disposalDate CGTEvent a
ev) (forall a. CGTEvent a -> Day
acquisitionDate CGTEvent a
ev) forall a. Ord a => a -> a -> Bool
> Integer
365
class HasCapitalGain a b c where
capitalGain :: Getter (a b) (Money c)
instance (Num a, Ord a) => HasCapitalGain CGTEvent a a where
capitalGain :: Getter (CGTEvent a) (Money a)
capitalGain = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. (Num a, Ord a) => CGTEvent a -> Money a
capitalGain'
instance (Foldable t, HasCapitalGain x a a, Num a) => HasCapitalGain t (x a) a where
capitalGain :: Getter (t (x a)) (Money a)
capitalGain = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (a :: * -> *) b c.
HasCapitalGain a b c =>
Getter (a b) (Money c)
capitalGain))
netCapitalGainOrLoss
:: (Fractional a, Ord a, Foldable t)
=> Money a
-> t (CGTEvent a)
-> CGTNetGainOrLoss a
netCapitalGainOrLoss :: forall a (t :: * -> *).
(Fractional a, Ord a, Foldable t) =>
Money a -> t (CGTEvent a) -> CGTNetGainOrLoss a
netCapitalGainOrLoss Money a
carry t (CGTEvent a)
events =
let
l :: [CGTEvent a]
l = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t (CGTEvent a)
events
(Money a
discountableGain, Money a
nonDiscountableGain) =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (a :: * -> *) b c.
HasCapitalGain a b c =>
Getter (a b) (Money c)
capitalGain) (forall a. (a -> Bool) -> [a] -> ([a], [a])
partition forall a. CGTEvent a -> Bool
discountApplicable [CGTEvent a]
l)
loss :: Money a
loss = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. (Num a, Ord a) => CGTEvent a -> Money a
capitalLoss [CGTEvent a]
l
(Money a
nonDiscLessLoss, Money a
remLoss) = forall a.
(Num a, Ord a) =>
Money a -> Money a -> (Money a, Money a)
sub Money a
nonDiscountableGain (Money a
loss forall a. Semigroup a => a -> a -> a
<> Money a
carry)
(Money a
discLessLoss, Money a
finalLoss) = forall a.
(Num a, Ord a) =>
Money a -> Money a -> (Money a, Money a)
sub Money a
discountableGain Money a
remLoss
discGain :: Money a
discGain = Money a
nonDiscLessLoss forall a. Semigroup a => a -> a -> a
<> (Money a
discLessLoss forall a. Num a => Money a -> a -> Money a
$* a
0.5)
in
if Money a
discGain forall a. Ord a => a -> a -> Bool
> forall a. Monoid a => a
mempty
then forall a. Money a -> CGTNetGainOrLoss a
CGTNetGain Money a
discGain
else forall a. Money a -> CGTNetGainOrLoss a
CGTLoss Money a
finalLoss
sub :: (Num a, Ord a) => Money a -> Money a -> (Money a, Money a)
sub :: forall a.
(Num a, Ord a) =>
Money a -> Money a -> (Money a, Money a)
sub Money a
x Money a
y =
let r :: Money a
r = Money a
x forall a. Num a => Money a -> Money a -> Money a
$-$ Money a
y
in (forall a. Ord a => a -> a -> a
max forall a. Monoid a => a
mempty Money a
r, forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a b. Iso (Money a) (Money b) a b
money forall a. Num a => a -> a
abs (forall a. Ord a => a -> a -> a
min forall a. Monoid a => a
mempty Money a
r))
assessCGTEvents
:: (Fractional a, Ord a, Foldable t)
=> Money a
-> t (CGTEvent a)
-> CGTAssessment a
assessCGTEvents :: forall a (t :: * -> *).
(Fractional a, Ord a, Foldable t) =>
Money a -> t (CGTEvent a) -> CGTAssessment a
assessCGTEvents Money a
carry t (CGTEvent a)
evs = forall a. Money a -> CGTNetGainOrLoss a -> CGTAssessment a
CGTAssessment
(forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (a :: * -> *) b c.
HasCapitalGain a b c =>
Getter (a b) (Money c)
capitalGain t (CGTEvent a)
evs)
(forall a (t :: * -> *).
(Fractional a, Ord a, Foldable t) =>
Money a -> t (CGTEvent a) -> CGTNetGainOrLoss a
netCapitalGainOrLoss Money a
carry t (CGTEvent a)
evs)
data CGTAssessment a = CGTAssessment
{ forall a. CGTAssessment a -> Money a
_cgtaTotal :: Money a
, forall a. CGTAssessment a -> CGTNetGainOrLoss a
_cgtaNet :: CGTNetGainOrLoss a
}
deriving (Int -> CGTAssessment a -> ShowS
forall a. Show a => Int -> CGTAssessment a -> ShowS
forall a. Show a => [CGTAssessment a] -> ShowS
forall a. Show a => CGTAssessment a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CGTAssessment a] -> ShowS
$cshowList :: forall a. Show a => [CGTAssessment a] -> ShowS
show :: CGTAssessment a -> String
$cshow :: forall a. Show a => CGTAssessment a -> String
showsPrec :: Int -> CGTAssessment a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CGTAssessment a -> ShowS
Show)
instance Functor CGTAssessment where
fmap :: forall a b. (a -> b) -> CGTAssessment a -> CGTAssessment b
fmap a -> b
f (CGTAssessment Money a
a CGTNetGainOrLoss a
b) = forall a. Money a -> CGTNetGainOrLoss a -> CGTAssessment a
CGTAssessment (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Money a
a) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f CGTNetGainOrLoss a
b)
instance HasCapitalGain CGTAssessment a a where
capitalGain :: Getter (CGTAssessment a) (Money a)
capitalGain = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. CGTAssessment a -> Money a
_cgtaTotal
cgtNetGainOrLoss :: Lens' (CGTAssessment a) (CGTNetGainOrLoss a)
cgtNetGainOrLoss :: forall a. Lens' (CGTAssessment a) (CGTNetGainOrLoss a)
cgtNetGainOrLoss = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a. CGTAssessment a -> CGTNetGainOrLoss a
_cgtaNet (\CGTAssessment a
s CGTNetGainOrLoss a
b -> CGTAssessment a
s { _cgtaNet :: CGTNetGainOrLoss a
_cgtaNet = CGTNetGainOrLoss a
b })
cgtNetGain :: (Num a) => Getter (CGTAssessment a) (Money a)
cgtNetGain :: forall a. Num a => Getter (CGTAssessment a) (Money a)
cgtNetGain = forall a. Lens' (CGTAssessment a) (CGTNetGainOrLoss a)
cgtNetGainOrLoss forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall {a}. Num a => CGTNetGainOrLoss a -> Money a
f
where
f :: CGTNetGainOrLoss a -> Money a
f (CGTNetGain Money a
a) = Money a
a
f CGTNetGainOrLoss a
_ = forall a. Monoid a => a
mempty
data CGTNetGainOrLoss a = CGTNetGain (Money a) | CGTLoss (Money a)
deriving (Int -> CGTNetGainOrLoss a -> ShowS
forall a. Show a => Int -> CGTNetGainOrLoss a -> ShowS
forall a. Show a => [CGTNetGainOrLoss a] -> ShowS
forall a. Show a => CGTNetGainOrLoss a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CGTNetGainOrLoss a] -> ShowS
$cshowList :: forall a. Show a => [CGTNetGainOrLoss a] -> ShowS
show :: CGTNetGainOrLoss a -> String
$cshow :: forall a. Show a => CGTNetGainOrLoss a -> String
showsPrec :: Int -> CGTNetGainOrLoss a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CGTNetGainOrLoss a -> ShowS
Show)
instance Functor CGTNetGainOrLoss where
fmap :: forall a b. (a -> b) -> CGTNetGainOrLoss a -> CGTNetGainOrLoss b
fmap a -> b
f (CGTNetGain Money a
a) = forall a. Money a -> CGTNetGainOrLoss a
CGTNetGain (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Money a
a)
fmap a -> b
f (CGTLoss Money a
a) = forall a. Money a -> CGTNetGainOrLoss a
CGTLoss (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Money a
a)
class HasCapitalLossCarryForward a b where
capitalLossCarryForward :: Lens' (a b) (Money b)
instance (Num a, Eq a) => HasCapitalLossCarryForward CGTNetGainOrLoss a where
capitalLossCarryForward :: Lens' (CGTNetGainOrLoss a) (Money a)
capitalLossCarryForward = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(\CGTNetGainOrLoss a
s -> case CGTNetGainOrLoss a
s of CGTLoss Money a
a -> Money a
a ; CGTNetGainOrLoss a
_ -> forall a. Monoid a => a
mempty)
(\CGTNetGainOrLoss a
s Money a
b -> if Money a
b forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty then CGTNetGainOrLoss a
s else forall a. Money a -> CGTNetGainOrLoss a
CGTLoss Money a
b)
instance (Num a, Eq a) => HasCapitalLossCarryForward CGTAssessment a where
capitalLossCarryForward :: Lens' (CGTAssessment a) (Money a)
capitalLossCarryForward = forall a. Lens' (CGTAssessment a) (CGTNetGainOrLoss a)
cgtNetGainOrLoss forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> *) b.
HasCapitalLossCarryForward a b =>
Lens' (a b) (Money b)
capitalLossCarryForward