-- 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 for representing a number of days in a year.

-}

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.Tax.ATO.Days
  ( Days
  , days
  , daysAll
  , daysNone
  , getDays
  , getFraction
  , DaysInYear
  )
  where

import GHC.TypeLits
import Data.Proxy
import Data.Ratio ((%))

import Data.Time.Calendar (isLeapYear)

type Year = Nat
type DaysInYear = KnownNat

daysInYear :: KnownNat n => Proxy n -> Integer
daysInYear :: forall (n :: Nat). KnownNat n => Proxy n -> Integer
daysInYear Proxy n
proxy
  | Integer -> Bool
isLeapYear (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
proxy) = Integer
366
  | Bool
otherwise                 = Integer
365

-- | Some number of days in a year.  Use 'days' to construct.
newtype Days (n :: Year) = Days
  { forall (n :: Nat). Days n -> Integer
getDays :: Integer
  -- ^ Get the number of days, which is between 0 and 365/366 inclusive.
  }
  deriving (Int -> Days n -> ShowS
forall (n :: Nat). Int -> Days n -> ShowS
forall (n :: Nat). [Days n] -> ShowS
forall (n :: Nat). Days n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Days n] -> ShowS
$cshowList :: forall (n :: Nat). [Days n] -> ShowS
show :: Days n -> String
$cshow :: forall (n :: Nat). Days n -> String
showsPrec :: Int -> Days n -> ShowS
$cshowsPrec :: forall (n :: Nat). Int -> Days n -> ShowS
Show)

-- | Construct a 'Days' value.  If out of range, the number of days
-- is clamped to 0 or 365/366 (no runtime errors).
days :: forall a. (DaysInYear a) => Integer -> Days a
days :: forall (a :: Nat). DaysInYear a => Integer -> Days a
days = forall (n :: Nat). Integer -> Days n
Days forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
max Integer
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min (forall (n :: Nat). KnownNat n => Proxy n -> Integer
daysInYear (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

-- | Every day of the year
daysAll :: forall a. (DaysInYear a) => Days a
daysAll :: forall (a :: Nat). DaysInYear a => Days a
daysAll = forall (n :: Nat). Integer -> Days n
Days (forall (n :: Nat). KnownNat n => Proxy n -> Integer
daysInYear (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

-- | Zero days of the year
daysNone :: Days a
daysNone :: forall (a :: Nat). Days a
daysNone = forall (n :: Nat). Integer -> Days n
Days Integer
0

-- | Get the number of days as a fractional value.
-- Information about the the year type is discarded.
getFraction :: forall a frac. (DaysInYear a, Fractional frac) => Days a -> frac
getFraction :: forall (a :: Nat) frac.
(DaysInYear a, Fractional frac) =>
Days a -> frac
getFraction Days a
n = forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall (n :: Nat). Days n -> Integer
getDays Days a
n forall a. Integral a => a -> a -> Ratio a
% forall (n :: Nat). KnownNat n => Proxy n -> Integer
daysInYear (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)