{-# LANGUAGE DeriveGeneric #-}
module Q.Time.Date (Calendar(..)) where

import Data.Time
import GHC.Generics

{- |Business Day conventions
 - These conventions specify the algorithm used to adjust a date in case it is not a valid business day.
 -}
data BusinessDayConvention =
          Following          -- ^Choose the first business day after the holiday 
        | ModifiedFollowing  {- ^Choose the first business day after
                                   the given holiday unless it belongs
                                    to a different month, in which case
                                    choose the first business day before
                                    the holiday -} 
        | Preceding          -- ^Choose the first business day before the holiday
        | ModifiedPreceding  {- ^Choose the first business day before
                                    the given holiday unless it belongs
                                    to a different month, in which case
                                    choose the first business day after
                                    the holiday. -}
        | Unadjusted         -- ^Do not adjust
        deriving ((forall x. BusinessDayConvention -> Rep BusinessDayConvention x)
-> (forall x. Rep BusinessDayConvention x -> BusinessDayConvention)
-> Generic BusinessDayConvention
forall x. Rep BusinessDayConvention x -> BusinessDayConvention
forall x. BusinessDayConvention -> Rep BusinessDayConvention x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BusinessDayConvention x -> BusinessDayConvention
$cfrom :: forall x. BusinessDayConvention -> Rep BusinessDayConvention x
Generic, Int -> BusinessDayConvention -> ShowS
[BusinessDayConvention] -> ShowS
BusinessDayConvention -> String
(Int -> BusinessDayConvention -> ShowS)
-> (BusinessDayConvention -> String)
-> ([BusinessDayConvention] -> ShowS)
-> Show BusinessDayConvention
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BusinessDayConvention] -> ShowS
$cshowList :: [BusinessDayConvention] -> ShowS
show :: BusinessDayConvention -> String
$cshow :: BusinessDayConvention -> String
showsPrec :: Int -> BusinessDayConvention -> ShowS
$cshowsPrec :: Int -> BusinessDayConvention -> ShowS
Show, BusinessDayConvention -> BusinessDayConvention -> Bool
(BusinessDayConvention -> BusinessDayConvention -> Bool)
-> (BusinessDayConvention -> BusinessDayConvention -> Bool)
-> Eq BusinessDayConvention
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BusinessDayConvention -> BusinessDayConvention -> Bool
$c/= :: BusinessDayConvention -> BusinessDayConvention -> Bool
== :: BusinessDayConvention -> BusinessDayConvention -> Bool
$c== :: BusinessDayConvention -> BusinessDayConvention -> Bool
Eq, Int -> BusinessDayConvention
BusinessDayConvention -> Int
BusinessDayConvention -> [BusinessDayConvention]
BusinessDayConvention -> BusinessDayConvention
BusinessDayConvention
-> BusinessDayConvention -> [BusinessDayConvention]
BusinessDayConvention
-> BusinessDayConvention
-> BusinessDayConvention
-> [BusinessDayConvention]
(BusinessDayConvention -> BusinessDayConvention)
-> (BusinessDayConvention -> BusinessDayConvention)
-> (Int -> BusinessDayConvention)
-> (BusinessDayConvention -> Int)
-> (BusinessDayConvention -> [BusinessDayConvention])
-> (BusinessDayConvention
    -> BusinessDayConvention -> [BusinessDayConvention])
-> (BusinessDayConvention
    -> BusinessDayConvention -> [BusinessDayConvention])
-> (BusinessDayConvention
    -> BusinessDayConvention
    -> BusinessDayConvention
    -> [BusinessDayConvention])
-> Enum BusinessDayConvention
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BusinessDayConvention
-> BusinessDayConvention
-> BusinessDayConvention
-> [BusinessDayConvention]
$cenumFromThenTo :: BusinessDayConvention
-> BusinessDayConvention
-> BusinessDayConvention
-> [BusinessDayConvention]
enumFromTo :: BusinessDayConvention
-> BusinessDayConvention -> [BusinessDayConvention]
$cenumFromTo :: BusinessDayConvention
-> BusinessDayConvention -> [BusinessDayConvention]
enumFromThen :: BusinessDayConvention
-> BusinessDayConvention -> [BusinessDayConvention]
$cenumFromThen :: BusinessDayConvention
-> BusinessDayConvention -> [BusinessDayConvention]
enumFrom :: BusinessDayConvention -> [BusinessDayConvention]
$cenumFrom :: BusinessDayConvention -> [BusinessDayConvention]
fromEnum :: BusinessDayConvention -> Int
$cfromEnum :: BusinessDayConvention -> Int
toEnum :: Int -> BusinessDayConvention
$ctoEnum :: Int -> BusinessDayConvention
pred :: BusinessDayConvention -> BusinessDayConvention
$cpred :: BusinessDayConvention -> BusinessDayConvention
succ :: BusinessDayConvention -> BusinessDayConvention
$csucc :: BusinessDayConvention -> BusinessDayConvention
Enum)

-- | Defines a holidays for given calendar. Corresponds to calendar class in QuantLib
class Calendar m where
  isHoliday :: m -> (Integer, Int, Int) -> Bool
  isWeekend :: m -> Day -> Bool

  isBusinessDay :: m -> Day -> Bool
  isBusinessDay m
m Day
d = Bool -> Bool
not (m -> (Integer, Int, Int) -> Bool
forall m. Calendar m => m -> (Integer, Int, Int) -> Bool
isHoliday m
m ((Integer, Int, Int) -> Bool) -> (Integer, Int, Int) -> Bool
forall a b. (a -> b) -> a -> b
$ Day -> (Integer, Int, Int)
toGregorian Day
d)

  hBusinessDayBetween :: m -> (Day, Day) -> Int
  hBusinessDayBetween m
m (Day
fd, Day
td) = (Int -> Day -> Int) -> Int -> [Day] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Day -> Int
countDays Int
0 [Day]
listOfDates
    where   countDays :: Int -> Day -> Int
countDays Int
counter Day
x     = Int
counter Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Int
forall a. Enum a => a -> Int
fromEnum (m -> Day -> Bool
forall m. Calendar m => m -> Day -> Bool
isBusinessDay m
m Day
x)
            listOfDates :: [Day]
listOfDates             = (Day, Day) -> [Day]
getDaysBetween (Day
fd, Day
td)

  hNextBusinessDay :: m -> Day -> Day
  hNextBusinessDay m
m Day
d | m -> Day -> Bool
forall m. Calendar m => m -> Day -> Bool
isBusinessDay m
m Day
nextDay = Day
nextDay
                       | Bool
otherwise                = m -> Day -> Day
forall a. Calendar a => a -> Day -> Day
getNextBusinessDay m
m Day
nextDay
    where   nextDay :: Day
nextDay = Integer -> Day -> Day
addDays Integer
1 Day
d



-- | Generate a list of all dates inbetween
getDaysBetween ::  (Day, Day) -> [Day]
getDaysBetween :: (Day, Day) -> [Day]
getDaysBetween (Day
fd, Day
td) = [Day] -> [Day]
forall a. [a] -> [a]
reverse ([Day] -> [Day]) -> [Day] -> [Day]
forall a b. (a -> b) -> a -> b
$ Day -> [Day] -> [Day]
generator Day
fd []
  where   generator :: Day -> [Day] -> [Day]
generator Day
date [Day]
x
            | Day
date Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
td     = Day -> [Day] -> [Day]
generator Day
nextDate (Day
nextDate Day -> [Day] -> [Day]
forall a. a -> [a] -> [a]
: [Day]
x)
            | Bool
otherwise     = [Day]
x
            where   nextDate :: Day
nextDate        = Integer -> Day -> Day
addDays Integer
1 Day
date

-- | Gets the next working day
getNextBusinessDay :: Calendar a => a -> Day -> Day
getNextBusinessDay :: a -> Day -> Day
getNextBusinessDay a
m Day
d
  | a -> Day -> Bool
forall m. Calendar m => m -> Day -> Bool
isBusinessDay a
m Day
nextDay       = Day
nextDay
  | Bool
otherwise                     = a -> Day -> Day
forall a. Calendar a => a -> Day -> Day
getNextBusinessDay a
m Day
nextDay
  where   nextDay :: Day
nextDay = Integer -> Day -> Day
addDays Integer
1 Day
d