-- This file is part of hs-tax-ato
-- Copyright (C) 2018  Fraser Tweedale
--
-- hs-tax-ato is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.


{-|

Types and calculations for /capital gains tax/ (CGT).

This module does not implement the /indexation method/ for cost base reduction.
If you have assets acquired before 1999-09-21 11:45:00+1000… file a ticket or
send a patch!

The main function you need is 'assessCGTEvents'.

-}

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Data.Tax.ATO.CGT
  (
  -- * CGT events
    CGTEvent(..)

  -- * CGT assessments for tax returns
  , assessCGTEvents
  , CGTAssessment(CGTAssessment)
  , CGTNetGainOrLoss(..)
  , HasCapitalLossCarryForward(..)
  , cgtNetGainOrLoss
  , cgtNetGain

  -- * CGT computations
  , 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

-- | A CGT Event (usually an asset disposal)
--
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)

-- | The capital loss as a /non-negative/ amount.
-- /$0/ if the event is not a loss.
--
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)

-- | Whether the CGT event is a capital gain.  /Not the opposite
-- of 'isCapitalLoss'!/  A CGT event may be neither a loss nor a
-- gain.
--
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'

-- | Whether the CGT event is a capital loss.  /Not the opposite
-- of 'isCapitalGain'!/  A CGT event may be neither a loss nor a
-- gain.
--
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

-- | Whether the 50% CGT discount is applicable to this event (only
-- with regard to duration of holding; acquisition date ignored).
--
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

-- | Types that may have a capital gain.  Non-discounted, losses ignored.
class HasCapitalGain a b c where
  capitalGain :: Getter (a b) (Money c)

-- | Capital gain as a positive amount.  /$0/ if the event not a gain.
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'

-- | Sum of capital gains, ignoring losses.
-- Input __H__ at /item 18/ on tax return.
--
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))



-- | Compute the /discounted/ gain or carry-forward loss
--
-- Losses are used to offset non-discountable capital gains
-- first, then discountable gains, before the discount is applied
-- to discountable gains.
--
-- *Does not implement the indexation method for cost-base reduction!*
--
netCapitalGainOrLoss
  :: (Fractional a, Ord a, Foldable t)
  => Money a                     -- ^ loss carried forward
  -> t (CGTEvent a)              -- ^ CGT events
  -> 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 x y@ = subtract @y@ from @x@, clamping to 0 and
-- returning @(result, leftovers)@
--
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))

-- | Assess the total capital gains and net capital gain or loss.
assessCGTEvents
  :: (Fractional a, Ord a, Foldable t)
  => Money a            -- ^ capital loss carried forward
  -> 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)

-- | Total undiscounted gains and net gain/loss for tax assessment
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

-- | The 'CGTNetGainOrLoss' value of the 'CGTAssessment'
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 })

-- | The net capital gain, or zero if a loss.
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

-- | A net (loss offset, discounted) gain, or the loss amount
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)

-- | Types that have a carry-forward capital loss (either as an
-- input or an output).
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