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

{-| Rounding functions used by ATO -}
module Data.Tax.ATO.Rounding
  ( wholeDollars
  , roundCents
  ) where

import Data.Tax

-- | Round half up
roundHalfUp :: (RealFrac a, Integral b) => a -> b
roundHalfUp :: forall a b. (RealFrac a, Integral b) => a -> b
roundHalfUp a
x =
  let
    (b
n, a
r) = a -> (b, a)
forall b. Integral b => a -> (b, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction a
x
  in
    case a -> a
forall a. Num a => a -> a
signum (a -> a
forall a. Num a => a -> a
abs a
r a -> a -> a
forall a. Num a => a -> a -> a
- a
0.5) of
      -1 -> b
n
      a
0 -> if a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then b
n else b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1
      a
_ -> if a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
- b
1 else b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1

-- | Discard cents
wholeDollars :: (RealFrac a) => Money a -> Money a
wholeDollars :: forall a. RealFrac a => Money a -> Money a
wholeDollars = (a -> a) -> Money a -> Money a
forall a b. (a -> b) -> Money a -> Money b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> (a -> Integer) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate)

-- | Round money to the cent (half-up)
roundCents :: (RealFrac a) => Money a -> Money a
roundCents :: forall a. RealFrac a => Money a -> Money a
roundCents = (a -> a) -> Money a -> Money a
forall a b. (a -> b) -> Money a -> Money b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
100)(a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> (a -> Integer) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
roundHalfUp (a -> Integer) -> (a -> a) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a
forall a. Num a => a -> a -> a
* a
100))