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 -- |process-global evaluation context: run-time library settings and the exception type
6 -- raised across the FFI boundary
7 module QuantLib.Context
8 (
9 -- * Types
10 Error(..)
11 , SettingsSnapshot(..)
12
13 -- * Mutators
14 , restoreSettings
15 , setEvaluationDate
16 , setEnforceTodaysHistoricFixings
17 , setIncludeTodaysCashFlows
18 , setIncludeReferenceDateEvents
19 , disableUpdates
20 , enableUpdates
21 , keepingSettings
22 , keepingSettingsGc
23 , collectGarbage
24 , setExtendedPrecision
25
26 -- * Inspectors
27 , captureSettings
28 , evaluationDate
29 , enforceTodaysHistoricFixings
30 , includeTodaysCashFlows
31 , includeReferenceDateEvents
32 , updatesEnabled
33 , updatesDeferred
34 , version
35 , boostVersion
36 , epsilon
37 ) where
38 import qualified Foreign.C.Types as C2HSImp
39 import qualified Foreign.Marshal.Utils as C2HSImp
40 import qualified Foreign.Ptr as C2HSImp
41
42
43 import Foreign.C.Types(CDouble)
44 import Foreign.C.String(CString, peekCString)
45 import System.IO.Unsafe(unsafePerformIO)
46 import System.Mem(performGC)
47 import Control.Exception(bracket, SomeException, try, throwIO)
48 import Control.Monad (forM)
49
50 import QuantLib.Time.Date
51 import QuantLib.Internal
52
53
54
55
56 -- |Sets the x87 floating-point unit to 64-bit extended precision. On Windows, call on
57 -- each OS thread before it prices, since the control word is per-thread; a no-op elsewhere.
58 setExtendedPrecision :: IO ()
59 setExtendedPrecision =
60 setExtendedPrecision'_ >>
61 return ()
62
63
64
65 -- Padding: being the file's first {#fun#}, this entry absorbs c2hs's module-header
66 -- line-count drift; without enough real distance to the next entry, Haddock
67 -- misattaches this doc to that one (see c2hs-shim-patterns's LINE-pragma note).
68
69
70
71
72 -- |returns the current value of the Evaluation Date: the date at which pricing is to be performed
73 evaluationDate :: IO ((Day))
74 evaluationDate =
75 evaluationDate'_ >>= \res ->
76 let {res' = toDay res} in
77 return (res')
78
79
80
81 -- |sets the value of the Evaluation Date.
82 -- Nothing sets the evaluation date to Date::todaysDate() and allow it to change at midnight.
83 -- This comes at the price of losing some performance, since the evaluation date is re-evaluated each time it is read.
84 setEvaluationDate :: (Maybe Day) -> IO ()
85 setEvaluationDate a1 =
86 withMaybeDay a1 $ \a1' ->
87 preErrorCheck $ \a2' ->
88 setEvaluationDate'_ a1' a2' >>
89 errorCheck a2'>>
90 return ()
91
92
93
94 -- |returns the current value of the boolean which enforce the usage of historic
95 -- fixings for today's date
96 enforceTodaysHistoricFixings :: IO ((Bool))
97 enforceTodaysHistoricFixings =
98 enforceTodaysHistoricFixings'_ >>= \res ->
99 let {res' = C2HSImp.toBool res} in
100 return (res')
101
102
103
104 -- |sets the value of the boolean which enforce the usage of historic fixings for today's date
105 setEnforceTodaysHistoricFixings :: (Bool) -> IO ()
106 setEnforceTodaysHistoricFixings a1 =
107 let {a1' = C2HSImp.fromBool a1} in
108 setEnforceTodaysHistoricFixings'_ a1' >>
109 return ()
110
111
112
113 -- |if set, whether CashFlows occurring on today's date should enter the NPV; when the NPV date
114 -- equals today's date this overrides includeReferenceDateEvents and cannot be overridden locally
115 includeTodaysCashFlows :: IO ((Maybe Bool))
116 includeTodaysCashFlows =
117 includeTodaysCashFlows'_ >>= \res ->
118 let {res' = toMaybeBool res} in
119 return (res')
120
121
122
123 -- |sets whether CashFlows occurring on today's date should enter the NPV
124 setIncludeTodaysCashFlows :: (Maybe Bool) -> IO ()
125 setIncludeTodaysCashFlows a1 =
126 let {a1' = fromMaybeBool a1} in
127 setIncludeTodaysCashFlows'_ a1' >>
128 return ()
129
130
131
132 -- |This flag specifies whether or not Events occurring on the reference date should, by default, be taken into account as not happened yet. It can be overridden locally when calling the Event::hasOccurred method.
133 includeReferenceDateEvents :: IO ((Bool))
134 includeReferenceDateEvents =
135 includeReferenceDateEvents'_ >>= \res ->
136 let {res' = C2HSImp.toBool res} in
137 return (res')
138
139
140
141 -- |sets whether Events occurring on the reference date should, by default, be taken into account as not happened yet
142 setIncludeReferenceDateEvents :: (Bool) -> IO ()
143 setIncludeReferenceDateEvents a1 =
144 let {a1' = C2HSImp.fromBool a1} in
145 setIncludeReferenceDateEvents'_ a1' >>
146 return ()
147
148
149
150 -- |Disables observer notifications. When @deferred@ is 'True', notifications are queued until
151 -- 'enableUpdates' is called; otherwise they are discarded.
152 disableUpdates :: (Bool) -- ^deferred
153 -> IO ()
154 disableUpdates a1 =
155 let {a1' = C2HSImp.fromBool a1} in
156 disableUpdates'_ a1' >>
157 return ()
158
159
160
161 -- |Enables observer notifications and runs any notifications queued while updates were deferred.
162 enableUpdates :: IO ()
163 enableUpdates =
164 preErrorCheck $ \a1' ->
165 enableUpdates'_ a1' >>
166 errorCheck a1'>>
167 return ()
168
169
170
171 -- |Whether observer notifications are currently enabled.
172 updatesEnabled :: IO ((Bool))
173 updatesEnabled =
174 updatesEnabled'_ >>= \res ->
175 let {res' = C2HSImp.toBool res} in
176 return (res')
177
178
179
180 -- |Whether observer notifications are currently disabled with deferred delivery enabled.
181 updatesDeferred :: IO ((Bool))
182 updatesDeferred =
183 updatesDeferred'_ >>= \res ->
184 let {res' = C2HSImp.toBool res} in
185 return (res')
186
187
188
189 -- |A value snapshot of pricing and observer settings. A 'Nothing' date retains the
190 -- floating evaluation-date mode; it is not replaced with today's date.
191 data SettingsSnapshot = SettingsSnapshot
192 { snapshotEvaluationDate :: Maybe Day
193 , snapshotEnforceTodaysHistoricFixings :: Bool
194 , snapshotIncludeTodaysCashFlows :: Maybe Bool
195 , snapshotIncludeReferenceDateEvents :: Bool
196 , snapshotUpdatesEnabled :: Bool
197 , snapshotUpdatesDeferred :: Bool
198 } deriving (Eq, Show)
199
200 -- |Copies all settings preserved by 'keepingSettings', including the raw date mode.
201 captureSettings :: IO SettingsSnapshot
202 captureSettings = SettingsSnapshot <$> rawEvaluationDate <*> enforceTodaysHistoricFixings
203 <*> includeTodaysCashFlows <*> includeReferenceDateEvents <*> updatesEnabled <*> updatesDeferred
204
205 rawEvaluationDate :: IO ((Maybe Day))
206 rawEvaluationDate =
207 rawEvaluationDate'_ >>= \res ->
208 let {res' = toMaybeDay res} in
209 return (res')
210
211
212
213 -- |Restores a snapshot and reports errors rather than suppressing them as the native
214 -- SavedSettings destructor does. Every field is attempted even if an observer throws.
215 restoreSettings :: SettingsSnapshot -> IO ()
216 restoreSettings s = do
217 results <- forM
218 [ setEnforceTodaysHistoricFixings (snapshotEnforceTodaysHistoricFixings s)
219 , setIncludeTodaysCashFlows (snapshotIncludeTodaysCashFlows s)
220 , setIncludeReferenceDateEvents (snapshotIncludeReferenceDateEvents s)
221 , setEvaluationDate (snapshotEvaluationDate s)
222 , if snapshotUpdatesEnabled s then enableUpdates else disableUpdates (snapshotUpdatesDeferred s)
223 ] (try :: IO () -> IO (Either SomeException ()))
224 case [e | Left e <- results] of
225 e : _ -> throwIO e
226 [] -> pure ()
227
228 -- |brackets to restore settings once action has completed or raised an exception
229 keepingSettings :: IO b -> IO b
230 keepingSettings = bracket qlSavedSettings qlFreeSavedSettings . const
231 -- SavedSettings destructor suppresses all exceptions
232
233 -- |brackets to restore settings once action has completed or raised an exception. Before restoring settings
234 -- 'collectGarbage' is run to avoid problems with market data objects watching evaluation date
235 keepingSettingsGc :: IO b -> IO b
236 keepingSettingsGc = bracket qlSavedSettings (\s -> collectGarbage >> qlFreeSavedSettings s) . const
237
238 -- |Best effort: give the finalizers of unreachable QuantLib objects a chance to run, so
239 -- their C++ destructors fire before, say, 'setEvaluationDate' notifies surviving observers.
240 --
241 -- 'performGC' only /schedules/ finalizers, it does not run them synchronously, so this is a
242 -- nudge rather than a guarantee. Where correctness depends on an object being gone, anchor
243 -- its dates so staleness cannot arise in the first place.
244 collectGarbage :: IO ()
245 collectGarbage = performGC >> performGC
246
247 foreign import ccall safe "ql.h qlVersion" qlVersion :: IO CString
248 foreign import ccall safe "ql.h qlBoostVersion" qlBoostVersion :: IO CString
249 foreign import ccall safe "ql.h qlEpsilon" qlEpsilon :: CDouble
250
251 {-# NOINLINE version #-}
252 version :: String
253 version = unsafePerformIO $ qlVersion >>= peekCString
254
255 {-# NOINLINE boostVersion #-}
256 boostVersion :: String
257 boostVersion = unsafePerformIO $ qlBoostVersion >>= peekCString
258
259 epsilon :: Double
260 epsilon = realToFrac qlEpsilon
261
262 -- vim: set ff=unix ts=8 sts=2 sw=2 et:
263
264 foreign import ccall safe "QuantLib/Context.chs.h qlSetExtendedPrecision"
265 setExtendedPrecision'_ :: (IO ())
266
267 foreign import ccall safe "QuantLib/Context.chs.h qlSettingsEvaluationDate"
268 evaluationDate'_ :: (IO C2HSImp.CInt)
269
270 foreign import ccall safe "QuantLib/Context.chs.h qlSettingsSetEvaluationDate"
271 setEvaluationDate'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO ())))
272
273 foreign import ccall safe "QuantLib/Context.chs.h qlSettingsEnforceTodaysHistoricFixings"
274 enforceTodaysHistoricFixings'_ :: (IO C2HSImp.CInt)
275
276 foreign import ccall safe "QuantLib/Context.chs.h qlSettingsSetEnforceTodaysHistoricFixings"
277 setEnforceTodaysHistoricFixings'_ :: (C2HSImp.CInt -> (IO ()))
278
279 foreign import ccall safe "QuantLib/Context.chs.h qlSettingsIncludeTodaysCashFlows"
280 includeTodaysCashFlows'_ :: (IO C2HSImp.CInt)
281
282 foreign import ccall safe "QuantLib/Context.chs.h qlSettingsSetIncludeTodaysCashFlows"
283 setIncludeTodaysCashFlows'_ :: (C2HSImp.CInt -> (IO ()))
284
285 foreign import ccall safe "QuantLib/Context.chs.h qlSettingsIncludeReferenceDateEvents"
286 includeReferenceDateEvents'_ :: (IO C2HSImp.CInt)
287
288 foreign import ccall safe "QuantLib/Context.chs.h qlSettingsSetIncludeReferenceDateEvents"
289 setIncludeReferenceDateEvents'_ :: (C2HSImp.CInt -> (IO ()))
290
291 foreign import ccall safe "QuantLib/Context.chs.h qlObservableSettingsDisableUpdates"
292 disableUpdates'_ :: (C2HSImp.CInt -> (IO ()))
293
294 foreign import ccall safe "QuantLib/Context.chs.h qlObservableSettingsEnableUpdates"
295 enableUpdates'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO ()))
296
297 foreign import ccall safe "QuantLib/Context.chs.h qlObservableSettingsUpdatesEnabled"
298 updatesEnabled'_ :: (IO C2HSImp.CInt)
299
300 foreign import ccall safe "QuantLib/Context.chs.h qlObservableSettingsUpdatesDeferred"
301 updatesDeferred'_ :: (IO C2HSImp.CInt)
302
303 foreign import ccall safe "QuantLib/Context.chs.h qlSettingsRawEvaluationDate"
304 rawEvaluationDate'_ :: (IO C2HSImp.CInt)