never executed always true always false
1 -- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
2 -- Edit the ORIGNAL .chs file instead!
3
4
5 -- CalendarConstructor is declared in QuantLib.Internal.CalendarEnum, but its Read instance
6 -- needs `calendar` (below), and CalendarEnum -> Calendar -> CalendarEnum would be a cycle if
7 -- the instance lived there instead -- see deriveReadPlain's comment in Internal/Syntax.hs.
8 -- Deliberate, not a stray orphan.
9 {-# OPTIONS_GHC -Wno-orphans #-}
10 module QuantLib.Time.Calendar
11 (
12 JointCalendarRule(..)
13 , CalendarConstructor(..)
14
15 , Calendar
16 , calendar
17 , adjust
18 , advance
19 , addHoliday
20 , businessDaysBetween
21 , endOfMonth
22 , isBusinessDay
23 , isEndOfMonth
24 , isHoliday
25 , isWeekend
26 , removeHoliday
27 , holidays
28 , BusinessDayConvention(..)
29 ) where
30 import qualified Foreign.C.String as C2HSImp
31 import qualified Foreign.C.Types as C2HSImp
32 import qualified Foreign.ForeignPtr as C2HSImp
33 import qualified Foreign.Marshal.Utils as C2HSImp
34 import qualified Foreign.Ptr as C2HSImp
35
36
37 import QuantLib.Internal
38 import QuantLib.Internal.Type
39 import QuantLib.Time.Date(Weekday)
40 import QuantLib.Internal.Common
41 import QuantLib.Internal.CalendarEnum
42 import System.IO.Unsafe(unsafePerformIO)
43
44
45
46
47
48
49
50
51
52
53 -- |Constructs the calendar for the given country, with an optional market variant.
54 qlCalendar :: (Int) -> (Int) -> IO ((Calendar))
55 qlCalendar a1 a2 =
56 let {a1' = fromIntegral a1} in
57 let {a2' = fromIntegral a2} in
58 preErrorCheck $ \a3' ->
59 qlCalendar'_ a1' a2' a3' >>= \res ->
60 peekCalendar res >>= \res' ->
61 errorCheck a3'>>
62 return (res')
63
64
65
66 calendar :: CalendarConstructor -> IO Calendar
67 calendar (Bespoke n w) = qlBespokeCalendar n w
68 calendar (Joint2 c1 c2 r) = qlJointCalendar2 c1 c2 r
69 calendar (Joint3 c1 c2 c3 r) = qlJointCalendar3 c1 c2 c3 r
70 calendar (Joint4 c1 c2 c3 c4 r) = qlJointCalendar4 c1 c2 c3 c4 r
71 calendar x = uncurry qlCalendar $ mapCalendar x
72
73 -- |Adjusts a non-business day to the appropriate near business day with respect to the given convention
74 adjust :: (Calendar) -> (Day) -> (BusinessDayConvention) -> IO ((Day))
75 adjust a1 a2 a3 =
76 withCalendar a1 $ \a1' ->
77 withDay a2 $ \a2' ->
78 let {a3' = fromEnumC a3} in
79 preErrorCheck $ \a4' ->
80 adjust'_ a1' a2' a3' a4' >>= \res ->
81 let {res' = toDay res} in
82 errorCheck a4'>>
83 return (res')
84
85
86
87 -- |Advances the given date of the given number of business days and returns the result using business day convention and the EOM flag
88 advance :: (Calendar) -> (Day) -> ((Int,TimeUnit)) -> (BusinessDayConvention) -> (Bool) -- ^endOfMonth
89 -> IO ((Day))
90 advance a1 a2 a3 a4 a5 =
91 withCalendar a1 $ \a1' ->
92 withDay a2 $ \a2' ->
93 let {(a3'1, a3'2) = fromEnumQuantity a3} in
94 let {a4' = fromEnumC a4} in
95 let {a5' = C2HSImp.fromBool a5} in
96 preErrorCheck $ \a6' ->
97 advance'_ a1' a2' a3'1 a3'2 a4' a5' a6' >>= \res ->
98 let {res' = toDay res} in
99 errorCheck a6'>>
100 return (res')
101
102
103
104 -- |Adds a date to the set of holidays for the given calendar.
105 addHoliday :: (Calendar) -> (Day) -> IO ()
106 addHoliday a1 a2 =
107 withCalendar a1 $ \a1' ->
108 withDay a2 $ \a2' ->
109 preErrorCheck $ \a3' ->
110 addHoliday'_ a1' a2' a3' >>
111 errorCheck a3'>>
112 return ()
113
114
115
116 -- |Calculates the number of business days between two given dates and returns the result.
117 businessDaysBetween :: (Calendar) -> (Day) -> (Day) -> (Bool) -- ^includeFirst
118 -> (Bool) -- ^includeLast
119 -> IO ((Int))
120 businessDaysBetween a1 a2 a3 a4 a5 =
121 withCalendar a1 $ \a1' ->
122 withDay a2 $ \a2' ->
123 withDay a3 $ \a3' ->
124 let {a4' = C2HSImp.fromBool a4} in
125 let {a5' = C2HSImp.fromBool a5} in
126 preErrorCheck $ \a6' ->
127 businessDaysBetween'_ a1' a2' a3' a4' a5' a6' >>= \res ->
128 let {res' = fromIntegral res} in
129 errorCheck a6'>>
130 return (res')
131
132
133
134 -- |last business day of the month to which the given date belongs
135 endOfMonth :: (Calendar) -> (Day) -> IO ((Day))
136 endOfMonth a1 a2 =
137 withCalendar a1 $ \a1' ->
138 withDay a2 $ \a2' ->
139 preErrorCheck $ \a3' ->
140 endOfMonth'_ a1' a2' a3' >>= \res ->
141 let {res' = toDay res} in
142 errorCheck a3'>>
143 return (res')
144
145
146
147 -- |Returns true iff the date is a business day for the given market.
148 isBusinessDay :: (Calendar) -> (Day) -> IO ((Bool))
149 isBusinessDay a1 a2 =
150 withCalendar a1 $ \a1' ->
151 withDay a2 $ \a2' ->
152 preErrorCheck $ \a3' ->
153 isBusinessDay'_ a1' a2' a3' >>= \res ->
154 let {res' = C2HSImp.toBool res} in
155 errorCheck a3'>>
156 return (res')
157
158
159
160 -- |Returns true iff the date is last business day for the month in given market.
161 isEndOfMonth :: (Calendar) -> (Day) -> IO ((Bool))
162 isEndOfMonth a1 a2 =
163 withCalendar a1 $ \a1' ->
164 withDay a2 $ \a2' ->
165 preErrorCheck $ \a3' ->
166 isEndOfMonth'_ a1' a2' a3' >>= \res ->
167 let {res' = C2HSImp.toBool res} in
168 errorCheck a3'>>
169 return (res')
170
171
172
173 -- |Returns true iff the date is a holiday for the given market.
174 isHoliday :: (Calendar) -> (Day) -> IO ((Bool))
175 isHoliday a1 a2 =
176 withCalendar a1 $ \a1' ->
177 withDay a2 $ \a2' ->
178 preErrorCheck $ \a3' ->
179 isHoliday'_ a1' a2' a3' >>= \res ->
180 let {res' = C2HSImp.toBool res} in
181 errorCheck a3'>>
182 return (res')
183
184
185
186 -- |Returns true iff the weekday is part of the weekend for the given market.
187 isWeekend :: (Calendar) -> (Weekday) -> IO ((Bool))
188 isWeekend a1 a2 =
189 withCalendar a1 $ \a1' ->
190 let {a2' = (fromIntegral . fromEnum) a2} in
191 preErrorCheck $ \a3' ->
192 isWeekend'_ a1' a2' a3' >>= \res ->
193 let {res' = C2HSImp.toBool res} in
194 errorCheck a3'>>
195 return (res')
196
197
198
199 -- |Removes a date from the set of holidays for the given calendar.
200 removeHoliday :: (Calendar) -> (Day) -> IO ()
201 removeHoliday a1 a2 =
202 withCalendar a1 $ \a1' ->
203 withDay a2 $ \a2' ->
204 preErrorCheck $ \a3' ->
205 removeHoliday'_ a1' a2' a3' >>
206 errorCheck a3'>>
207 return ()
208
209
210
211 -- |Builds a calendar with no predefined business days; the given weekdays become its weekend.
212 qlBespokeCalendar :: (String) -> ([Weekday]) -> IO ((Calendar))
213 qlBespokeCalendar a1 a2 =
214 C2HSImp.withCString a1 $ \a1' ->
215 withEnumArray a2 $ \(a2'1, a2'2) ->
216 preErrorCheck $ \a3' ->
217 qlBespokeCalendar'_ a1' a2'1 a2'2 a3' >>= \res ->
218 peekCalendar res >>= \res' ->
219 errorCheck a3'>>
220 return (res')
221
222
223
224 -- |Combines three calendars into one whose business days are the union or intersection of theirs, per the given rule.
225 qlJointCalendar3 :: (Calendar) -> (Calendar) -> (Calendar) -> (JointCalendarRule) -> IO ((Calendar))
226 qlJointCalendar3 a1 a2 a3 a4 =
227 withCalendar a1 $ \a1' ->
228 withCalendar a2 $ \a2' ->
229 withCalendar a3 $ \a3' ->
230 let {a4' = fromEnumC a4} in
231 preErrorCheck $ \a5' ->
232 qlJointCalendar3'_ a1' a2' a3' a4' a5' >>= \res ->
233 peekCalendar res >>= \res' ->
234 errorCheck a5'>>
235 return (res')
236
237
238
239 -- |Combines two calendars into one whose business days are the union or intersection of theirs, per the given rule.
240 qlJointCalendar2 :: (Calendar) -> (Calendar) -> (JointCalendarRule) -> IO ((Calendar))
241 qlJointCalendar2 a1 a2 a3 =
242 withCalendar a1 $ \a1' ->
243 withCalendar a2 $ \a2' ->
244 let {a3' = fromEnumC a3} in
245 preErrorCheck $ \a4' ->
246 qlJointCalendar2'_ a1' a2' a3' a4' >>= \res ->
247 peekCalendar res >>= \res' ->
248 errorCheck a4'>>
249 return (res')
250
251
252
253 -- |Combines four calendars into one whose business days are the union or intersection of theirs, per the given rule.
254 qlJointCalendar4 :: (Calendar) -> (Calendar) -> (Calendar) -> (Calendar) -> (JointCalendarRule) -> IO ((Calendar))
255 qlJointCalendar4 a1 a2 a3 a4 a5 =
256 withCalendar a1 $ \a1' ->
257 withCalendar a2 $ \a2' ->
258 withCalendar a3 $ \a3' ->
259 withCalendar a4 $ \a4' ->
260 let {a5' = fromEnumC a5} in
261 preErrorCheck $ \a6' ->
262 qlJointCalendar4'_ a1' a2' a3' a4' a5' a6' >>= \res ->
263 peekCalendar res >>= \res' ->
264 errorCheck a6'>>
265 return (res')
266
267
268
269 -- |Returns the holidays between two dates.
270 holidays :: (Calendar) -> (Day) -- ^from
271 -> (Day) -- ^to
272 -> (Bool) -- ^includeWeekEnds
273 -> IO (([Day]))
274 holidays a1 a2 a3 a4 =
275 withCalendar a1 $ \a1' ->
276 withDay a2 $ \a2' ->
277 withDay a3 $ \a3' ->
278 let {a4' = C2HSImp.fromBool a4} in
279 preArray $ \(a5'1, a5'2) ->
280 preErrorCheck $ \a6' ->
281 holidays'_ a1' a2' a3' a4' a5'1 a5'2 a6' >>
282 peekDayArray a5'1 a5'2>>= \a5'' ->
283 errorCheck a6'>>
284 return (a5'')
285
286
287
288 -- The name of a QuantLib object is fixed for its lifetime, so materializing one through
289 -- unsafePerformIO during Read is as safe as showStandalone's own use of it above; NOINLINE
290 -- keeps GHC from duplicating or floating the C++ call, same reasoning as showStandalone's.
291 unsafeCalendar :: CalendarConstructor -> Calendar
292 unsafeCalendar = unsafePerformIO . calendar
293 {-# NOINLINE unsafeCalendar #-}
294
295 -- Hand-written, not `deriving`/TH-spliced: CalendarConstructor's Joint2/3/4 cases carry live
296 -- Calendar fields, which have no Read instance of their own (see
297 -- QuantLib.Internal.Syntax.deriveReadPlain's comment for why the generated part -- covering
298 -- everything except these three -- has to be spliced back in CalendarEnum.chs instead of
299 -- here). Each alternative below parses a nested CalendarConstructor and materializes it with
300 -- `calendar`, exactly what a caller passing a literal Joint2/3/4 value would already do.
301 instance Read CalendarConstructor where
302 readsPrec d r = readCalendarConstructorPlain d r
303 ++ readParen (d > 10) (\r' ->
304 [ (Joint2 c1 c2 rule, s3)
305 | ("Joint2", s0) <- lex r'
306 , (p1, s1) <- readsPrec 11 s0, let c1 = unsafeCalendar p1
307 , (p2, s2) <- readsPrec 11 s1, let c2 = unsafeCalendar p2
308 , (rule, s3) <- readsPrec 11 s2
309 ]) r
310 ++ readParen (d > 10) (\r' ->
311 [ (Joint3 c1 c2 c3 rule, s4)
312 | ("Joint3", s0) <- lex r'
313 , (p1, s1) <- readsPrec 11 s0, let c1 = unsafeCalendar p1
314 , (p2, s2) <- readsPrec 11 s1, let c2 = unsafeCalendar p2
315 , (p3, s3) <- readsPrec 11 s2, let c3 = unsafeCalendar p3
316 , (rule, s4) <- readsPrec 11 s3
317 ]) r
318 ++ readParen (d > 10) (\r' ->
319 [ (Joint4 c1 c2 c3 c4 rule, s5)
320 | ("Joint4", s0) <- lex r'
321 , (p1, s1) <- readsPrec 11 s0, let c1 = unsafeCalendar p1
322 , (p2, s2) <- readsPrec 11 s1, let c2 = unsafeCalendar p2
323 , (p3, s3) <- readsPrec 11 s2, let c3 = unsafeCalendar p3
324 , (p4, s4) <- readsPrec 11 s3, let c4 = unsafeCalendar p4
325 , (rule, s5) <- readsPrec 11 s4
326 ]) r
327
328 -- vim: set ff=unix ts=8 sts=2 sw=2 et:
329
330 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendar"
331 qlCalendar'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CCalendar))))))
332
333 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarAdjust"
334 adjust'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt)))))
335
336 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarAdvance"
337 advance'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))))))
338
339 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarAddHoliday"
340 addHoliday'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO ()))))
341
342 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarBusinessDaysBetween"
343 businessDaysBetween'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt)))))))
344
345 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarEndOfMonth"
346 endOfMonth'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))
347
348 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarIsBusinessDay"
349 isBusinessDay'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))
350
351 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarIsEndOfMonth"
352 isEndOfMonth'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))
353
354 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarIsHoliday"
355 isHoliday'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))
356
357 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarIsWeekend"
358 isWeekend'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))
359
360 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarRemoveHoliday"
361 removeHoliday'_ :: ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO ()))))
362
363 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlBespokeCalendar"
364 qlBespokeCalendar'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CCalendar)))))))
365
366 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlJointCalendar3"
367 qlJointCalendar3'_ :: ((C2HSImp.Ptr (CCalendar)) -> ((C2HSImp.Ptr (CCalendar)) -> ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CCalendar))))))))
368
369 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlJointCalendar2"
370 qlJointCalendar2'_ :: ((C2HSImp.Ptr (CCalendar)) -> ((C2HSImp.Ptr (CCalendar)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CCalendar)))))))
371
372 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlJointCalendar4"
373 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)))))))))
374
375 foreign import ccall safe "QuantLib/Time/Calendar.chs.h qlCalendarHolidayList"
376 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 ()))))))))