{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module DateUtil(
yearCountFraction,genSerialDates,genSerialDatesTill,genSerialDatesTill2,subDates,sliceDates,SliceType(..)
,splitByDate,projDatesByPattern,monthsAfter,getIntervalFactorsDc
,daysInterval
)
where
import qualified Data.Time as T
import Data.List
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Ratio ((%))
import Debug.Trace
import Data.Time (addDays)
import Types
import Data.Ix
import Lib
import Control.Exception
debug :: c -> [Char] -> c
debug = ([Char] -> c -> c) -> c -> [Char] -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> c -> c
forall a. [Char] -> a -> a
trace
yearCountFraction :: DayCount -> Date -> Date -> Rational
yearCountFraction :: DayCount -> Date -> Date -> Rational
yearCountFraction DayCount
dc Date
sd Date
ed
= case DayCount
dc of
DayCount
DC_ACT_ACT -> if Bool
sameYear then
Year
_diffDays Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year -> Year
forall {a}. Num a => Year -> a
daysOfYear Year
syear
else
(Year
sDaysTillYearEnd Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Year -> Year
forall {a}. Num a => Year -> a
daysOfYear Year
syear)) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Year
eDaysAfterYearBeg Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Year -> Year
forall {a}. Num a => Year -> a
daysOfYear Year
eyear)) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Rational -> Rational
forall a. Enum a => a -> a
pred Rational
_diffYears)
DayCount
DC_ACT_365F -> Year
_diffDays Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year
365
DayCount
DC_ACT_360 -> Year
_diffDays Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year
360
DayCount
DC_ACT_365A -> if Bool
has_leap_day then
Year
_diffDays Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year
366
else
Year
_diffDays Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year
365
DayCount
DC_ACT_365L -> if Year -> Bool
T.isLeapYear Year
eyear then
Year
_diffDays Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year
366
else
Year
_diffDays Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year
365
DayCount
DC_NL_365 -> if Bool
has_leap_day then
(Year -> Year
forall a. Enum a => a -> a
pred Year
_diffDays) Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year
365
else
Year
_diffDays Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year
365
DayCount
DC_30E_360 -> let
_sday :: Int
_sday = Int -> Int
forall {a}. (Eq a, Num a) => a -> a
f31to30 Int
sday
_eday :: Int
_eday = Int -> Int
forall {a}. (Eq a, Num a) => a -> a
f31to30 Int
eday
num :: Rational
num = Int -> Rational
forall a. Real a => a -> Rational
toRational (Int
_eday Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
_sday) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
30Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
_gapMonth Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
360Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
_diffYears
in
Rational
num Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
360
DayCount
DC_30Ep_360 -> let
_sday :: Int
_sday = Int -> Int
forall {a}. (Eq a, Num a) => a -> a
f31to30 Int
sday
(Year
_eyear,Int
_emonth,Int
_eday) = Date -> (Year, Int, Int)
T.toGregorian (Date -> (Year, Int, Int)) -> Date -> (Year, Int, Int)
forall a b. (a -> b) -> a -> b
$
if Int
edayInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
31 then
Year -> Date -> Date
T.addDays Year
1 Date
ed
else
Date
ed
__gapMonth :: Rational
__gapMonth = (Int -> Year
forall a. Integral a => a -> Year
toInteger (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ Int
_emonth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
smonth) Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year
1
__diffYears :: Rational
__diffYears = (Year -> Year
forall a. Integral a => a -> Year
toInteger (Year -> Year) -> Year -> Year
forall a b. (a -> b) -> a -> b
$ Year
_eyear Year -> Year -> Year
forall a. Num a => a -> a -> a
- Year
syear) Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year
1
num :: Rational
num = Int -> Rational
forall a. Real a => a -> Rational
toRational (Int
_eday Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
_sday) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
30Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
__gapMonth Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
360Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
__diffYears
in
Rational
num Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
360
DayCount
DC_30_360_ISDA -> let
_sday :: Int
_sday = Int -> Int
forall {a}. (Eq a, Num a) => a -> a
f31to30 Int
sday
_eday :: Int
_eday = if Int
_sdayInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
30 Bool -> Bool -> Bool
&& Int
edayInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
31 then
Int
30
else
Int
eday
num :: Rational
num = Int -> Rational
forall a. Real a => a -> Rational
toRational (Int
_eday Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
_sday) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
30Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
_gapMonth Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
360Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
_diffYears
in
Rational
num Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
360
DayCount
DC_30_360_German -> let
_sday :: Int
_sday = if Int
sdayInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
31 Bool -> Bool -> Bool
|| (Year -> Int -> Int -> Bool
forall {a} {a}.
(Eq a, Eq a, Num a, Num a) =>
Year -> a -> a -> Bool
endOfFeb Year
syear Int
smonth Int
sday) then
Int
30
else
Int
sday
_eday :: Int
_eday = if Int
edayInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
31 Bool -> Bool -> Bool
|| (Year -> Int -> Int -> Bool
forall {a} {a}.
(Eq a, Eq a, Num a, Num a) =>
Year -> a -> a -> Bool
endOfFeb Year
eyear Int
emonth Int
eday) then
Int
30
else
Int
eday
num :: Rational
num = Int -> Rational
forall a. Real a => a -> Rational
toRational (Int
_eday Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
_sday) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
30Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
_gapMonth Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
360Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
_diffYears
in
Rational
num Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
360
DayCount
DC_30_360_US -> let
_sday :: Int
_sday = if (Year -> Int -> Int -> Bool
forall {a} {a}.
(Eq a, Eq a, Num a, Num a) =>
Year -> a -> a -> Bool
endOfFeb Year
syear Int
smonth Int
sday) Bool -> Bool -> Bool
|| Int
sdayInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
31 then
Int
30
else
Int
sday
_eday :: Int
_eday = if (Int
edayInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
31 Bool -> Bool -> Bool
&& Int
sday Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
30)Bool -> Bool -> Bool
||(Year -> Int -> Int -> Bool
forall {a} {a}.
(Eq a, Eq a, Num a, Num a) =>
Year -> a -> a -> Bool
endOfFeb Year
eyear Int
emonth Int
eday) Bool -> Bool -> Bool
&& (Year -> Int -> Int -> Bool
forall {a} {a}.
(Eq a, Eq a, Num a, Num a) =>
Year -> a -> a -> Bool
endOfFeb Year
syear Int
smonth Int
sday) then
Int
30
else
Int
eday
num :: Rational
num = Int -> Rational
forall a. Real a => a -> Rational
toRational (Int
_eday Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
_sday) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
30Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
_gapMonth Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
360Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
_diffYears
in
Rational
num Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
360
DayCount
_ -> [Char] -> Rational
forall a. HasCallStack => [Char] -> a
error ([Char] -> Rational) -> [Char] -> Rational
forall a b. (a -> b) -> a -> b
$ [Char]
"DayCount not supported" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DayCount -> [Char]
forall a. Show a => a -> [Char]
show DayCount
dc
where
daysOfYear :: Year -> a
daysOfYear Year
y = if Year -> Bool
T.isLeapYear Year
y then a
366 else a
365
f31to30 :: a -> a
f31to30 a
d = if a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
31 then
a
30
else
a
d
endOfFeb :: Year -> a -> a -> Bool
endOfFeb Year
y a
m a
d = if Year -> Bool
T.isLeapYear Year
y then
(a
ma -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
2) Bool -> Bool -> Bool
&& a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
29
else
(a
ma -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
2) Bool -> Bool -> Bool
&& a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
28
sameYear :: Bool
sameYear = Year
syear Year -> Year -> Bool
forall a. Eq a => a -> a -> Bool
== Year
eyear
has_leap_day :: Bool
has_leap_day
= case (Bool
sameYear,Bool
sLeap,Bool
eLeap) of
(Bool
True,Bool
False,Bool
False) -> Bool
False
(Bool
True,Bool
True,Bool
_) -> (Date, Date) -> Date -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Date
sd,Date
ed) (Year -> Int -> Int -> Date
T.fromGregorian Year
syear Int
2 Int
29)
(Bool, Bool, Bool)
_ -> let
_leapDays :: [Date]
_leapDays = [ Year -> Int -> Int -> Date
T.fromGregorian Year
_y Int
2 Int
29 | Year
_y <- (Year, Year) -> [Year]
forall a. Ix a => (a, a) -> [a]
range (Year
syear,Year
eyear) , Year -> Bool
T.isLeapYear Year
_y ]
in
(Date -> Bool) -> [Date] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Date, Date) -> Date -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Date
sd,Date
ed)) [Date]
_leapDays
_diffYears :: Rational
_diffYears = (Year
eyear Year -> Year -> Year
forall a. Num a => a -> a -> a
- Year
syear) Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year
1
_gapDay :: Rational
_gapDay = Int -> Year
forall a. Integral a => a -> Year
toInteger (Int
eday Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sday) Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year
1
_gapMonth :: Rational
_gapMonth = Int -> Year
forall a. Integral a => a -> Year
toInteger (Int
emonth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
smonth) Year -> Year -> Rational
forall a. Integral a => a -> a -> Ratio a
% Year
1
sDaysTillYearEnd :: Year
sDaysTillYearEnd = Year -> Year
forall a. Enum a => a -> a
succ (Year -> Year) -> Year -> Year
forall a b. (a -> b) -> a -> b
$ Date -> Date -> Year
T.diffDays (Year -> Int -> Int -> Date
T.fromGregorian Year
syear Int
12 Int
31) Date
sd
eDaysAfterYearBeg :: Year
eDaysAfterYearBeg = Date -> Date -> Year
T.diffDays Date
ed (Year -> Int -> Int -> Date
T.fromGregorian Year
eyear Int
1 Int
1)
_diffDays :: Year
_diffDays = Year -> Year
forall a. Integral a => a -> Year
toInteger (Year -> Year) -> Year -> Year
forall a b. (a -> b) -> a -> b
$ Date -> Date -> Year
T.diffDays Date
ed Date
sd
sLeap :: Bool
sLeap = Year -> Bool
T.isLeapYear Year
syear
eLeap :: Bool
eLeap = Year -> Bool
T.isLeapYear Year
eyear
(Year
syear,Int
smonth,Int
sday) = Date -> (Year, Int, Int)
T.toGregorian Date
sd
(Year
eyear,Int
emonth,Int
eday) = Date -> (Year, Int, Int)
T.toGregorian Date
ed
genSerialDates :: DatePattern -> CutoffType -> Date -> Int -> Dates
genSerialDates :: DatePattern -> CutoffType -> Date -> Int -> [Date]
genSerialDates DatePattern
dp CutoffType
ct Date
sd Int
num
= Int -> [Date] -> [Date]
forall a. Int -> [a] -> [a]
take Int
num ([Date] -> [Date]) -> [Date] -> [Date]
forall a b. (a -> b) -> a -> b
$
(Date -> Bool) -> [Date] -> [Date]
forall a. (a -> Bool) -> [a] -> [a]
filter Date -> Bool
ftFn ([Date] -> [Date]) -> [Date] -> [Date]
forall a b. (a -> b) -> a -> b
$
case DatePattern
dp of
DatePattern
MonthEnd ->
[Year -> Int -> Int -> Date
T.fromGregorian Year
yearRange ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
__md) ((Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
__md) | Year
yearRange <- [Year
_y..(Year
_yYear -> Year -> Year
forall a. Num a => a -> a -> a
+Year
yrs)]
,(Int, Int)
__md <- Year -> [(Int, Int)]
forall {a} {b}. (Num a, Num b) => Year -> [(a, b)]
monthEnds Year
yearRange ]
where
yrs :: Year
yrs = Int -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
num Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
DatePattern
QuarterEnd ->
[Year -> Int -> Int -> Date
T.fromGregorian Year
yearRange Int
__m Int
__d | Year
yearRange <- [Year
_y..(Year
_yYear -> Year -> Year
forall a. Num a => a -> a -> a
+Year
yrs)]
,(Int
__m,Int
__d) <- [(Int, Int)]
quarterEnds]
where
yrs :: Year
yrs = Int -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
num Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
DatePattern
YearEnd ->
[Year -> Int -> Int -> Date
T.fromGregorian Year
yearRange Int
12 Int
31 | Year
yearRange <- [Year
_y..(Year
_yYear -> Year -> Year
forall a. Num a => a -> a -> a
+(Int -> Year
forall a. Integral a => a -> Year
toInteger Int
num))]]
DatePattern
YearFirst ->
[Year -> Int -> Int -> Date
T.fromGregorian Year
yearRange Int
1 Int
1 | Year
yearRange <- [Year
_y..(Year
_yYear -> Year -> Year
forall a. Num a => a -> a -> a
+(Int -> Year
forall a. Integral a => a -> Year
toInteger Int
num))]]
DatePattern
MonthFirst ->
[Year -> Int -> Int -> Date
T.fromGregorian Year
yearRange Int
monthRange Int
1 | Year
yearRange <- [Year
_y..(Year
_yYear -> Year -> Year
forall a. Num a => a -> a -> a
+Year
yrs)]
, Int
monthRange <- [Int
1..Int
12]]
where
yrs :: Year
yrs = Int -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
num Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
DatePattern
QuarterFirst ->
[Year -> Int -> Int -> Date
T.fromGregorian Year
yearRange Int
__m Int
1 | Year
yearRange <- [Year
_y..(Year
_yYear -> Year -> Year
forall a. Num a => a -> a -> a
+Year
yrs)]
,Int
__m <- [Int
3,Int
6,Int
9,Int
12]]
where
yrs :: Year
yrs = Int -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
num Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
MonthDayOfYear Int
m Int
d ->
[Year -> Int -> Int -> Date
T.fromGregorian Year
yearRange Int
m Int
d | Year
yearRange <- [Year
_y..(Year
_yYear -> Year -> Year
forall a. Num a => a -> a -> a
+(Int -> Year
forall a. Integral a => a -> Year
toInteger Int
num))]]
DayOfMonth Int
d ->
[Year -> Int -> Int -> Date
T.fromGregorian Year
yearRange Int
monthRange Int
d | Year
yearRange <- [Year
_y..(Year
_yYear -> Year -> Year
forall a. Num a => a -> a -> a
+Year
yrs)]
, Int
monthRange <- [Int
1..Int
12]]
where
yrs :: Year
yrs = Int -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
num Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Weekday Int
wday ->
[Year -> Date -> Date
T.addDays (Year -> Year
forall a. Integral a => a -> Year
toInteger Year
_n Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
7) Date
startDay | Year
_n <- [Year
0..]]
where
dOfWeek :: DayOfWeek
dOfWeek = Int -> DayOfWeek
forall a. Enum a => Int -> a
toEnum Int
wday::T.DayOfWeek
startDay :: Date
startDay = DayOfWeek -> Date -> Date
T.firstDayOfWeekOnAfter DayOfWeek
dOfWeek Date
sd
CustomDate [Date]
ds -> [Date]
ds
EveryNMonth Date
d Int
n ->
Date
dDate -> [Date] -> [Date]
forall a. a -> [a] -> [a]
:[ CalendarDiffDays -> Date -> Date
T.addGregorianDurationClip (Year -> Year -> CalendarDiffDays
T.CalendarDiffDays ((Int -> Year
forall a. Integral a => a -> Year
toInteger Int
_n)Year -> Year -> Year
forall a. Num a => a -> a -> a
*(Int -> Year
forall a. Integral a => a -> Year
toInteger Int
n)) Year
0) Date
d | Int
_n <- [Int
1..Int
num] ]
SingletonDate Date
d -> [Date
d]
where
quarterEnds :: [(Int, Int)]
quarterEnds = [(Int
3,Int
31),(Int
6,Int
30),(Int
9,Int
30),(Int
12,Int
31)]
monthEnds :: Year -> [(a, b)]
monthEnds Year
y =
if Year -> Bool
T.isLeapYear Year
y then
[(a
1,b
31),(a
2,b
29),(a
3,b
31),(a
4,b
30),(a
5,b
31),(a
6,b
30),(a
7,b
31),(a
8,b
31),(a
9,b
30),(a
10,b
31),(a
11,b
30),(a
12,b
31)]
else
[(a
1,b
31),(a
2,b
28),(a
3,b
31),(a
4,b
30),(a
5,b
31),(a
6,b
30),(a
7,b
31),(a
8,b
31),(a
9,b
30),(a
10,b
31),(a
11,b
30),(a
12,b
31)]
(Year
_y,Int
_m,Int
_d) = Date -> (Year, Int, Int)
T.toGregorian Date
sd
ftFn :: Date -> Bool
ftFn = if CutoffType
ct CutoffType -> CutoffType -> Bool
forall a. Eq a => a -> a -> Bool
== CutoffType
Inc then
(Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
sd)
else
(Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
sd)
genSerialDatesTill:: Date -> DatePattern -> Date -> Dates
genSerialDatesTill :: Date -> DatePattern -> Date -> [Date]
genSerialDatesTill Date
sd DatePattern
ptn Date
ed
= (Date -> Bool) -> [Date] -> [Date]
forall a. (a -> Bool) -> [a] -> [a]
filter (Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
<= Date
ed) ([Date] -> [Date]) -> [Date] -> [Date]
forall a b. (a -> b) -> a -> b
$ DatePattern -> CutoffType -> Date -> Int -> [Date]
genSerialDates DatePattern
ptn CutoffType
Inc Date
sd (Year -> Int
forall {a}. Num a => Year -> a
fromInteger (Year -> Year
forall a. Enum a => a -> a
succ Year
num))
where
(Year
sy,Int
sm,Int
sday) = Date -> (Year, Int, Int)
T.toGregorian Date
sd
(Year
ey,Int
em,Int
eday) = Date -> (Year, Int, Int)
T.toGregorian Date
ed
T.CalendarDiffDays Year
cdM Year
cdD = Date -> Date -> CalendarDiffDays
T.diffGregorianDurationRollOver Date
ed Date
sd
num :: Year
num = case DatePattern
ptn of
DatePattern
MonthEnd -> Year
cdM
DatePattern
QuarterEnd -> Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
cdM Year
3
DatePattern
YearEnd -> Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
cdM Year
12
DatePattern
MonthFirst -> Year
cdM
DatePattern
QuarterFirst-> Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
cdM Year
3
DatePattern
YearFirst-> Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
cdM Year
12
MonthDayOfYear Int
_m Int
_d -> Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
cdM Year
12
DayOfMonth Int
_d -> Year
cdM
CustomDate [Date]
ds -> Year
2 Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Int -> Year
forall a. Integral a => a -> Year
toInteger ([Date] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Date]
ds)
EveryNMonth Date
_d Int
_n -> Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
cdM (Int -> Year
forall a. Integral a => a -> Year
toInteger Int
_n)
Weekday Int
_d -> Year
cdM Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
4
SingletonDate Date
_d -> if Date
_d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
<= Date
ed then Year
1 else Year
0
DatePattern
_ -> [Char] -> Year
forall a. HasCallStack => [Char] -> a
error ([Char] -> Year) -> [Char] -> Year
forall a b. (a -> b) -> a -> b
$ [Char]
"failed to match" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DatePattern -> [Char]
forall a. Show a => a -> [Char]
show DatePattern
ptn
genSerialDatesTill2 :: RangeType -> Date -> DatePattern -> Date -> Dates
genSerialDatesTill2 :: RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
rt Date
sd DatePattern
dp Date
ed
= case (RangeType
rt, [Date] -> Date
forall a. HasCallStack => [a] -> a
head [Date]
_rDate -> Date -> Bool
forall a. Eq a => a -> a -> Bool
==Date
sd, [Date] -> Date
forall a. HasCallStack => [a] -> a
last [Date]
_rDate -> Date -> Bool
forall a. Eq a => a -> a -> Bool
==Date
ed) of
(RangeType
II,Bool
True,Bool
True) -> [Date]
_r
(RangeType
II,Bool
True,Bool
False) -> [Date]
_r [Date] -> [Date] -> [Date]
forall a. [a] -> [a] -> [a]
++ [Date
ed]
(RangeType
II,Bool
False,Bool
True)-> Date
sdDate -> [Date] -> [Date]
forall a. a -> [a] -> [a]
:[Date]
_r
(RangeType
II,Bool
False,Bool
False)-> Date
sdDate -> [Date] -> [Date]
forall a. a -> [a] -> [a]
:[Date]
_r [Date] -> [Date] -> [Date]
forall a. [a] -> [a] -> [a]
++ [Date
ed]
(RangeType
EI,Bool
True,Bool
True) -> [Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
tail [Date]
_r
(RangeType
EI,Bool
True,Bool
False) -> [Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
tail [Date]
_r [Date] -> [Date] -> [Date]
forall a. [a] -> [a] -> [a]
++ [Date
ed]
(RangeType
EI,Bool
False,Bool
True) -> [Date]
_r
(RangeType
EI,Bool
False,Bool
False) -> [Date]
_r [Date] -> [Date] -> [Date]
forall a. [a] -> [a] -> [a]
++ [Date
ed]
(RangeType
IE,Bool
True,Bool
True) -> [Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
init [Date]
_r
(RangeType
IE,Bool
True,Bool
False) -> [Date]
_r
(RangeType
IE,Bool
False,Bool
True) -> Date
sdDate -> [Date] -> [Date]
forall a. a -> [a] -> [a]
:[Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
init [Date]
_r
(RangeType
IE,Bool
False,Bool
False) -> Date
sdDate -> [Date] -> [Date]
forall a. a -> [a] -> [a]
:[Date]
_r
(RangeType
EE,Bool
True,Bool
True) -> [Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
init ([Date] -> [Date]) -> [Date] -> [Date]
forall a b. (a -> b) -> a -> b
$ [Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
tail [Date]
_r
(RangeType
EE,Bool
True,Bool
False) -> [Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
tail [Date]
_r
(RangeType
EE,Bool
False,Bool
True) -> [Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
init [Date]
_r
(RangeType
EE,Bool
False,Bool
False) -> [Date]
_r
(RangeType
NO_IE,Bool
_,Bool
_) -> [Date]
_r
where
_r :: [Date]
_r = case DatePattern
dp of
AllDatePattern [DatePattern]
dps -> [[Date]] -> [Date]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Date -> DatePattern -> Date -> [Date]
genSerialDatesTill Date
sd DatePattern
_dp Date
ed | DatePattern
_dp <- [DatePattern]
dps ]
StartsExclusive Date
d DatePattern
_dp -> (Date -> Bool) -> [Date] -> [Date]
forall a. (a -> Bool) -> [a] -> [a]
filter (Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
d) ([Date] -> [Date]) -> [Date] -> [Date]
forall a b. (a -> b) -> a -> b
$ RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
rt Date
sd DatePattern
_dp Date
ed
StartsAt CutoffType
Exc Date
d DatePattern
_dp -> (Date -> Bool) -> [Date] -> [Date]
forall a. (a -> Bool) -> [a] -> [a]
filter (Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
d) ([Date] -> [Date]) -> [Date] -> [Date]
forall a b. (a -> b) -> a -> b
$ RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
rt Date
sd DatePattern
_dp Date
ed
StartsAt CutoffType
Inc Date
d DatePattern
_dp -> (Date -> Bool) -> [Date] -> [Date]
forall a. (a -> Bool) -> [a] -> [a]
filter (Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
d) ([Date] -> [Date]) -> [Date] -> [Date]
forall a b. (a -> b) -> a -> b
$ RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
rt Date
sd DatePattern
_dp Date
ed
EndsAt CutoffType
Exc Date
d DatePattern
_dp -> (Date -> Bool) -> [Date] -> [Date]
forall a. (a -> Bool) -> [a] -> [a]
filter (Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
< Date
d) ([Date] -> [Date]) -> [Date] -> [Date]
forall a b. (a -> b) -> a -> b
$ RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
rt Date
sd DatePattern
_dp Date
ed
EndsAt CutoffType
Inc Date
d DatePattern
_dp -> (Date -> Bool) -> [Date] -> [Date]
forall a. (a -> Bool) -> [a] -> [a]
filter (Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
<= Date
d) ([Date] -> [Date]) -> [Date] -> [Date]
forall a b. (a -> b) -> a -> b
$ RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
rt Date
sd DatePattern
_dp Date
ed
Exclude DatePattern
_d [DatePattern]
_dps ->
let
a :: Set Date
a = [Date] -> Set Date
forall a. Ord a => [a] -> Set a
S.fromList ([Date] -> Set Date) -> [Date] -> Set Date
forall a b. (a -> b) -> a -> b
$ RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
rt Date
sd DatePattern
_d Date
ed
b :: Set Date
b = [Date] -> Set Date
forall a. Ord a => [a] -> Set a
S.fromList ([Date] -> Set Date) -> [Date] -> Set Date
forall a b. (a -> b) -> a -> b
$ RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
rt Date
sd ([DatePattern] -> DatePattern
AllDatePattern [DatePattern]
_dps) Date
ed
in
[Date] -> [Date]
forall a. Ord a => [a] -> [a]
sort ([Date] -> [Date]) -> [Date] -> [Date]
forall a b. (a -> b) -> a -> b
$ Set Date -> [Date]
forall a. Set a -> [a]
S.toList (Set Date -> [Date]) -> Set Date -> [Date]
forall a b. (a -> b) -> a -> b
$ Set Date -> Set Date -> Set Date
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set Date
a Set Date
b
OffsetBy DatePattern
_dp Int
_n -> [ Year -> Date -> Date
T.addDays (Int -> Year
forall a. Integral a => a -> Year
toInteger Int
_n) Date
_d | Date
_d <- RangeType -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill2 RangeType
rt Date
sd DatePattern
_dp Date
ed ]
DatePattern
_ -> Date -> DatePattern -> Date -> [Date]
genSerialDatesTill Date
sd DatePattern
dp Date
ed
subDates :: RangeType -> Date -> Date -> [Date] -> [Date]
subDates :: RangeType -> Date -> Date -> [Date] -> [Date]
subDates RangeType
rt Date
sd Date
ed [Date]
ds
= case RangeType
rt of
RangeType
II -> (Date -> Bool) -> [Date] -> [Date]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Date
x -> Date
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
sd Bool -> Bool -> Bool
&& Date
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
<= Date
ed ) [Date]
ds
RangeType
EI -> (Date -> Bool) -> [Date] -> [Date]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Date
x -> Date
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
sd Bool -> Bool -> Bool
&& Date
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
<= Date
ed ) [Date]
ds
RangeType
IE -> (Date -> Bool) -> [Date] -> [Date]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Date
x -> Date
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
sd Bool -> Bool -> Bool
&& Date
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
< Date
ed ) [Date]
ds
RangeType
EE -> (Date -> Bool) -> [Date] -> [Date]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Date
x -> Date
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
sd Bool -> Bool -> Bool
&& Date
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
< Date
ed ) [Date]
ds
RangeType
NO_IE -> [Char] -> [Date]
forall a. HasCallStack => [Char] -> a
error [Char]
"Need to specify II/EI/EE/IE when subset dates vector "
data SliceType = SliceAfter Date
| SliceOnAfter Date
| SliceAfterKeepPrevious Date
| SliceOnAfterKeepPrevious Date
sliceDates :: SliceType -> [Date] -> [Date]
sliceDates :: SliceType -> [Date] -> [Date]
sliceDates SliceType
st [Date]
ds =
case SliceType
st of
SliceAfter Date
d -> (Date -> Bool) -> [Date] -> [Date]
forall a. (a -> Bool) -> [a] -> [a]
filter (Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
d) [Date]
ds
SliceOnAfter Date
d -> (Date -> Bool) -> [Date] -> [Date]
forall a. (a -> Bool) -> [a] -> [a]
filter (Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
d) [Date]
ds
SliceAfterKeepPrevious Date
d ->
case (Date -> Bool) -> [Date] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
d) [Date]
ds of
Just Int
idx -> ([Date], [Date]) -> [Date]
forall a b. (a, b) -> b
snd (([Date], [Date]) -> [Date]) -> ([Date], [Date]) -> [Date]
forall a b. (a -> b) -> a -> b
$ Int -> [Date] -> ([Date], [Date])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int
forall a. Enum a => a -> a
pred Int
idx) [Date]
ds
Maybe Int
Nothing -> []
SliceOnAfterKeepPrevious Date
d ->
case (Date -> Bool) -> [Date] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
d) [Date]
ds of
Just Int
idx -> ([Date], [Date]) -> [Date]
forall a b. (a, b) -> b
snd (([Date], [Date]) -> [Date]) -> ([Date], [Date]) -> [Date]
forall a b. (a -> b) -> a -> b
$ Int -> [Date] -> ([Date], [Date])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int
forall a. Enum a => a -> a
pred Int
idx) [Date]
ds
Maybe Int
Nothing -> []
projDatesByPattern :: DatePattern -> Date -> Date -> Dates
projDatesByPattern :: DatePattern -> Date -> Date -> [Date]
projDatesByPattern DatePattern
dp Date
sd Date
ed
= let
(T.CalendarDiffDays Year
cdm Year
cdd) = Date -> Date -> CalendarDiffDays
T.diffGregorianDurationClip Date
ed Date
sd
num :: Year
num = case DatePattern
dp of
DatePattern
MonthEnd -> Year
cdm Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
1
DatePattern
QuarterEnd -> Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
cdm Year
3 Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
1
DatePattern
YearEnd -> Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
cdm Year
12 Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
1
DatePattern
MonthFirst -> Year
cdm Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
1
DatePattern
QuarterFirst -> Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
cdm Year
3 Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
1
DatePattern
YearFirst -> Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
cdm Year
12 Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
1
MonthDayOfYear Int
_ Int
_ -> Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
cdm Year
12 Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
1
DayOfMonth Int
_ -> Year
cdm Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
1
in
DatePattern -> CutoffType -> Date -> Int -> [Date]
genSerialDates DatePattern
dp CutoffType
Inc Date
sd (Year -> Int
forall {a}. Num a => Year -> a
fromInteger Year
num)
splitByDate :: TimeSeries a => [a] -> Date -> SplitType -> ([a],[a])
splitByDate :: forall a. TimeSeries a => [a] -> Date -> SplitType -> ([a], [a])
splitByDate [a]
xs Date
d SplitType
st
= case SplitType
st of
SplitType
EqToLeft -> (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\a
x -> a -> Date
forall ts. TimeSeries ts => ts -> Date
getDate a
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
<= Date
d) [a]
xs
SplitType
EqToRight -> (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\a
x -> a -> Date
forall ts. TimeSeries ts => ts -> Date
getDate a
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
< Date
d) [a]
xs
SplitType
EqToLeftKeepOne ->
case (a -> Bool) -> [a] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\a
x -> a -> Date
forall ts. TimeSeries ts => ts -> Date
getDate a
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
d ) [a]
xs of
Just Int
idx -> Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int
forall a. Enum a => a -> a
pred Int
idx) [a]
xs
Maybe Int
Nothing -> ([a]
xs,[])
monthsAfter :: Date -> Integer -> Date
monthsAfter :: Date -> Year -> Date
monthsAfter Date
d Year
n = CalendarDiffDays -> Date -> Date
T.addGregorianDurationClip (Year -> Year -> CalendarDiffDays
T.CalendarDiffDays Year
n Year
0) Date
d
getIntervalFactorsDc :: DayCount -> [Date] -> [Rate]
getIntervalFactorsDc :: DayCount -> [Date] -> [Rational]
getIntervalFactorsDc DayCount
dc [Date]
ds
= (Date -> Date -> Rational) -> [Date] -> [Date] -> [Rational]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (DayCount -> Date -> Date -> Rational
yearCountFraction DayCount
dc) ([Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
init [Date]
ds) ([Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
tail [Date]
ds)
daysInterval :: [Date] -> [Integer]
daysInterval :: [Date] -> [Year]
daysInterval [Date]
ds = (Date -> Date -> Year) -> [Date] -> [Date] -> [Year]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Date -> Date -> Year
daysBetween ([Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
init [Date]
ds) ([Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
tail [Date]
ds)