-- This file is part of hs-tax-ato
-- Copyright (C) 2024  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/>.

{-|

Pretty-print tax data.

Monetary values are rounded to the nearest whole cent (half-up).

-}

{-# LANGUAGE OverloadedStrings #-}

module Data.Tax.ATO.Pretty
  ( summariseTaxReturnInfo
  , summariseAssessment
  , summariseCGTAssessment
  ) where

import Data.Function (on)
import Data.List (groupBy, sortOn)

import Control.Lens (ALens', cloneLens, view, views)
import qualified Text.PrettyPrint as P

import Data.Tax.ATO
import Data.Tax.ATO.CGT


colWidthMoney, colWidthLabel :: Int
colWidthMoney :: Int
colWidthMoney = Int
16
colWidthLabel :: Int
colWidthLabel = Int
80 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
colWidthMoney

-- | Format money for display.  Rounds to the nearest whole cent (half-up).
-- Does not prepend '$'.
formatMoney :: Money Rational -> P.Doc
formatMoney :: Money Rational -> Doc
formatMoney (Money Rational
x) =
  String -> Doc
P.text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
colWidthMoney Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
amount) Char
' ' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
amount)
  where
    (Integer
iPart, Rational
fPart) = Rational -> (Integer, Rational)
forall b. Integral b => Rational -> (b, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
100) :: (Integer, Rational)
    iPart' :: Integer
iPart' = if Rational
fPart Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
0.5 then Integer
iPart Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 else Integer
iPart
    digits :: String
digits = String -> String
forall a. [a] -> [a]
reverse (Integer -> String
forall a. Show a => a -> String
show Integer
iPart')
    cents :: String
cents = case String -> String
forall a. [a] -> [a]
reverse (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
digits) of [] -> String
"00" ; [Char
c] -> Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
"0" ; String
s -> String
s
    dollars :: String
dollars = case Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 String
digits of String
"" -> String
"0" ; String
s -> String -> String
forall a. [a] -> [a]
reverse (String -> String
putCommas String
s)
    amount :: String
amount = String
dollars String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cents
    putCommas :: String -> String
putCommas (Char
a:Char
b:Char
c:Char
d:String
rest) | Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-' = Char
aChar -> String -> String
forall a. a -> [a] -> [a]
:Char
bChar -> String -> String
forall a. a -> [a] -> [a]
:Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Char
','Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
putCommas (Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
rest)
    putCommas String
rest                      = String
rest

twoCol :: (P.Doc, Money Rational) -> P.Doc
twoCol :: (Doc, Money Rational) -> Doc
twoCol (Doc
label, Money Rational
value) = Doc
label Doc -> Doc -> Doc
P.$$ Int -> Doc -> Doc
P.nest (Int
80 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
colWidthMoney) (Money Rational -> Doc
formatMoney Money Rational
value)

threeCol :: (P.Doc, Money Rational, Money Rational) -> P.Doc
threeCol :: (Doc, Money Rational, Money Rational) -> Doc
threeCol (Doc
label, Money Rational
v1, Money Rational
v2) =
  Doc
label
  Doc -> Doc -> Doc
P.$$ Int -> Doc -> Doc
P.nest (Int
80 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
colWidthMoney) (Money Rational -> Doc
formatMoney Money Rational
v1)
  Doc -> Doc -> Doc
P.<> Money Rational -> Doc
formatMoney Money Rational
v2

-- | 3-column layout with rightmost column blank
threeColLeft :: (P.Doc, Money Rational) -> P.Doc
threeColLeft :: (Doc, Money Rational) -> Doc
threeColLeft (Doc
label, Money Rational
v1) =
  Doc
label
  Doc -> Doc -> Doc
P.$$ Int -> Doc -> Doc
P.nest (Int
80 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
colWidthMoney) (Money Rational -> Doc
formatMoney Money Rational
v1)

vcatWith :: (a -> P.Doc) -> [a] -> P.Doc
vcatWith :: forall a. (a -> Doc) -> [a] -> Doc
vcatWith a -> Doc
f = [Doc] -> Doc
P.vcat ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Doc
f

summariseTaxReturnInfo :: TaxReturnInfo y Rational -> P.Doc
summariseTaxReturnInfo :: forall (y :: Nat). TaxReturnInfo y Rational -> Doc
summariseTaxReturnInfo TaxReturnInfo y Rational
info =
  Doc
"Income"
  Doc -> Doc -> Doc
P.$+$ ((Doc, Money Rational, Money Rational) -> Doc)
-> [(Doc, Money Rational, Money Rational)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
vcatWith (Doc, Money Rational, Money Rational) -> Doc
threeCol
    [ (Doc
"  1   Salary or wages"  , Getting
  (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
-> TaxReturnInfo y Rational -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (([PaymentSummary Rational]
 -> Const (Money Rational) [PaymentSummary Rational])
-> TaxReturnInfo y Rational
-> Const (Money Rational) (TaxReturnInfo y Rational)
forall (y :: Nat) a (f :: * -> *).
Functor f =>
([PaymentSummary a] -> f [PaymentSummary a])
-> TaxReturnInfo y a -> f (TaxReturnInfo y a)
paymentSummaries (([PaymentSummary Rational]
  -> Const (Money Rational) [PaymentSummary Rational])
 -> TaxReturnInfo y Rational
 -> Const (Money Rational) (TaxReturnInfo y Rational))
-> ((Money Rational -> Const (Money Rational) (Money Rational))
    -> [PaymentSummary Rational]
    -> Const (Money Rational) [PaymentSummary Rational])
-> Getting
     (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Money Rational -> Const (Money Rational) (Money Rational))
-> [PaymentSummary Rational]
-> Const (Money Rational) [PaymentSummary Rational]
forall {k} (a :: k -> *) (b :: k) c.
HasTaxWithheld a b c =>
Getter (a b) (Money c)
Getter [PaymentSummary Rational] (Money Rational)
taxWithheld) TaxReturnInfo y Rational
info, Getting
  (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
-> TaxReturnInfo y Rational -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (([PaymentSummary Rational]
 -> Const (Money Rational) [PaymentSummary Rational])
-> TaxReturnInfo y Rational
-> Const (Money Rational) (TaxReturnInfo y Rational)
forall (y :: Nat) a (f :: * -> *).
Functor f =>
([PaymentSummary a] -> f [PaymentSummary a])
-> TaxReturnInfo y a -> f (TaxReturnInfo y a)
paymentSummaries (([PaymentSummary Rational]
  -> Const (Money Rational) [PaymentSummary Rational])
 -> TaxReturnInfo y Rational
 -> Const (Money Rational) (TaxReturnInfo y Rational))
-> ((Money Rational -> Const (Money Rational) (Money Rational))
    -> [PaymentSummary Rational]
    -> Const (Money Rational) [PaymentSummary Rational])
-> Getting
     (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Money Rational -> Const (Money Rational) (Money Rational))
-> [PaymentSummary Rational]
-> Const (Money Rational) [PaymentSummary Rational]
forall {k} (a :: k -> *) (b :: k) c.
HasTaxableIncome a b c =>
Getter (a b) (Money c)
Getter [PaymentSummary Rational] (Money Rational)
taxableIncome) TaxReturnInfo y Rational
info)
    , (Doc
"  10  Interest"         , Getting
  (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
-> TaxReturnInfo y Rational -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((GrossAndWithheld Rational
 -> Const (Money Rational) (GrossAndWithheld Rational))
-> TaxReturnInfo y Rational
-> Const (Money Rational) (TaxReturnInfo y Rational)
forall (y :: Nat) a (f :: * -> *).
Functor f =>
(GrossAndWithheld a -> f (GrossAndWithheld a))
-> TaxReturnInfo y a -> f (TaxReturnInfo y a)
interest ((GrossAndWithheld Rational
  -> Const (Money Rational) (GrossAndWithheld Rational))
 -> TaxReturnInfo y Rational
 -> Const (Money Rational) (TaxReturnInfo y Rational))
-> ((Money Rational -> Const (Money Rational) (Money Rational))
    -> GrossAndWithheld Rational
    -> Const (Money Rational) (GrossAndWithheld Rational))
-> Getting
     (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Money Rational -> Const (Money Rational) (Money Rational))
-> GrossAndWithheld Rational
-> Const (Money Rational) (GrossAndWithheld Rational)
forall {k} (a :: k -> *) (b :: k) c.
HasTaxWithheld a b c =>
Getter (a b) (Money c)
Getter (GrossAndWithheld Rational) (Money Rational)
taxWithheld) TaxReturnInfo y Rational
info, Getting
  (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
-> TaxReturnInfo y Rational -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((GrossAndWithheld Rational
 -> Const (Money Rational) (GrossAndWithheld Rational))
-> TaxReturnInfo y Rational
-> Const (Money Rational) (TaxReturnInfo y Rational)
forall (y :: Nat) a (f :: * -> *).
Functor f =>
(GrossAndWithheld a -> f (GrossAndWithheld a))
-> TaxReturnInfo y a -> f (TaxReturnInfo y a)
interest ((GrossAndWithheld Rational
  -> Const (Money Rational) (GrossAndWithheld Rational))
 -> TaxReturnInfo y Rational
 -> Const (Money Rational) (TaxReturnInfo y Rational))
-> ((Money Rational -> Const (Money Rational) (Money Rational))
    -> GrossAndWithheld Rational
    -> Const (Money Rational) (GrossAndWithheld Rational))
-> Getting
     (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Money Rational -> Const (Money Rational) (Money Rational))
-> GrossAndWithheld Rational
-> Const (Money Rational) (GrossAndWithheld Rational)
forall {k} (a :: k -> *) (b :: k) c.
HasTaxableIncome a b c =>
Getter (a b) (Money c)
Getter (GrossAndWithheld Rational) (Money Rational)
taxableIncome) TaxReturnInfo y Rational
info)
    ]
  Doc -> Doc -> Doc
P.$+$ Doc
"  11  Dividends"
  Doc -> Doc -> Doc
P.$+$ LensLike'
  (Const Doc) (TaxReturnInfo y Rational) [Dividend Rational]
-> ([Dividend Rational] -> Doc) -> TaxReturnInfo y Rational -> Doc
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike'
  (Const Doc) (TaxReturnInfo y Rational) [Dividend Rational]
forall (y :: Nat) a (f :: * -> *).
Functor f =>
([Dividend a] -> f [Dividend a])
-> TaxReturnInfo y a -> f (TaxReturnInfo y a)
dividends [Dividend Rational] -> Doc
summariseDividends TaxReturnInfo y Rational
info
  Doc -> Doc -> Doc
P.$+$ ((Doc, Money Rational) -> Doc) -> [(Doc, Money Rational)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
vcatWith (Doc, Money Rational) -> Doc
twoCol
    [ (Doc
"  12  Employee share schemes" , Getting
  (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
-> TaxReturnInfo y Rational -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ESSStatement Rational
 -> Const (Money Rational) (ESSStatement Rational))
-> TaxReturnInfo y Rational
-> Const (Money Rational) (TaxReturnInfo y Rational)
forall (y :: Nat) a (f :: * -> *).
Functor f =>
(ESSStatement a -> f (ESSStatement a))
-> TaxReturnInfo y a -> f (TaxReturnInfo y a)
ess ((ESSStatement Rational
  -> Const (Money Rational) (ESSStatement Rational))
 -> TaxReturnInfo y Rational
 -> Const (Money Rational) (TaxReturnInfo y Rational))
-> ((Money Rational -> Const (Money Rational) (Money Rational))
    -> ESSStatement Rational
    -> Const (Money Rational) (ESSStatement Rational))
-> Getting
     (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Money Rational -> Const (Money Rational) (Money Rational))
-> ESSStatement Rational
-> Const (Money Rational) (ESSStatement Rational)
forall {k} (a :: k -> *) (b :: k) c.
HasTaxableIncome a b c =>
Getter (a b) (Money c)
Getter (ESSStatement Rational) (Money Rational)
taxableIncome) TaxReturnInfo y Rational
info)
    , (Doc
"  20M Other net foreign source income" , Getting
  (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
-> TaxReturnInfo y Rational -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
forall (y :: Nat) a (f :: * -> *).
Functor f =>
(Money a -> f (Money a))
-> TaxReturnInfo y a -> f (TaxReturnInfo y a)
foreignIncome TaxReturnInfo y Rational
info)
    ]
  Doc -> Doc -> Doc
P.$+$ Doc
"Deductions"
  Doc -> Doc -> Doc
P.$+$ [Doc] -> Doc
P.vcat ((ALens' (Deductions Rational) (Money Rational) -> String -> Doc)
-> (ALens' (Deductions Rational) (Money Rational), String) -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Deductions Rational
-> ALens' (Deductions Rational) (Money Rational) -> String -> Doc
summariseDeduction (Getting
  (Deductions Rational)
  (TaxReturnInfo y Rational)
  (Deductions Rational)
-> TaxReturnInfo y Rational -> Deductions Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Deductions Rational)
  (TaxReturnInfo y Rational)
  (Deductions Rational)
forall (y :: Nat) a (f :: * -> *).
Functor f =>
(Deductions a -> f (Deductions a))
-> TaxReturnInfo y a -> f (TaxReturnInfo y a)
deductions TaxReturnInfo y Rational
info)) ((ALens' (Deductions Rational) (Money Rational), String) -> Doc)
-> [(ALens' (Deductions Rational) (Money Rational), String)]
-> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ALens' (Deductions Rational) (Money Rational), String)]
deductionsTable)
  Doc -> Doc -> Doc
P.$+$ Doc
"Tax offsets"
  Doc -> Doc -> Doc
P.$+$ ((Doc, Money Rational) -> Doc) -> [(Doc, Money Rational)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
vcatWith (Doc, Money Rational) -> Doc
threeColLeft
    [ (Doc
"  20O Foreign income tax offset"  , Getting
  (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
-> TaxReturnInfo y Rational -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Offsets Rational -> Const (Money Rational) (Offsets Rational))
-> TaxReturnInfo y Rational
-> Const (Money Rational) (TaxReturnInfo y Rational)
forall (y :: Nat) a (f :: * -> *).
Functor f =>
(Offsets a -> f (Offsets a))
-> TaxReturnInfo y a -> f (TaxReturnInfo y a)
offsets ((Offsets Rational -> Const (Money Rational) (Offsets Rational))
 -> TaxReturnInfo y Rational
 -> Const (Money Rational) (TaxReturnInfo y Rational))
-> ((Money Rational -> Const (Money Rational) (Money Rational))
    -> Offsets Rational -> Const (Money Rational) (Offsets Rational))
-> Getting
     (Money Rational) (TaxReturnInfo y Rational) (Money Rational)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Money Rational -> Const (Money Rational) (Money Rational))
-> Offsets Rational -> Const (Money Rational) (Offsets Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Offsets a -> f (Offsets a)
foreignTaxOffset) TaxReturnInfo y Rational
info)
    ]

summariseDividends :: [Dividend Rational] -> P.Doc
summariseDividends :: [Dividend Rational] -> Doc
summariseDividends =
  ([Dividend Rational] -> Doc) -> [[Dividend Rational]] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
vcatWith ((Doc, Money Rational, Money Rational) -> Doc
threeCol ((Doc, Money Rational, Money Rational) -> Doc)
-> ([Dividend Rational] -> (Doc, Money Rational, Money Rational))
-> [Dividend Rational]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Dividend Rational] -> (Doc, Money Rational, Money Rational)
prep)
  ([[Dividend Rational]] -> Doc)
-> ([Dividend Rational] -> [[Dividend Rational]])
-> [Dividend Rational]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dividend Rational -> Dividend Rational -> Bool)
-> [Dividend Rational] -> [[Dividend Rational]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> (Dividend Rational -> String)
-> Dividend Rational
-> Dividend Rational
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Dividend Rational -> String
forall a. Dividend a -> String
dividendSource)
  ([Dividend Rational] -> [[Dividend Rational]])
-> ([Dividend Rational] -> [Dividend Rational])
-> [Dividend Rational]
-> [[Dividend Rational]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dividend Rational -> String)
-> [Dividend Rational] -> [Dividend Rational]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Dividend Rational -> String
forall a. Dividend a -> String
dividendSource
  where
    prep :: [Dividend Rational] -> (P.Doc, Money Rational, Money Rational)
    prep :: [Dividend Rational] -> (Doc, Money Rational, Money Rational)
prep [Dividend Rational]
l =
      ( String -> Doc
P.text (String
"        " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Dividend Rational -> String
forall a. Dividend a -> String
dividendSource ([Dividend Rational] -> Dividend Rational
forall a. HasCallStack => [a] -> a
head [Dividend Rational]
l))
      , Getting (Money Rational) [Dividend Rational] (Money Rational)
-> [Dividend Rational] -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Money Rational) [Dividend Rational] (Money Rational)
forall {k} (a :: k -> *) (b :: k) c.
HasTaxWithheld a b c =>
Getter (a b) (Money c)
Getter [Dividend Rational] (Money Rational)
taxWithheld [Dividend Rational]
l
      , Getting (Money Rational) [Dividend Rational] (Money Rational)
-> [Dividend Rational] -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Money Rational) [Dividend Rational] (Money Rational)
forall {k} (a :: k -> *) (b :: k) c.
HasTaxableIncome a b c =>
Getter (a b) (Money c)
Getter [Dividend Rational] (Money Rational)
taxableIncome [Dividend Rational]
l
      )

deductionsTable :: [(ALens' (Deductions Rational) (Money Rational), String)]
deductionsTable :: [(ALens' (Deductions Rational) (Money Rational), String)]
deductionsTable =
  [ (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
workRelatedCarExpenses, String
"D1  Work-related car expenses")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
workRelatedTravelExpenses, String
"D2  Work-related travel expenses")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
workRelatedClothingLaundryAndDryCleaningExpenses, String
"D3  Work-related clothing, laundry and dry cleaning expenses")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
workRelatedSelfEducationExpenses, String
"D4  Work-related self-education expenses")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
otherWorkRelatedExpenses, String
"D5  Other work-related expenses")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
lowValuePoolDeduction, String
"D6  Low value pool deduction")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
interestDeductions, String
"D7  Interest deductions")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
dividendDeductions, String
"D8  Dividend deductions")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
giftsOrDonations, String
"D9  Gifts or donations")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
costOfManagingTaxAffairs, String
"D10 Cost of managing tax affairs")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
deductibleAmountOfUndeductedPurchasePriceOfAForeignPensionOrAnnuity, String
"D11 Deductible amount of undeducted purchase price of a foreign pension or annuity")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
personalSuperannuationContributions, String
"D12 Personal superannuation contributions")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
deductionForProjectPool, String
"D13 Deduction for project pool")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
forestryManagedInvestmentSchemeDeduction, String
"D14 Forestry managed investment scheme deduction")
  , (ALens' (Deductions Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> Deductions a -> f (Deductions a)
otherDeductions, String
"D15 Other deductions")
  ]

summariseDeduction
  :: Deductions Rational
  -> ALens' (Deductions Rational) (Money Rational)
  -> String
  -> P.Doc
summariseDeduction :: Deductions Rational
-> ALens' (Deductions Rational) (Money Rational) -> String -> Doc
summariseDeduction Deductions Rational
a ALens' (Deductions Rational) (Money Rational)
l String
desc
  | Money Rational
amt Money Rational -> Money Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Money Rational
forall a. Monoid a => a
mempty
  = Int -> Doc -> Doc
P.nest Int
2 (String -> Doc
P.text String
desc) Doc -> Doc -> Doc
P.$$ Int -> Doc -> Doc
P.nest Int
colWidthLabel (Money Rational -> Doc
formatMoney Money Rational
amt)
  | Bool
otherwise
  = Doc
P.empty
  where
    amt :: Money Rational
amt = Getting (Money Rational) (Deductions Rational) (Money Rational)
-> Deductions Rational -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (ALens' (Deductions Rational) (Money Rational)
-> Lens
     (Deductions Rational)
     (Deductions Rational)
     (Money Rational)
     (Money Rational)
forall s t a b. ALens s t a b -> Lens s t a b
cloneLens ALens' (Deductions Rational) (Money Rational)
l) Deductions Rational
a


summariseAssessment :: TaxAssessment Rational -> P.Doc
summariseAssessment :: TaxAssessment Rational -> Doc
summariseAssessment TaxAssessment Rational
assessment =
  Doc
"Your taxable income is $" Doc -> Doc -> Doc
P.<> Money Rational -> Doc
formatMoney (Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
-> TaxAssessment Rational -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
forall {k} (a :: k -> *) (b :: k) c.
HasTaxableIncome a b c =>
Getter (a b) (Money c)
Getter (TaxAssessment Rational) (Money Rational)
taxableIncome TaxAssessment Rational
assessment)
  Doc -> Doc -> Doc
P.$+$ String -> Doc
P.text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
80 Char
'-')
  Doc -> Doc -> Doc
P.$+$ ((Doc, Money Rational) -> Doc) -> [(Doc, Money Rational)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
vcatWith (Doc, Money Rational) -> Doc
twoCol
    [ (Doc
"Tax on your taxable income"                 , Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
-> TaxAssessment Rational -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
forall a (f :: * -> *).
(Contravariant f, Functor f) =>
(Money a -> f (Money a)) -> TaxAssessment a -> f (TaxAssessment a)
taxDue TaxAssessment Rational
assessment)
    , (Doc
"Less credits and offsets"                   , Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
-> (Money Rational -> Money Rational)
-> TaxAssessment Rational
-> Money Rational
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
forall a (f :: * -> *).
(Contravariant f, Functor f) =>
(Money a -> f (Money a)) -> TaxAssessment a -> f (TaxAssessment a)
taxCreditsAndOffsets ((Rational -> Rational) -> Money Rational -> Money Rational
forall a b. (a -> b) -> Money a -> Money b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Rational
forall a. Num a => a -> a
negate) TaxAssessment Rational
assessment)
    , (Doc
"Medicare levy (and surcharge, if any)"      , Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
-> TaxAssessment Rational -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
forall a (f :: * -> *).
(Contravariant f, Functor f) =>
(Money a -> f (Money a)) -> TaxAssessment a -> f (TaxAssessment a)
medicareLevyDue TaxAssessment Rational
assessment)
    , (Doc
"Study and training loan repayment"          , Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
-> TaxAssessment Rational -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> TaxAssessment a -> f (TaxAssessment a)
studyAndTrainingLoanRepayment TaxAssessment Rational
assessment)
    , (Doc
"Excess private health reduction or refund"  , Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
-> TaxAssessment Rational -> Money Rational
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> TaxAssessment a -> f (TaxAssessment a)
privateHealthInsuranceRebateAdjustment TaxAssessment Rational
assessment)
    , (Doc
"Less PAYG withholding"                      , Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
-> (Money Rational -> Money Rational)
-> TaxAssessment Rational
-> Money Rational
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
forall {k} (a :: k -> *) (b :: k) c.
HasTaxWithheld a b c =>
Getter (a b) (Money c)
Getter (TaxAssessment Rational) (Money Rational)
taxWithheld ((Rational -> Rational) -> Money Rational -> Money Rational
forall a b. (a -> b) -> Money a -> Money b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Rational
forall a. Num a => a -> a
negate) TaxAssessment Rational
assessment)
    , (Doc
"Less PAYG instalments"                      , Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
-> (Money Rational -> Money Rational)
-> TaxAssessment Rational
-> Money Rational
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Getting (Money Rational) (TaxAssessment Rational) (Money Rational)
forall a (f :: * -> *).
Functor f =>
(Money a -> f (Money a)) -> TaxAssessment a -> f (TaxAssessment a)
paygInstalmentsCredit ((Rational -> Rational) -> Money Rational -> Money Rational
forall a b. (a -> b) -> Money a -> Money b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Rational
forall a. Num a => a -> a
negate) TaxAssessment Rational
assessment)
    ]
  Doc -> Doc -> Doc
P.$+$ String -> Doc
P.text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
80 Char
'-')
  Doc -> Doc -> Doc
P.$+$ Doc
"Result of this notice" Doc -> Doc -> Doc
P.$$ Int -> Doc -> Doc
P.nest Int
colWidthLabel (LensLike' (Const Doc) (TaxAssessment Rational) (Money Rational)
-> (Money Rational -> Doc) -> TaxAssessment Rational -> Doc
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const Doc) (TaxAssessment Rational) (Money Rational)
forall a. Num a => Getter (TaxAssessment a) (Money a)
Getter (TaxAssessment Rational) (Money Rational)
taxBalance Money Rational -> Doc
formatMoney TaxAssessment Rational
assessment)
  Doc -> Doc -> Doc
P.$+$ Doc
"Net capital loss to carry forward" Doc -> Doc -> Doc
P.$$ Int -> Doc -> Doc
P.nest Int
colWidthLabel (LensLike' (Const Doc) (TaxAssessment Rational) (Money Rational)
-> (Money Rational -> Doc) -> TaxAssessment Rational -> Doc
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((CGTAssessment Rational -> Const Doc (CGTAssessment Rational))
-> TaxAssessment Rational -> Const Doc (TaxAssessment Rational)
forall a (f :: * -> *).
Functor f =>
(CGTAssessment a -> f (CGTAssessment a))
-> TaxAssessment a -> f (TaxAssessment a)
taxCGTAssessment ((CGTAssessment Rational -> Const Doc (CGTAssessment Rational))
 -> TaxAssessment Rational -> Const Doc (TaxAssessment Rational))
-> ((Money Rational -> Const Doc (Money Rational))
    -> CGTAssessment Rational -> Const Doc (CGTAssessment Rational))
-> LensLike' (Const Doc) (TaxAssessment Rational) (Money Rational)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Money Rational -> Const Doc (Money Rational))
-> CGTAssessment Rational -> Const Doc (CGTAssessment Rational)
Lens' (CGTAssessment Rational) (Money Rational)
forall (a :: * -> *) b.
HasCapitalLossCarryForward a b =>
Lens' (a b) (Money b)
capitalLossCarryForward) Money Rational -> Doc
formatMoney TaxAssessment Rational
assessment)

summariseCGTAssessment :: CGTAssessment Rational -> P.Doc
summariseCGTAssessment :: CGTAssessment Rational -> Doc
summariseCGTAssessment cgtAss :: CGTAssessment Rational
cgtAss@(CGTAssessment Money Rational
total CGTNetGainOrLoss Rational
_) =
  Doc
"Total FY capital gains" Doc -> Doc -> Doc
P.$$ (Int -> Doc -> Doc
P.nest Int
colWidthLabel (Doc -> Doc) -> (Money Rational -> Doc) -> Money Rational -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Money Rational -> Doc
formatMoney) Money Rational
total
  Doc -> Doc -> Doc
P.$+$ Doc
"Net capital gain" Doc -> Doc -> Doc
P.$$ Int -> Doc -> Doc
P.nest Int
colWidthLabel (((Money Rational -> Const Doc (Money Rational))
 -> CGTAssessment Rational -> Const Doc (CGTAssessment Rational))
-> (Money Rational -> Doc) -> CGTAssessment Rational -> Doc
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (Money Rational -> Const Doc (Money Rational))
-> CGTAssessment Rational -> Const Doc (CGTAssessment Rational)
forall a. Num a => Getter (CGTAssessment a) (Money a)
Getter (CGTAssessment Rational) (Money Rational)
cgtNetGain Money Rational -> Doc
formatMoney CGTAssessment Rational
cgtAss)
  Doc -> Doc -> Doc
P.$+$ Doc
"Net capital loss to carry forward" Doc -> Doc -> Doc
P.$$ Int -> Doc -> Doc
P.nest Int
colWidthLabel (((Money Rational -> Const Doc (Money Rational))
 -> CGTAssessment Rational -> Const Doc (CGTAssessment Rational))
-> (Money Rational -> Doc) -> CGTAssessment Rational -> Doc
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (Money Rational -> Const Doc (Money Rational))
-> CGTAssessment Rational -> Const Doc (CGTAssessment Rational)
Lens' (CGTAssessment Rational) (Money Rational)
forall (a :: * -> *) b.
HasCapitalLossCarryForward a b =>
Lens' (a b) (Money b)
capitalLossCarryForward Money Rational -> Doc
formatMoney CGTAssessment Rational
cgtAss)