-- 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
[CGTEvent a] -> ShowS
CGTEvent a -> String
(Int -> CGTEvent a -> ShowS)
-> (CGTEvent a -> String)
-> ([CGTEvent a] -> ShowS)
-> Show (CGTEvent a)
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
$cshowsPrec :: forall a. Show a => Int -> CGTEvent a -> ShowS
showsPrec :: Int -> CGTEvent a -> ShowS
$cshow :: forall a. Show a => CGTEvent a -> String
show :: CGTEvent a -> String
$cshowList :: forall a. Show a => [CGTEvent a] -> ShowS
showList :: [CGTEvent a] -> ShowS
Show)

instance Functor CGTEvent where
  fmap :: forall a b. (a -> b) -> CGTEvent a -> CGTEvent b
fmap a -> b
f (CGTEvent String
k a
n Day
t1 Money a
p1 Money a
b1 Day
t2 Money a
p2 Money a
b2 Money a
cap Money a
own) =
    String
-> b
-> Day
-> Money b
-> Money b
-> Day
-> Money b
-> Money b
-> Money b
-> Money b
-> CGTEvent b
forall a.
String
-> a
-> Day
-> Money a
-> Money a
-> Day
-> Money a
-> Money a
-> Money a
-> Money a
-> CGTEvent a
CGTEvent String
k (a -> b
f a
n)
      Day
t1 (a -> b
f (a -> b) -> Money a -> Money b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Money a
p1) (a -> b
f (a -> b) -> Money a -> Money b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Money a
b1)
      Day
t2 (a -> b
f (a -> b) -> Money a -> Money b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Money a
p2) (a -> b
f (a -> b) -> Money a -> Money b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Money a
b2)
      (a -> b
f (a -> b) -> Money a -> Money b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Money a
cap) (a -> b
f (a -> b) -> Money a -> Money b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Money a
own)

reducedCostBase :: Num a => CGTEvent a -> Money a
reducedCostBase :: forall a. Num a => CGTEvent a -> Money a
reducedCostBase CGTEvent a
event =
  (CGTEvent a -> a
forall a. CGTEvent a -> a
units CGTEvent a
event a -> Money a -> Money a
forall a. Num a => a -> Money a -> Money a
*$ CGTEvent a -> Money a
forall a. CGTEvent a -> Money a
acquisitionPrice CGTEvent a
event)
  Money a -> Money a -> Money a
forall a. Num a => Money a -> Money a -> Money a
$+$ CGTEvent a -> Money a
forall a. CGTEvent a -> Money a
acquisitionCosts CGTEvent a
event
  Money a -> Money a -> Money a
forall a. Num a => Money a -> Money a -> Money a
$+$ CGTEvent a -> Money a
forall a. CGTEvent a -> Money a
disposalCosts CGTEvent a
event
  Money a -> Money a -> Money a
forall a. Num a => Money a -> Money a -> Money a
$+$ CGTEvent 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 = CGTEvent a -> Money a
forall a. Num a => CGTEvent a -> Money a
reducedCostBase CGTEvent a
event Money a -> Money a -> Money a
forall a. Num a => Money a -> Money a -> Money a
$+$ CGTEvent 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 =
  Money a -> Money a -> Money a
forall a. Ord a => a -> a -> a
max Money a
forall a. Monoid a => a
mempty (CGTEvent a -> a
forall a. CGTEvent a -> a
units CGTEvent a
event a -> Money a -> Money a
forall a. Num a => a -> Money a -> Money a
*$ CGTEvent a -> Money a
forall a. CGTEvent a -> Money a
disposalPrice CGTEvent a
event Money a -> Money a -> Money a
forall a. Num a => Money a -> Money a -> Money a
$-$ CGTEvent 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 = ASetter (Money a) (Money a) a a -> (a -> a) -> Money a -> Money a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Money a) (Money a) a a
forall a b (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p a (f b) -> p (Money a) (f (Money b))
money a -> a
forall a. Num a => a -> a
abs (Money a -> Money a) -> Money a -> Money a
forall a b. (a -> b) -> a -> b
$
  Money a -> Money a -> Money a
forall a. Ord a => a -> a -> a
min Money a
forall a. Monoid a => a
mempty (CGTEvent a -> a
forall a. CGTEvent a -> a
units CGTEvent a
event a -> Money a -> Money a
forall a. Num a => a -> Money a -> Money a
*$ CGTEvent a -> Money a
forall a. CGTEvent a -> Money a
disposalPrice CGTEvent a
event Money a -> Money a -> Money a
forall a. Num a => Money a -> Money a -> Money a
$-$ CGTEvent 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 = (Money a -> Money a -> Bool
forall a. Ord a => a -> a -> Bool
> Money a
forall a. Monoid a => a
mempty) (Money a -> Bool) -> (CGTEvent a -> Money a) -> CGTEvent a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CGTEvent a -> Money a
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 = (Money a -> Money a -> Bool
forall a. Ord a => a -> a -> Bool
> Money a
forall a. Monoid a => a
mempty) (Money a -> Bool) -> (CGTEvent a -> Money a) -> CGTEvent a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CGTEvent a -> Money a
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 (CGTEvent a -> Day
forall a. CGTEvent a -> Day
disposalDate CGTEvent a
ev) (CGTEvent a -> Day
forall a. CGTEvent a -> Day
acquisitionDate CGTEvent a
ev) Integer -> Integer -> Bool
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 = (CGTEvent a -> Money a)
-> (Money a -> f (Money a)) -> CGTEvent a -> f (CGTEvent a)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to CGTEvent a -> Money a
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 = (t (x a) -> Money a)
-> (Money a -> f (Money a)) -> t (x a) -> f (t (x a))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((x a -> Money a) -> t (x a) -> Money a
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Getting (Money a) (x a) (Money a) -> x a -> Money a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Money a) (x a) (Money a)
Getter (x a) (Money a)
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 = t (CGTEvent a) -> [CGTEvent a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t (CGTEvent a)
events
    (Money a
discountableGain, Money a
nonDiscountableGain) =
      ASetter
  ([CGTEvent a], [CGTEvent a])
  (Money a, Money a)
  [CGTEvent a]
  (Money a)
-> ([CGTEvent a] -> Money a)
-> ([CGTEvent a], [CGTEvent a])
-> (Money a, Money a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ([CGTEvent a], [CGTEvent a])
  (Money a, Money a)
  [CGTEvent a]
  (Money a)
Traversal
  ([CGTEvent a], [CGTEvent a])
  (Money a, Money a)
  [CGTEvent a]
  (Money a)
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (Getting (Money a) [CGTEvent a] (Money a) -> [CGTEvent a] -> Money a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Money a) [CGTEvent a] (Money a)
Getter [CGTEvent a] (Money a)
forall (a :: * -> *) b c.
HasCapitalGain a b c =>
Getter (a b) (Money c)
capitalGain) ((CGTEvent a -> Bool)
-> [CGTEvent a] -> ([CGTEvent a], [CGTEvent a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition CGTEvent a -> Bool
forall a. CGTEvent a -> Bool
discountApplicable [CGTEvent a]
l)
    loss :: Money a
loss = (CGTEvent a -> Money a) -> [CGTEvent a] -> Money a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap CGTEvent a -> Money a
forall a. (Num a, Ord a) => CGTEvent a -> Money a
capitalLoss [CGTEvent a]
l
    (Money a
nonDiscLessLoss, Money a
remLoss) = Money a -> Money a -> (Money a, Money a)
forall a.
(Num a, Ord a) =>
Money a -> Money a -> (Money a, Money a)
sub Money a
nonDiscountableGain (Money a
loss Money a -> Money a -> Money a
forall a. Semigroup a => a -> a -> a
<> Money a
carry)
    (Money a
discLessLoss, Money a
finalLoss) = Money a -> Money a -> (Money a, Money a)
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 Money a -> Money a -> Money a
forall a. Semigroup a => a -> a -> a
<> (Money a
discLessLoss Money a -> a -> Money a
forall a. Num a => Money a -> a -> Money a
$* a
0.5)
  in
    if Money a
discGain Money a -> Money a -> Bool
forall a. Ord a => a -> a -> Bool
> Money a
forall a. Monoid a => a
mempty
    then Money a -> CGTNetGainOrLoss a
forall a. Money a -> CGTNetGainOrLoss a
CGTNetGain Money a
discGain
    else Money a -> CGTNetGainOrLoss a
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 Money a -> Money a -> Money a
forall a. Num a => Money a -> Money a -> Money a
$-$ Money a
y
  in (Money a -> Money a -> Money a
forall a. Ord a => a -> a -> a
max Money a
forall a. Monoid a => a
mempty Money a
r, ASetter (Money a) (Money a) a a -> (a -> a) -> Money a -> Money a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Money a) (Money a) a a
forall a b (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p a (f b) -> p (Money a) (f (Money b))
money a -> a
forall a. Num a => a -> a
abs (Money a -> Money a -> Money a
forall a. Ord a => a -> a -> a
min Money a
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 = Money a -> CGTNetGainOrLoss a -> CGTAssessment a
forall a. Money a -> CGTNetGainOrLoss a -> CGTAssessment a
CGTAssessment
  (Getting (Money a) (t (CGTEvent a)) (Money a)
-> t (CGTEvent a) -> Money a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Money a) (t (CGTEvent a)) (Money a)
Getter (t (CGTEvent a)) (Money a)
forall (a :: * -> *) b c.
HasCapitalGain a b c =>
Getter (a b) (Money c)
capitalGain t (CGTEvent a)
evs)
  (Money a -> t (CGTEvent a) -> CGTNetGainOrLoss a
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
[CGTAssessment a] -> ShowS
CGTAssessment a -> String
(Int -> CGTAssessment a -> ShowS)
-> (CGTAssessment a -> String)
-> ([CGTAssessment a] -> ShowS)
-> Show (CGTAssessment a)
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
$cshowsPrec :: forall a. Show a => Int -> CGTAssessment a -> ShowS
showsPrec :: Int -> CGTAssessment a -> ShowS
$cshow :: forall a. Show a => CGTAssessment a -> String
show :: CGTAssessment a -> String
$cshowList :: forall a. Show a => [CGTAssessment a] -> ShowS
showList :: [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) = Money b -> CGTNetGainOrLoss b -> CGTAssessment b
forall a. Money a -> CGTNetGainOrLoss a -> CGTAssessment a
CGTAssessment ((a -> b) -> Money a -> Money b
forall a b. (a -> b) -> Money a -> Money b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Money a
a) ((a -> b) -> CGTNetGainOrLoss a -> CGTNetGainOrLoss b
forall a b. (a -> b) -> CGTNetGainOrLoss a -> CGTNetGainOrLoss b
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 = (CGTAssessment a -> Money a)
-> (Money a -> f (Money a))
-> CGTAssessment a
-> f (CGTAssessment a)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to CGTAssessment a -> Money a
forall a. CGTAssessment a -> Money a
_cgtaTotal

-- | The 'CGTNetGainOrLoss' value of the 'CGTAssessment'
cgtNetGainOrLoss :: Lens' (CGTAssessment a) (CGTNetGainOrLoss a)
cgtNetGainOrLoss :: forall a (f :: * -> *).
Functor f =>
(CGTNetGainOrLoss a -> f (CGTNetGainOrLoss a))
-> CGTAssessment a -> f (CGTAssessment a)
cgtNetGainOrLoss = (CGTAssessment a -> CGTNetGainOrLoss a)
-> (CGTAssessment a -> CGTNetGainOrLoss a -> CGTAssessment a)
-> Lens
     (CGTAssessment a)
     (CGTAssessment a)
     (CGTNetGainOrLoss a)
     (CGTNetGainOrLoss a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CGTAssessment a -> CGTNetGainOrLoss a
forall a. CGTAssessment a -> CGTNetGainOrLoss a
_cgtaNet (\CGTAssessment a
s CGTNetGainOrLoss a
b -> CGTAssessment a
s { _cgtaNet = 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 = (CGTNetGainOrLoss a -> f (CGTNetGainOrLoss a))
-> CGTAssessment a -> f (CGTAssessment a)
forall a (f :: * -> *).
Functor f =>
(CGTNetGainOrLoss a -> f (CGTNetGainOrLoss a))
-> CGTAssessment a -> f (CGTAssessment a)
cgtNetGainOrLoss ((CGTNetGainOrLoss a -> f (CGTNetGainOrLoss a))
 -> CGTAssessment a -> f (CGTAssessment a))
-> ((Money a -> f (Money a))
    -> CGTNetGainOrLoss a -> f (CGTNetGainOrLoss a))
-> (Money a -> f (Money a))
-> CGTAssessment a
-> f (CGTAssessment a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CGTNetGainOrLoss a -> Money a)
-> (Money a -> f (Money a))
-> CGTNetGainOrLoss a
-> f (CGTNetGainOrLoss a)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to CGTNetGainOrLoss a -> Money a
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
_ = Money 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
[CGTNetGainOrLoss a] -> ShowS
CGTNetGainOrLoss a -> String
(Int -> CGTNetGainOrLoss a -> ShowS)
-> (CGTNetGainOrLoss a -> String)
-> ([CGTNetGainOrLoss a] -> ShowS)
-> Show (CGTNetGainOrLoss a)
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
$cshowsPrec :: forall a. Show a => Int -> CGTNetGainOrLoss a -> ShowS
showsPrec :: Int -> CGTNetGainOrLoss a -> ShowS
$cshow :: forall a. Show a => CGTNetGainOrLoss a -> String
show :: CGTNetGainOrLoss a -> String
$cshowList :: forall a. Show a => [CGTNetGainOrLoss a] -> ShowS
showList :: [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) = Money b -> CGTNetGainOrLoss b
forall a. Money a -> CGTNetGainOrLoss a
CGTNetGain ((a -> b) -> Money a -> Money b
forall a b. (a -> b) -> Money a -> Money b
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)    = Money b -> CGTNetGainOrLoss b
forall a. Money a -> CGTNetGainOrLoss a
CGTLoss ((a -> b) -> Money a -> Money b
forall a b. (a -> b) -> Money a -> Money b
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 = (CGTNetGainOrLoss a -> Money a)
-> (CGTNetGainOrLoss a -> Money a -> CGTNetGainOrLoss a)
-> Lens' (CGTNetGainOrLoss a) (Money a)
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
_ -> Money a
forall a. Monoid a => a
mempty)
    (\CGTNetGainOrLoss a
s Money a
b -> if Money a
b Money a -> Money a -> Bool
forall a. Eq a => a -> a -> Bool
== Money a
forall a. Monoid a => a
mempty then CGTNetGainOrLoss a
s else Money a -> CGTNetGainOrLoss a
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 = (CGTNetGainOrLoss a -> f (CGTNetGainOrLoss a))
-> CGTAssessment a -> f (CGTAssessment a)
forall a (f :: * -> *).
Functor f =>
(CGTNetGainOrLoss a -> f (CGTNetGainOrLoss a))
-> CGTAssessment a -> f (CGTAssessment a)
cgtNetGainOrLoss ((CGTNetGainOrLoss a -> f (CGTNetGainOrLoss a))
 -> CGTAssessment a -> f (CGTAssessment a))
-> ((Money a -> f (Money a))
    -> CGTNetGainOrLoss a -> f (CGTNetGainOrLoss a))
-> (Money a -> f (Money a))
-> CGTAssessment a
-> f (CGTAssessment a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Money a -> f (Money a))
-> CGTNetGainOrLoss a -> f (CGTNetGainOrLoss a)
Lens' (CGTNetGainOrLoss a) (Money a)
forall (a :: * -> *) b.
HasCapitalLossCarryForward a b =>
Lens' (a b) (Money b)
capitalLossCarryForward