module QuantLib.Time.Date
        ( module QuantLib.Time.Date
        , DayOfWeek(..)
        ) where

import Data.Time
import Data.Time.Calendar.WeekDate

{- | 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 
        | ModifiedFollowing 
        | Preceding
        | ModifiedPreceding
        | Unadjusted
        deriving (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)

-- -- | Week days
-- data WeekDay = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday
--         deriving (Show, Eq, Enum)

-- | Date
type Date = Day

-- | Defines a holidays for given calendar. Corresponds to calendar class in QuantLib
class Holiday m where
        isHoliday :: m->(Integer, Int, Int)->Bool
        
        isBusinessDay :: m->Date->Bool
        isBusinessDay m
m Date
d = Bool -> Bool
not (m -> (Integer, Int, Int) -> Bool
forall m. Holiday m => m -> (Integer, Int, Int) -> Bool
isHoliday m
m ((Integer, Int, Int) -> Bool) -> (Integer, Int, Int) -> Bool
forall a b. (a -> b) -> a -> b
$ Date -> (Integer, Int, Int)
toGregorian Date
d)

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

-- | Gets a week day 
getWeekDay :: Date->DayOfWeek
getWeekDay :: Date -> DayOfWeek
getWeekDay Date
d   = Int -> DayOfWeek
forall a. Enum a => Int -> a
toEnum (Int
weekDay Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        where   (Integer
_, Int
_, Int
weekDay) = Date -> (Integer, Int, Int)
toWeekDate Date
d

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

-- | Checks if the day is a weekend, i.e. Saturday or Sunday
isWeekEnd :: Date->Bool
isWeekEnd :: Date -> Bool
isWeekEnd Date
d     = (DayOfWeek
weekday DayOfWeek -> DayOfWeek -> Bool
forall a. Eq a => a -> a -> Bool
== DayOfWeek
Saturday) Bool -> Bool -> Bool
|| (DayOfWeek
weekday DayOfWeek -> DayOfWeek -> Bool
forall a. Eq a => a -> a -> Bool
== DayOfWeek
Sunday)
        where   weekday :: DayOfWeek
weekday = Date -> DayOfWeek
getWeekDay Date
d

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