{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE UndecidableInstances #-}
module Q.Time.DayCounter (
  DayCounter(..),
  Thirty360(..)
  ) where

import           Data.Time.Calendar
import           GHC.Generics
-- |Day counter type class
class DayCounter m where
  dcName         :: m -> String -- ^Name of the day counter.
  dcCount        :: m -> Day -> Day -> Int -- ^Number of business days inbetween
  dcYearFraction :: m -> Day -> Day -> Double -- ^Year fraction between 2 dates.


-- | Thirty day counters as in QuantLib
data Thirty360 = ThirtyUSA | ThirtyEuropean | ThirtyItalian
  deriving ((forall x. Thirty360 -> Rep Thirty360 x)
-> (forall x. Rep Thirty360 x -> Thirty360) -> Generic Thirty360
forall x. Rep Thirty360 x -> Thirty360
forall x. Thirty360 -> Rep Thirty360 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Thirty360 x -> Thirty360
$cfrom :: forall x. Thirty360 -> Rep Thirty360 x
Generic, Thirty360 -> Thirty360 -> Bool
(Thirty360 -> Thirty360 -> Bool)
-> (Thirty360 -> Thirty360 -> Bool) -> Eq Thirty360
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Thirty360 -> Thirty360 -> Bool
$c/= :: Thirty360 -> Thirty360 -> Bool
== :: Thirty360 -> Thirty360 -> Bool
$c== :: Thirty360 -> Thirty360 -> Bool
Eq, Int -> Thirty360 -> ShowS
[Thirty360] -> ShowS
Thirty360 -> String
(Int -> Thirty360 -> ShowS)
-> (Thirty360 -> String)
-> ([Thirty360] -> ShowS)
-> Show Thirty360
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Thirty360] -> ShowS
$cshowList :: [Thirty360] -> ShowS
show :: Thirty360 -> String
$cshow :: Thirty360 -> String
showsPrec :: Int -> Thirty360 -> ShowS
$cshowsPrec :: Int -> Thirty360 -> ShowS
Show, ReadPrec [Thirty360]
ReadPrec Thirty360
Int -> ReadS Thirty360
ReadS [Thirty360]
(Int -> ReadS Thirty360)
-> ReadS [Thirty360]
-> ReadPrec Thirty360
-> ReadPrec [Thirty360]
-> Read Thirty360
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Thirty360]
$creadListPrec :: ReadPrec [Thirty360]
readPrec :: ReadPrec Thirty360
$creadPrec :: ReadPrec Thirty360
readList :: ReadS [Thirty360]
$creadList :: ReadS [Thirty360]
readsPrec :: Int -> ReadS Thirty360
$creadsPrec :: Int -> ReadS Thirty360
Read)

instance DayCounter Thirty360 where
  dcName :: Thirty360 -> String
dcName Thirty360
ThirtyUSA      = String
"Thirty USA"
  dcName Thirty360
ThirtyEuropean = String
"Thirty Euro"
  dcName Thirty360
ThirtyItalian  = String
"Thirty Italian"

  dcYearFraction :: Thirty360 -> Day -> Day -> Double
dcYearFraction  Thirty360
dc Day
fromDate Day
toDate = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Thirty360 -> Day -> Day -> Int
forall m. DayCounter m => m -> Day -> Day -> Int
dcCount Thirty360
dc Day
fromDate Day
toDate) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
360.0

  dcCount :: Thirty360 -> Day -> Day -> Int
dcCount Thirty360
ThirtyUSA Day
fd Day
td = Int
360Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
yy2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
yy1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
30Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
mm2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
mm1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
30Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
dd1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
30 Int
dd2
    where   (Int
yy1, Int
mm1, Int
dd1) = Day -> (Int, Int, Int)
intGregorian Day
fd
            (Int
yy2, Int
m2, Int
d2)   = Day -> (Int, Int, Int)
intGregorian Day
td
            (Int
dd2, Int
mm2)      = Int -> Int -> Int -> (Int, Int)
forall a a b.
(Ord a, Num a, Num a, Num b, Eq a) =>
a -> a -> b -> (a, b)
adjust Int
dd1 Int
d2 Int
m2
            adjust :: a -> a -> b -> (a, b)
adjust a
x1 a
x2 b
z2
              | a
x2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
31 Bool -> Bool -> Bool
&& a
x1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
30   = (a
1, b
z2b -> b -> b
forall a. Num a => a -> a -> a
+b
1)
              | Bool
otherwise             = (a
x2, b
z2)


  dcCount Thirty360
ThirtyEuropean Day
fd Day
td = Int
360Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
yy2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
yy1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
30Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
m2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
m1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
30Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
d1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
30 Int
d2
    where   (Int
yy1, Int
m1, Int
d1)    = Day -> (Int, Int, Int)
intGregorian Day
fd
            (Int
yy2, Int
m2, Int
d2)    = Day -> (Int, Int, Int)
intGregorian Day
td

  dcCount Thirty360
ThirtyItalian Day
fd Day
td = Int
360Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
yy2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
yy1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
30Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
mm2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
mm1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
30Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
dd1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
30 Int
dd2
    where   (Int
yy1, Int
mm1, Int
d1)   = Day -> (Int, Int, Int)
intGregorian Day
fd
            (Int
yy2, Int
mm2, Int
d2)   = Day -> (Int, Int, Int)
intGregorian Day
td
            dd1 :: Int
dd1              = Int -> Int -> Int
forall p a. (Ord p, Num a, Num p, Eq a) => p -> a -> p
adjust Int
d1 Int
mm1
            dd2 :: Int
dd2              = Int -> Int -> Int
forall p a. (Ord p, Num a, Num p, Eq a) => p -> a -> p
adjust Int
d2 Int
mm2
            adjust :: p -> a -> p
adjust p
x1 a
z1
              | a
z1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
2 Bool -> Bool -> Bool
&& p
x1 p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
27    = p
30
              | Bool
otherwise             = p
x1

intGregorian ::  Day -> (Int, Int, Int)
intGregorian :: Day -> (Int, Int, Int)
intGregorian Day
date = (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y, Int
m, Int
d)
  where (Integer
y, Int
m, Int
d) = Day -> (Integer, Int, Int)
toGregorian Day
date