{-# LINE 1 "./QuantLib/Time/Calendar.chs" #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module QuantLib.Time.Calendar
(
Calendar
, CalendarConstructor(..)
, JointCalendarRule(..)
, BusinessDayConvention(..)
, calendar
, addHoliday
, removeHoliday
, adjust
, advance
, businessDaysBetween
, endOfMonth
, isBusinessDay
, isEndOfMonth
, isHoliday
, isWeekend
, holidays
) where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import QuantLib.Internal
import QuantLib.Internal.Type
import QuantLib.Time.Date(Weekday)
import QuantLib.Internal.Common
import QuantLib.Internal.CalendarEnum
import System.IO.Unsafe(unsafePerformIO)
{-# LINE 45 "./QuantLib/Time/Calendar.chs" #-}
qlCalendar :: (Int) -> (Int) -> IO ((Calendar))
qlCalendar a1 a2 =
let {a1' = fromIntegral a1} in
let {a2' = fromIntegral a2} in
preErrorCheck $ \a3' ->
qlCalendar'_ a1' a2' a3' >>= \res ->
peekCalendar res >>= \res' ->
errorCheck a3'>>
return (res')
{-# LINE 48 "./QuantLib/Time/Calendar.chs" #-}
calendar :: CalendarConstructor -> IO Calendar
calendar (Bespoke n w) = qlBespokeCalendar n w
calendar (Joint2 c1 c2 r) = qlJointCalendar2 c1 c2 r
calendar (Joint3 c1 c2 c3 r) = qlJointCalendar3 c1 c2 c3 r
calendar (Joint4 c1 c2 c3 c4 r) = qlJointCalendar4 c1 c2 c3 c4 r
calendar x = uncurry qlCalendar $ mapCalendar x
adjust :: (Calendar) -> (Day) -> (BusinessDayConvention) -> IO ((Day))
adjust :: Calendar -> Day -> BusinessDayConvention -> IO Day
adjust Calendar
a1 Day
a2 BusinessDayConvention
a3 =
Calendar -> (Ptr CCalendar -> IO Day) -> IO Day
forall b. Calendar -> (Ptr CCalendar -> IO b) -> IO b
withCalendar Calendar
a1 ((Ptr CCalendar -> IO Day) -> IO Day)
-> (Ptr CCalendar -> IO Day) -> IO Day
forall a b. (a -> b) -> a -> b
$ \Ptr CCalendar
a1' ->
Day -> (CInt -> IO Day) -> IO Day
forall a. Day -> (CInt -> IO a) -> IO a
withDay Day
a2 ((CInt -> IO Day) -> IO Day) -> (CInt -> IO Day) -> IO Day
forall a b. (a -> b) -> a -> b
$ \CInt
a2' ->
let {a3' :: CInt
a3' = BusinessDayConvention -> CInt
forall a b. (Enum a, Integral b) => a -> b
fromEnumC BusinessDayConvention
a3} in
(Ptr (Ptr CChar) -> IO Day) -> IO Day
forall a b. (Ptr (Ptr a) -> IO b) -> IO b
preErrorCheck ((Ptr (Ptr CChar) -> IO Day) -> IO Day)
-> (Ptr (Ptr CChar) -> IO Day) -> IO Day
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
a4' ->
Ptr CCalendar -> CInt -> CInt -> Ptr (Ptr CChar) -> IO CInt
adjust'_ Ptr CCalendar
a1' CInt
a2' CInt
a3' Ptr (Ptr CChar)
a4' IO CInt -> (CInt -> IO Day) -> IO Day
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
let {res' = CInt -> Day
toDay CInt
res} in
Ptr (Ptr CChar) -> IO ()
errorCheck Ptr (Ptr CChar)
a4'IO () -> IO Day -> IO Day
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Day -> IO Day
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Day
res')
{-# LINE 58 "./QuantLib/Time/Calendar.chs" #-}
advance :: (Calendar) -> (Day) -> ((Int,TimeUnit)) -> (BusinessDayConvention) -> (Bool)
-> IO ((Day))
advance a1 a2 a3 a4 a5 =
withCalendar a1 $ \a1' ->
withDay a2 $ \a2' ->
let {(a3'1, a3'2) = fromEnumQuantity a3} in
let {a4' = fromEnumC a4} in
let {a5' = C2HSImp.fromBool a5} in
preErrorCheck $ \a6' ->
advance'_ a1' a2' a3'1 a3'2 a4' a5' a6' >>= \res ->
let {res' = toDay res} in
errorCheck a6'>>
return (res')
{-# LINE 62 "./QuantLib/Time/Calendar.chs" #-}
addHoliday :: (Calendar) -> (Day) -> IO ()
addHoliday a1 a2 =
withCalendar a1 $ \a1' ->
withDay a2 $ \a2' ->
preErrorCheck $ \a3' ->
addHoliday'_ a1' a2' a3' >>
errorCheck a3'>>
return ()
{-# LINE 65 "./QuantLib/Time/Calendar.chs" #-}
businessDaysBetween :: (Calendar) -> (Day) -> (Day) -> (Bool)
-> (Bool)
-> IO ((Int))
businessDaysBetween a1 a2 a3 a4 a5 =
withCalendar a1 $ \a1' ->
withDay a2 $ \a2' ->
withDay a3 $ \a3' ->
let {a4' = C2HSImp.fromBool a4} in
let {a5' = C2HSImp.fromBool a5} in
preErrorCheck $ \a6' ->
businessDaysBetween'_ a1' a2' a3' a4' a5' a6' >>= \res ->
let {res' = fromIntegral res} in
errorCheck a6'>>
return (res')
{-# LINE 71 "./QuantLib/Time/Calendar.chs" #-}
endOfMonth :: (Calendar) -> (Day) -> IO ((Day))
endOfMonth a1 a2 =
withCalendar a1 $ \a1' ->
withDay a2 $ \a2' ->
preErrorCheck $ \a3' ->
endOfMonth'_ a1' a2' a3' >>= \res ->
let {res' = toDay res} in
errorCheck a3'>>
return (res')
{-# LINE 74 "./QuantLib/Time/Calendar.chs" #-}
isBusinessDay :: (Calendar) -> (Day) -> IO ((Bool))
isBusinessDay a1 a2 =
withCalendar a1 $ \a1' ->
withDay a2 $ \a2' ->
preErrorCheck $ \a3' ->
isBusinessDay'_ a1' a2' a3' >>= \res ->
let {res' = C2HSImp.toBool res} in
errorCheck a3'>>
return (res')
{-# LINE 77 "./QuantLib/Time/Calendar.chs" #-}
isEndOfMonth :: (Calendar) -> (Day) -> IO ((Bool))
isEndOfMonth a1 a2 =
withCalendar a1 $ \a1' ->
withDay a2 $ \a2' ->
preErrorCheck $ \a3' ->
isEndOfMonth'_ a1' a2' a3' >>= \res ->
let {res' = C2HSImp.toBool res} in
errorCheck a3'>>
return (res')
{-# LINE 80 "./QuantLib/Time/Calendar.chs" #-}
isHoliday :: (Calendar) -> (Day) -> IO ((Bool))
isHoliday a1 a2 =
withCalendar a1 $ \a1' ->
withDay a2 $ \a2' ->
preErrorCheck $ \a3' ->
isHoliday'_ a1' a2' a3' >>= \res ->
let {res' = C2HSImp.toBool res} in
errorCheck a3'>>
return (res')
{-# LINE 83 "./QuantLib/Time/Calendar.chs" #-}
isWeekend :: (Calendar) -> (Weekday) -> IO ((Bool))
isWeekend a1 a2 =
withCalendar a1 $ \a1' ->
let {a2' = (fromIntegral . fromEnum) a2} in
preErrorCheck $ \a3' ->
isWeekend'_ a1' a2' a3' >>= \res ->
let {res' = C2HSImp.toBool res} in
errorCheck a3'>>
return (res')
{-# LINE 86 "./QuantLib/Time/Calendar.chs" #-}
removeHoliday :: (Calendar) -> (Day) -> IO ()
removeHoliday a1 a2 =
withCalendar a1 $ \a1' ->
withDay a2 $ \a2' ->
preErrorCheck $ \a3' ->
removeHoliday'_ a1' a2' a3' >>
errorCheck a3'>>
return ()
{-# LINE 89 "./QuantLib/Time/Calendar.chs" #-}
qlBespokeCalendar :: (String) -> ([Weekday]) -> IO ((Calendar))
qlBespokeCalendar a1 a2 =
C2HSImp.withCString a1 $ \a1' ->
withEnumArray a2 $ \(a2'1, a2'2) ->
preErrorCheck $ \a3' ->
qlBespokeCalendar'_ a1' a2'1 a2'2 a3' >>= \res ->
peekCalendar res >>= \res' ->
errorCheck a3'>>
return (res')
{-# LINE 92 "./QuantLib/Time/Calendar.chs" #-}
qlJointCalendar3 :: (Calendar) -> (Calendar) -> (Calendar) -> (JointCalendarRule) -> IO ((Calendar))
qlJointCalendar3 a1 a2 a3 a4 =
withCalendar a1 $ \a1' ->
withCalendar a2 $ \a2' ->
withCalendar a3 $ \a3' ->
let {a4' = fromEnumC a4} in
preErrorCheck $ \a5' ->
qlJointCalendar3'_ a1' a2' a3' a4' a5' >>= \res ->
peekCalendar res >>= \res' ->
errorCheck a5'>>
return (res')
{-# LINE 95 "./QuantLib/Time/Calendar.chs" #-}
qlJointCalendar2 :: (Calendar) -> (Calendar) -> (JointCalendarRule) -> IO ((Calendar))
qlJointCalendar2 a1 a2 a3 =
withCalendar a1 $ \a1' ->
withCalendar a2 $ \a2' ->
let {a3' = fromEnumC a3} in
preErrorCheck $ \a4' ->
qlJointCalendar2'_ a1' a2' a3' a4' >>= \res ->
peekCalendar res >>= \res' ->
errorCheck a4'>>
return (res')
{-# LINE 98 "./QuantLib/Time/Calendar.chs" #-}
qlJointCalendar4 :: (Calendar) -> (Calendar) -> (Calendar) -> (Calendar) -> (JointCalendarRule) -> IO ((Calendar))
qlJointCalendar4 a1 a2 a3 a4 a5 =
withCalendar a1 $ \a1' ->
withCalendar a2 $ \a2' ->
withCalendar a3 $ \a3' ->
withCalendar a4 $ \a4' ->
let {a5' = fromEnumC a5} in
preErrorCheck $ \a6' ->
qlJointCalendar4'_ a1' a2' a3' a4' a5' a6' >>= \res ->
peekCalendar res >>= \res' ->
errorCheck a6'>>
return (res')
{-# LINE 101 "./QuantLib/Time/Calendar.chs" #-}
holidays :: (Calendar) -> (Day)
-> (Day)
-> (Bool)
-> IO (([Day]))
holidays a1 a2 a3 a4 =
withCalendar a1 $ \a1' ->
withDay a2 $ \a2' ->
withDay a3 $ \a3' ->
let {a4' = C2HSImp.fromBool a4} in
preArray $ \(a5'1, a5'2) ->
preErrorCheck $ \a6' ->
holidays'_ a1' a2' a3' a4' a5'1 a5'2 a6' >>
peekDayArray a5'1 a5'2>>= \a5'' ->
errorCheck a6'>>
return (a5'')
{-# LINE 107 "./QuantLib/Time/Calendar.chs" #-}
unsafeCalendar :: CalendarConstructor -> Calendar
unsafeCalendar = unsafePerformIO . calendar
{-# NOINLINE unsafeCalendar #-}
instance Read CalendarConstructor where
readsPrec :: Int -> ReadS CalendarConstructor
readsPrec Int
d String
r = Int -> ReadS CalendarConstructor
readCalendarConstructorPlain Int
d String
r
[(CalendarConstructor, String)]
-> [(CalendarConstructor, String)]
-> [(CalendarConstructor, String)]
forall a. [a] -> [a] -> [a]
++ Bool -> ReadS CalendarConstructor -> ReadS CalendarConstructor
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (\String
r' ->
[ (Calendar -> Calendar -> JointCalendarRule -> CalendarConstructor
Joint2 Calendar
c1 Calendar
c2 JointCalendarRule
rule, String
s3)
| (String
"Joint2", String
s0) <- ReadS String
lex String
r'
, (CalendarConstructor
p1, String
s1) <- Int -> ReadS CalendarConstructor
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s0, let c1 :: Calendar
c1 = CalendarConstructor -> Calendar
unsafeCalendar CalendarConstructor
p1
, (CalendarConstructor
p2, String
s2) <- Int -> ReadS CalendarConstructor
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s1, let c2 :: Calendar
c2 = CalendarConstructor -> Calendar
unsafeCalendar CalendarConstructor
p2
, (JointCalendarRule
rule, String
s3) <- Int -> ReadS JointCalendarRule
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s2
]) String
r
[(CalendarConstructor, String)]
-> [(CalendarConstructor, String)]
-> [(CalendarConstructor, String)]
forall a. [a] -> [a] -> [a]
++ Bool -> ReadS CalendarConstructor -> ReadS CalendarConstructor
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (\String
r' ->
[ (Calendar
-> Calendar -> Calendar -> JointCalendarRule -> CalendarConstructor
Joint3 Calendar
c1 Calendar
c2 Calendar
c3 JointCalendarRule
rule, String
s4)
| (String
"Joint3", String
s0) <- ReadS String
lex String
r'
, (CalendarConstructor
p1, String
s1) <- Int -> ReadS CalendarConstructor
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s0, let c1 :: Calendar
c1 = CalendarConstructor -> Calendar
unsafeCalendar CalendarConstructor
p1
, (CalendarConstructor
p2, String
s2) <- Int -> ReadS CalendarConstructor
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s1, let c2 :: Calendar
c2 = CalendarConstructor -> Calendar
unsafeCalendar CalendarConstructor
p2
, (CalendarConstructor
p3, String
s3) <- Int -> ReadS CalendarConstructor
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s2, let c3 :: Calendar
c3 = CalendarConstructor -> Calendar
unsafeCalendar CalendarConstructor
p3
, (JointCalendarRule
rule, String
s4) <- Int -> ReadS JointCalendarRule
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s3
]) String
r
[(CalendarConstructor, String)]
-> [(CalendarConstructor, String)]
-> [(CalendarConstructor, String)]
forall a. [a] -> [a] -> [a]
++ Bool -> ReadS CalendarConstructor -> ReadS CalendarConstructor
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (\String
r' ->
[ (Calendar
-> Calendar
-> Calendar
-> Calendar
-> JointCalendarRule
-> CalendarConstructor
Joint4 Calendar
c1 Calendar
c2 Calendar
c3 Calendar
c4 JointCalendarRule
rule, String
s5)
| (String
"Joint4", String
s0) <- ReadS String
lex String
r'
, (CalendarConstructor
p1, String
s1) <- Int -> ReadS CalendarConstructor
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s0, let c1 :: Calendar
c1 = CalendarConstructor -> Calendar
unsafeCalendar CalendarConstructor
p1
, (CalendarConstructor
p2, String
s2) <- Int -> ReadS CalendarConstructor
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s1, let c2 :: Calendar
c2 = CalendarConstructor -> Calendar
unsafeCalendar CalendarConstructor
p2
, (CalendarConstructor
p3, String
s3) <- Int -> ReadS CalendarConstructor
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s2, let c3 :: Calendar
c3 = CalendarConstructor -> Calendar
unsafeCalendar CalendarConstructor
p3
, (CalendarConstructor
p4, String
s4) <- Int -> ReadS CalendarConstructor
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s3, let c4 :: Calendar
c4 = CalendarConstructor -> Calendar
unsafeCalendar CalendarConstructor
p4
, (JointCalendarRule
rule, String
s5) <- Int -> ReadS JointCalendarRule
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s4
]) String
r
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendar"
qlCalendar'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CCalendar))))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarAdjust"
adjust'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt)))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarAdvance"
advance'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarAddHoliday"
addHoliday'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO ()))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarBusinessDaysBetween"
businessDaysBetween'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt)))))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarEndOfMonth"
endOfMonth'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarIsBusinessDay"
isBusinessDay'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarIsEndOfMonth"
isEndOfMonth'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarIsHoliday"
isHoliday'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarIsWeekend"
isWeekend'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarRemoveHoliday"
removeHoliday'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO ()))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlBespokeCalendar"
qlBespokeCalendar'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CCalendar)))))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlJointCalendar3"
qlJointCalendar3'_ :: ((C2HSImp.Ptr (CCalendar)) -> ((C2HSImp.Ptr (CCalendar)) -> ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CCalendar))))))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlJointCalendar2"
qlJointCalendar2'_ :: ((C2HSImp.Ptr (CCalendar)) -> ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CCalendar)))))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlJointCalendar4"
qlJointCalendar4'_ :: ((C2HSImp.Ptr (CCalendar)) -> ((C2HSImp.Ptr (CCalendar)) -> ((C2HSImp.Ptr (CCalendar)) -> ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CCalendar)))))))))
foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarHolidayList"
holidays'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CInt)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO ()))))))))