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