module QuantLib.Internal
  (
    Error(..)

  , Day -- reexport for simplicity
  , minDate
  , maxDate

  -- marshalling helpers
  , prePtr
  , preErrorCheck
  , errorCheck

  , fromMaybeBool
  , toMaybeBool
  , peekDynString
  , peekEnum
  , peekDouble
  , preEnum
  , preNum
  , preArray
  , withEnumArray
  , withIntArray
  , withBoolArray
  , withDoubleArray
  , withRealVector
  , withRealVectorRaw
  , withNonEmptyDoubleArray
  , withDoubleArrayRaw
  , withBoolArrayRaw
  , withDayPtr
  , withStringArray
  , peekCStringArray
  , fromEnumQuantity
  , toEnumQuantity
  , fromEnumDouble
  , toEnumDouble
  , fromEnumC
  , toEnumC

  , withDay
  , toDay
  , withMaybeDay
  , fromMaybeInt
  , toMaybeDay
  , peekDayArray
  , peekBoolArray
  , withDayArray
  , peekDoubleArray
  , peekRealVector
  , borrowRealVector
  , RealVector
  , NonEmptyVector
  , singletonNonEmptyVector
  , consNonEmptyVector
  , nonEmptyVector
  , nonEmptyVectorToVector
  , withNonEmptyRealVector

  , toSerial
  , fromSerial
  , qlSavedSettings
  , qlFreeSavedSettings
  , fromMaybeDouble
  , fromMaybeEnum
  , fromMaybeEnumQuantity
  , peekIntArray
  , peekIntArray'
  , peekUIntArray
  , peekWord
  , peekStructArray
  , peekPtrArray
  , Matrix(..)
  , RealMatrix(..)
  , boxedRealMatrix
  , realMatrixFromVector
  , objectMatrix
  , qlNullInteger
  , qlFreeAdditionalResults

  , uncurryNested
  , zipWith6
  )
where

import Foreign.C.Types(CUInt(..), CInt(..), CDouble(..))
import Foreign.C.String(CString, peekCString, withCString)
import Foreign.Ptr(Ptr, nullPtr, castPtr)
import Foreign.ForeignPtr(FinalizerPtr, newForeignPtr, newForeignPtr_, castForeignPtr)
import Foreign.Marshal.Array(peekArray, withArray)
import Foreign.Marshal.Utils(with, toBool, fromBool, withMany)
import Foreign.Storable(peek, Storable)
import Foreign.Marshal.Alloc(alloca)

import Control.Exception(Exception, throwIO)
import Control.Monad(when)
import Data.Time.Calendar(Day(ModifiedJulianDay), toModifiedJulianDay, fromGregorian)
import Data.List.NonEmpty(NonEmpty, toList)

import Data.Vector.Storable(Vector, unsafeFromForeignPtr0)
import qualified Data.Vector.Storable as V

data Error = CPlusPlusException String
           | DateConversion Day
           | EnumConversion String
           deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq)

instance Exception Error

errorCheck :: Ptr CString -> IO ()
errorCheck :: Ptr CString -> IO ()
errorCheck Ptr CString
p = do
  a <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
p
  when
    (a /= nullPtr)
    ((peekCString a <* qlFreeString a) >>= throwIO . CPlusPlusException)

-- like alloca but initializes the allocated pointer with zero
preErrorCheck :: (Ptr (Ptr a) -> IO b) -> IO b
preErrorCheck :: forall a b. (Ptr (Ptr a) -> IO b) -> IO b
preErrorCheck = Ptr a -> (Ptr (Ptr a) -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ptr a
forall a. Ptr a
nullPtr

fromMaybeBool :: Maybe Bool -> CInt
fromMaybeBool :: Maybe Bool -> CInt
fromMaybeBool = CInt -> (Bool -> CInt) -> Maybe Bool -> CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-CInt
1) Bool -> CInt
forall a. Num a => Bool -> a
fromBool

foreign import ccall safe "ql.h qlNullInteger" qlNullInteger :: CInt
foreign import ccall safe "ql.h qlNullReal" qlNullReal :: CDouble

fromMaybeInt :: (Integral a, Integral b) => Maybe a -> b
fromMaybeInt :: forall a b. (Integral a, Integral b) => Maybe a -> b
fromMaybeInt = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
qlNullInteger) a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral

fromMaybeDouble :: Maybe Double -> CDouble
fromMaybeDouble :: Maybe Double -> CDouble
fromMaybeDouble = CDouble -> (Double -> CDouble) -> Maybe Double -> CDouble
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CDouble
qlNullReal Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- |Marshals a Maybe of a plain by-value C++ enum whose lowest member maps to 0
-- (true of every by-value enum bound so far) as a C int, using -1 as the
-- ext::nullopt sentinel -- mirrors fromMaybeBool's convention.
fromMaybeEnum :: Enum a => Maybe a -> CInt
fromMaybeEnum :: forall a. Enum a => Maybe a -> CInt
fromMaybeEnum = CInt -> (a -> CInt) -> Maybe a -> CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-CInt
1) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (a -> Int) -> a -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum)

-- |'Nothing' emits the enum's -1 sentinel (same convention as 'fromMaybeEnum'), paired with a
-- placeholder quantity of 0 -- for enums like 'TimeUnit' that start at 0 and can't self-sentinel.
fromMaybeEnumQuantity :: Enum a => Maybe (Word, a) -> (CInt, CInt)
fromMaybeEnumQuantity :: forall a. Enum a => Maybe (Word, a) -> (CInt, CInt)
fromMaybeEnumQuantity = (CInt, CInt)
-> ((Word, a) -> (CInt, CInt)) -> Maybe (Word, a) -> (CInt, CInt)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CInt
0, -CInt
1) (Word, a) -> (CInt, CInt)
forall a b c.
(Enum a, Integral b, Integral c) =>
(b, a) -> (CInt, c)
fromEnumQuantity

toMaybeBool :: CInt -> Maybe Bool
toMaybeBool :: CInt -> Maybe Bool
toMaybeBool CInt
x = if CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
1 then Maybe Bool
forall a. Maybe a
Nothing else Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool CInt
x

peekDynString :: CString -> IO String
peekDynString :: CString -> IO String
peekDynString CString
x = CString -> IO String
peekCString CString
x IO String -> IO () -> IO String
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
qlFreeString CString
x

peekEnum :: (Enum a) => Ptr CInt -> IO a
peekEnum :: forall a. Enum a => Ptr CInt -> IO a
peekEnum Ptr CInt
x = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (CInt -> Int) -> CInt -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> IO CInt -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
x

peekDouble :: Ptr CDouble -> IO Double
peekDouble :: Ptr CDouble -> IO Double
peekDouble Ptr CDouble
x = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> IO CDouble -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
x

peekWord :: Ptr CUInt -> IO Word
peekWord :: Ptr CUInt -> IO Word
peekWord Ptr CUInt
x = CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Word) -> IO CUInt -> IO Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
x

-- initialize pointer to a enum with a valid value before passing it to the function
preEnum :: (Storable a, Bounded a) => (Ptr a -> IO b) -> IO b
preEnum :: forall a b. (Storable a, Bounded a) => (Ptr a -> IO b) -> IO b
preEnum = a -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
forall a. Bounded a => a
minBound

preNum :: (Storable a, Num a) => (Ptr a -> IO b) -> IO b
preNum :: forall a b. (Storable a, Num a) => (Ptr a -> IO b) -> IO b
preNum = a -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
0

foreign import ccall safe "ql.h qlFreeString" qlFreeString :: CString -> IO ()
foreign import ccall safe "ql.h qlFreeInts" qlFreeInts :: Ptr CInt -> IO ()
foreign import ccall safe "ql.h qlFreeUInts" qlFreeUInts :: Ptr CUInt -> IO ()
foreign import ccall safe "ql.h qlFreeDoubles" qlFreeDoubles :: Ptr CDouble -> IO ()
foreign import ccall safe "ql.h &qlFreeDoubles" qlFreeDoublesFin :: FinalizerPtr CDouble
foreign import ccall safe "ql.h qlFreePointerArray" qlFreePointerArray :: Ptr (Ptr ()) -> IO ()
foreign import ccall safe "ql.h qlFreeAdditionalResults" qlFreeAdditionalResults :: CUInt -> Ptr () -> IO ()
foreign import ccall safe "ql.h qlFreeStringArray" qlFreeStringArray :: CUInt -> Ptr CString -> IO ()
foreign import ccall safe "ql.h qlSavedSettings" qlSavedSettings :: IO (Ptr ())
foreign import ccall safe "ql.h qlFreeSavedSettings" qlFreeSavedSettings :: Ptr () -> IO ()

withLArray :: (Storable b) => (a -> b) -> [a] -> ((CUInt, Ptr b) -> IO c) -> IO c
withLArray :: forall b a c.
Storable b =>
(a -> b) -> [a] -> ((CUInt, Ptr b) -> IO c) -> IO c
withLArray a -> b
c [a]
x (CUInt, Ptr b) -> IO c
f = [b] -> (Ptr b -> IO c) -> IO c
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
c [a]
x) (\Ptr b
px -> (CUInt, Ptr b) -> IO c
f (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x, Ptr b
px))

withEnumArray :: (Enum a) => [a] -> ((CUInt, Ptr CInt) -> IO b) -> IO b
withEnumArray :: forall a b. Enum a => [a] -> ((CUInt, Ptr CInt) -> IO b) -> IO b
withEnumArray = (a -> CInt) -> [a] -> ((CUInt, Ptr CInt) -> IO b) -> IO b
forall b a c.
Storable b =>
(a -> b) -> [a] -> ((CUInt, Ptr b) -> IO c) -> IO c
withLArray (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (a -> Int) -> a -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum)

withIntArray :: (Integral a, Num n, Storable n) => [a] -> ((CUInt, Ptr n) -> IO b) -> IO b
withIntArray :: forall a n b.
(Integral a, Num n, Storable n) =>
[a] -> ((CUInt, Ptr n) -> IO b) -> IO b
withIntArray = (a -> n) -> [a] -> ((CUInt, Ptr n) -> IO b) -> IO b
forall b a c.
Storable b =>
(a -> b) -> [a] -> ((CUInt, Ptr b) -> IO c) -> IO c
withLArray a -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral

withBoolArray :: [Bool] -> ((CUInt, Ptr CInt) -> IO b) -> IO b
withBoolArray :: forall b. [Bool] -> ((CUInt, Ptr CInt) -> IO b) -> IO b
withBoolArray = (Bool -> CInt) -> [Bool] -> ((CUInt, Ptr CInt) -> IO b) -> IO b
forall b a c.
Storable b =>
(a -> b) -> [a] -> ((CUInt, Ptr b) -> IO c) -> IO c
withLArray Bool -> CInt
forall a. Num a => Bool -> a
fromBool

withDoubleArray :: [Double] -> ((CUInt, Ptr CDouble) -> IO b) -> IO b
withDoubleArray :: forall b. [Double] -> ((CUInt, Ptr CDouble) -> IO b) -> IO b
withDoubleArray = (Double -> CDouble)
-> [Double] -> ((CUInt, Ptr CDouble) -> IO b) -> IO b
forall b a c.
Storable b =>
(a -> b) -> [a] -> ((CUInt, Ptr b) -> IO c) -> IO c
withLArray Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- |Contiguous numeric data for APIs whose natural size is hundreds or thousands
-- of values.  The public element type stays 'Double'; C's @double@ representation
-- is used only at the FFI boundary.
type RealVector = Vector Double

-- |A storable vector known not to be empty.  The constructor is deliberately
-- hidden; build one with 'singletonNonEmptyVector', 'consNonEmptyVector', or
-- 'nonEmptyVector'.
newtype NonEmptyVector a = NonEmptyVector (Vector a)

singletonNonEmptyVector :: Storable a => a -> NonEmptyVector a
singletonNonEmptyVector :: forall a. Storable a => a -> NonEmptyVector a
singletonNonEmptyVector = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (a -> Vector a) -> a -> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vector a
forall a. Storable a => a -> Vector a
V.singleton

consNonEmptyVector :: Storable a => a -> Vector a -> NonEmptyVector a
consNonEmptyVector :: forall a. Storable a => a -> Vector a -> NonEmptyVector a
consNonEmptyVector a
x = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (Vector a -> Vector a) -> Vector a -> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vector a -> Vector a
forall a. Storable a => a -> Vector a -> Vector a
V.cons a
x

nonEmptyVector :: Storable a => Vector a -> Maybe (NonEmptyVector a)
nonEmptyVector :: forall a. Storable a => Vector a -> Maybe (NonEmptyVector a)
nonEmptyVector Vector a
x
  | Vector a -> Bool
forall a. Storable a => Vector a -> Bool
V.null Vector a
x = Maybe (NonEmptyVector a)
forall a. Maybe a
Nothing
  | Bool
otherwise = NonEmptyVector a -> Maybe (NonEmptyVector a)
forall a. a -> Maybe a
Just (Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector a
x)

nonEmptyVectorToVector :: NonEmptyVector a -> Vector a
nonEmptyVectorToVector :: forall a. NonEmptyVector a -> Vector a
nonEmptyVectorToVector (NonEmptyVector Vector a
x) = Vector a
x

withNonEmptyRealVector :: NonEmptyVector Double -> ((CUInt, Ptr CDouble) -> IO b) -> IO b
withNonEmptyRealVector :: forall b.
NonEmptyVector Double -> ((CUInt, Ptr CDouble) -> IO b) -> IO b
withNonEmptyRealVector (NonEmptyVector Vector Double
x) = Vector Double -> ((CUInt, Ptr CDouble) -> IO b) -> IO b
forall b. Vector Double -> ((CUInt, Ptr CDouble) -> IO b) -> IO b
withRealVector Vector Double
x

-- |Borrows the vector's storage for one FFI call.  QuantLib copies every
-- input vector it receives, so the vector need not outlive the continuation.
withRealVector :: RealVector -> ((CUInt, Ptr CDouble) -> IO b) -> IO b
withRealVector :: forall b. Vector Double -> ((CUInt, Ptr CDouble) -> IO b) -> IO b
withRealVector Vector Double
x (CUInt, Ptr CDouble) -> IO b
f = Vector Double -> (Ptr Double -> IO b) -> IO b
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
V.unsafeWith Vector Double
x ((Ptr Double -> IO b) -> IO b) -> (Ptr Double -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr Double
p -> (CUInt, Ptr CDouble) -> IO b
f (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Double -> Int
forall a. Storable a => Vector a -> Int
V.length Vector Double
x), Ptr Double -> Ptr CDouble
forall a b. Ptr a -> Ptr b
castPtr Ptr Double
p)

-- |Like 'withRealVector', for an FFI argument whose length is carried separately.
withRealVectorRaw :: RealVector -> (Ptr CDouble -> IO b) -> IO b
withRealVectorRaw :: forall b. Vector Double -> (Ptr CDouble -> IO b) -> IO b
withRealVectorRaw Vector Double
x Ptr CDouble -> IO b
f = Vector Double -> (Ptr Double -> IO b) -> IO b
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
V.unsafeWith Vector Double
x ((Ptr Double -> IO b) -> IO b) -> (Ptr Double -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ Ptr CDouble -> IO b
f (Ptr CDouble -> IO b)
-> (Ptr Double -> Ptr CDouble) -> Ptr Double -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Double -> Ptr CDouble
forall a b. Ptr a -> Ptr b
castPtr

withNonEmptyDoubleArray :: NonEmpty Double -> ((CUInt, Ptr CDouble) -> IO b) -> IO b
withNonEmptyDoubleArray :: forall b. NonEmpty Double -> ((CUInt, Ptr CDouble) -> IO b) -> IO b
withNonEmptyDoubleArray NonEmpty Double
x = (Double -> CDouble)
-> [Double] -> ((CUInt, Ptr CDouble) -> IO b) -> IO b
forall b a c.
Storable b =>
(a -> b) -> [a] -> ((CUInt, Ptr b) -> IO c) -> IO c
withLArray Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NonEmpty Double -> [Double]
forall a. NonEmpty a -> [a]
toList NonEmpty Double
x)

withDoubleArrayRaw :: [Double] -> (Ptr CDouble -> IO b) -> IO b
withDoubleArrayRaw :: forall b. [Double] -> (Ptr CDouble -> IO b) -> IO b
withDoubleArrayRaw [Double]
x = [CDouble] -> (Ptr CDouble -> IO b) -> IO b
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ((Double -> CDouble) -> [Double] -> [CDouble]
forall a b. (a -> b) -> [a] -> [b]
map Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac [Double]
x)

withBoolArrayRaw :: [Bool] -> (Ptr CInt -> IO b) -> IO b
withBoolArrayRaw :: forall b. [Bool] -> (Ptr CInt -> IO b) -> IO b
withBoolArrayRaw [Bool]
x = [CInt] -> (Ptr CInt -> IO b) -> IO b
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ((Bool -> CInt) -> [Bool] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map Bool -> CInt
forall a. Num a => Bool -> a
fromBool [Bool]
x)

withDayArray :: [Day] -> ((CUInt, Ptr CInt) -> IO b) -> IO b
withDayArray :: forall b. [Day] -> ((CUInt, Ptr CInt) -> IO b) -> IO b
withDayArray [Day]
x (CUInt, Ptr CInt) -> IO b
f = (Day -> IO CInt) -> [Day] -> IO [CInt]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Day -> IO CInt
toSerial [Day]
x IO [CInt] -> ([CInt] -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([CInt] -> (Ptr CInt -> IO b) -> IO b
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
`withArray` (\Ptr CInt
px -> (CUInt, Ptr CInt) -> IO b
f (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ [Day] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Day]
x, Ptr CInt
px)))

withDayPtr :: [Day] -> (Ptr CInt -> IO a) -> IO a
withDayPtr :: forall a. [Day] -> (Ptr CInt -> IO a) -> IO a
withDayPtr [Day]
x Ptr CInt -> IO a
f = (Day -> IO CInt) -> [Day] -> IO [CInt]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Day -> IO CInt
toSerial [Day]
x IO [CInt] -> ([CInt] -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([CInt] -> (Ptr CInt -> IO a) -> IO a
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
`withArray` Ptr CInt -> IO a
f)

-- |An array of plain C strings, for a function taking a @std::vector<std::string>@-shaped
-- argument as a flat @(count, char**)@ pair (the input-side counterpart of 'peekCStringArray'
-- below) -- first needed for @SecondaryCosts@' string keys (@QuantLib.Instrument.Energy@).
withStringArray :: [String] -> ((CUInt, Ptr CString) -> IO b) -> IO b
withStringArray :: forall b. [String] -> ((CUInt, Ptr CString) -> IO b) -> IO b
withStringArray [String]
xs (CUInt, Ptr CString) -> IO b
f = (String -> (CString -> IO b) -> IO b)
-> [String] -> ([CString] -> IO b) -> IO b
forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withMany String -> (CString -> IO b) -> IO b
forall a. String -> (CString -> IO a) -> IO a
withCString [String]
xs (\[CString]
ps -> [CString] -> (Ptr CString -> IO b) -> IO b
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CString]
ps (\Ptr CString
p -> (CUInt, Ptr CString) -> IO b
f (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs), Ptr CString
p)))

prePtr :: (Storable a) => (Ptr a -> IO b) -> IO b
prePtr :: forall a b. Storable a => (Ptr a -> IO b) -> IO b
prePtr = (Ptr a -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca

preArray :: ((Ptr CUInt, Ptr (Ptr a)) -> IO b) -> IO b
preArray :: forall a b. ((Ptr CUInt, Ptr (Ptr a)) -> IO b) -> IO b
preArray (Ptr CUInt, Ptr (Ptr a)) -> IO b
f = CUInt -> (Ptr CUInt -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CUInt
0 ((Ptr CUInt -> IO b) -> IO b) -> (Ptr CUInt -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$
  \Ptr CUInt
x -> Ptr a -> (Ptr (Ptr a) -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ptr a
forall a. Ptr a
nullPtr ((Ptr (Ptr a) -> IO b) -> IO b) -> (Ptr (Ptr a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$
    \Ptr (Ptr a)
y -> (Ptr CUInt, Ptr (Ptr a)) -> IO b
f (Ptr CUInt
x, Ptr (Ptr a)
y)

peekIntArray' :: (CInt -> b) -> Ptr CUInt -> Ptr (Ptr CInt) -> IO [b]
peekIntArray' :: forall b. (CInt -> b) -> Ptr CUInt -> Ptr (Ptr CInt) -> IO [b]
peekIntArray' CInt -> b
f Ptr CUInt
pl Ptr (Ptr CInt)
pp = do
  l <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
pl
  p <- peek pp
  map f <$> peekArray (fromIntegral l) p <* qlFreeInts p

peekUIntArray :: Ptr CUInt -> Ptr (Ptr CUInt) -> IO [Word]
peekUIntArray :: Ptr CUInt -> Ptr (Ptr CUInt) -> IO [Word]
peekUIntArray Ptr CUInt
pl Ptr (Ptr CUInt)
pp = do
  l <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
pl
  p <- peek pp
  map fromIntegral <$> peekArray (fromIntegral l) p <* qlFreeUInts p

peekIntArray :: Ptr CUInt -> Ptr (Ptr CInt) -> IO [Int]
peekIntArray :: Ptr CUInt -> Ptr (Ptr CInt) -> IO [Int]
peekIntArray = (CInt -> Int) -> Ptr CUInt -> Ptr (Ptr CInt) -> IO [Int]
forall b. (CInt -> b) -> Ptr CUInt -> Ptr (Ptr CInt) -> IO [b]
peekIntArray' CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- |An array of freshly heap-allocated (@DUP@'d) C strings -- the output-side counterpart of
-- 'withStringArray'. Each element is read via 'peekCString' and the whole array (including every
-- individual string) is then released via 'qlFreeStringArray' in one call, mirroring
-- 'peekDoubleArray'\/'peekIntArray'\''s read-then-free shape.
peekCStringArray :: Ptr CUInt -> Ptr (Ptr CString) -> IO [String]
peekCStringArray :: Ptr CUInt -> Ptr (Ptr CString) -> IO [String]
peekCStringArray Ptr CUInt
pl Ptr (Ptr CString)
pp = do
  l <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
pl
  p <- peek pp
  raws <- peekArray (fromIntegral l) p
  strs <- mapM peekCString raws
  strs <$ qlFreeStringArray l p

peekBoolArray :: Ptr CUInt -> Ptr (Ptr CInt) -> IO [Bool]
peekBoolArray :: Ptr CUInt -> Ptr (Ptr CInt) -> IO [Bool]
peekBoolArray = (CInt -> Bool) -> Ptr CUInt -> Ptr (Ptr CInt) -> IO [Bool]
forall b. (CInt -> b) -> Ptr CUInt -> Ptr (Ptr CInt) -> IO [b]
peekIntArray' CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool

peekDayArray :: Ptr CUInt -> Ptr (Ptr CInt) -> IO [Day]
peekDayArray :: Ptr CUInt -> Ptr (Ptr CInt) -> IO [Day]
peekDayArray = (CInt -> Day) -> Ptr CUInt -> Ptr (Ptr CInt) -> IO [Day]
forall b. (CInt -> b) -> Ptr CUInt -> Ptr (Ptr CInt) -> IO [b]
peekIntArray' CInt -> Day
fromSerial

peekDoubleArray :: Ptr CUInt -> Ptr (Ptr CDouble) -> IO [Double]
peekDoubleArray :: Ptr CUInt -> Ptr (Ptr CDouble) -> IO [Double]
peekDoubleArray Ptr CUInt
pl Ptr (Ptr CDouble)
pp = do
  l <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
pl
  p <- peek pp
  map realToFrac <$> peekArray (fromIntegral l) p <* qlFreeDoubles p

-- |Takes ownership of a C++-allocated @double[]@ result without copying it.
-- The vector's finalizer is the same @qlFreeDoubles@ path used by
-- 'peekDoubleArray'.
peekRealVector :: Ptr CUInt -> Ptr (Ptr CDouble) -> IO RealVector
peekRealVector :: Ptr CUInt -> Ptr (Ptr CDouble) -> IO (Vector Double)
peekRealVector Ptr CUInt
pl Ptr (Ptr CDouble)
pp = do
  n <- CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> IO CUInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
pl
  p <- peek pp
  fp <- castForeignPtr <$> newForeignPtr qlFreeDoublesFin p
  pure (unsafeFromForeignPtr0 fp n)

-- |A non-owning vector view valid only for the continuation that receives the
-- C++ callback buffer.  It deliberately has no finalizer.
borrowRealVector :: Ptr CDouble -> CUInt -> IO RealVector
borrowRealVector :: Ptr CDouble -> CUInt -> IO (Vector Double)
borrowRealVector Ptr CDouble
p CUInt
n = do
  fp <- ForeignPtr CDouble -> ForeignPtr Double
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr CDouble -> ForeignPtr Double)
-> IO (ForeignPtr CDouble) -> IO (ForeignPtr Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDouble -> IO (ForeignPtr CDouble)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr CDouble
p
  pure (unsafeFromForeignPtr0 fp (fromIntegral n))

-- |Like 'peekIntArray'\''/'peekDoubleArray', but for an array of a C struct rather than a C
-- primitive: reads the length and pointer out-params, walks the array via 'peekArray' (so the
-- element type just needs a 'Storable' instance -- e.g. one built from c2hs @{#get#}@/@{#sizeof#}@
-- hooks), converts every element via @convert@, /then/ hands the whole array to @freeFn@ to
-- release. The conversion must run before the free -- unlike 'peekIntArray'\''/'peekDoubleArray',
-- whose elements are self-contained primitives, a struct element read here may itself own
-- further heap buffers (e.g. a @char*@/@double*@ field) that @convert@ still needs to dereference
-- (via 'peekCString'/'peekArray' etc.); freeing first would leave it reading already-freed
-- memory. @freeFn@ takes the element count because some frees need it (e.g.
-- 'qlFreeAdditionalResults'); one that doesn't can ignore it.
peekStructArray :: Storable a => (a -> IO b) -> (CUInt -> Ptr a -> IO ()) -> Ptr CUInt -> Ptr (Ptr a) -> IO [b]
peekStructArray :: forall a b.
Storable a =>
(a -> IO b)
-> (CUInt -> Ptr a -> IO ()) -> Ptr CUInt -> Ptr (Ptr a) -> IO [b]
peekStructArray a -> IO b
convert CUInt -> Ptr a -> IO ()
freeFn Ptr CUInt
pl Ptr (Ptr a)
pp = do
  l <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
pl
  p <- peek pp
  raws <- peekArray (fromIntegral l) p
  results <- mapM convert raws
  results <$ freeFn l p

-- |Like 'peekStructArray' but for a @T**@ array of C++-owned pointers to live objects: peeks the
-- length/pointer out-params, converts each raw pointer to a live Haskell value via @peekOne@
-- (installing that value's own finalizer over the pointee), then frees only the array spine via
-- 'qlFreePointerArray' -- not the pointees, whose lifetime @peekOne@ has now taken over.
peekPtrArray :: (Ptr a -> IO b) -> Ptr CUInt -> Ptr (Ptr (Ptr a)) -> IO [b]
peekPtrArray :: forall a b.
(Ptr a -> IO b) -> Ptr CUInt -> Ptr (Ptr (Ptr a)) -> IO [b]
peekPtrArray Ptr a -> IO b
peekOne Ptr CUInt
pl Ptr (Ptr (Ptr a))
pp = do
  l <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
pl
  p <- peek pp
  ptrs <- peekArray (fromIntegral l) p
  xs <- mapM peekOne ptrs
  xs <$ qlFreePointerArray (castPtr p)

fromEnumQuantity :: (Enum a, Integral b, Integral c) => (b, a) -> (CInt, c)
fromEnumQuantity :: forall a b c.
(Enum a, Integral b, Integral c) =>
(b, a) -> (CInt, c)
fromEnumQuantity (b
x, a
u) = (b -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
x, Int -> c
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> c) -> Int -> c
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Enum a => a -> Int
fromEnum a
u)

toEnumQuantity :: (Enum a, Integral b, Integral c) => (CInt, c) -> (b, a)
toEnumQuantity :: forall a b c.
(Enum a, Integral b, Integral c) =>
(CInt, c) -> (b, a)
toEnumQuantity (CInt
x, c
u) = (CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x, Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ c -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral c
u)

fromEnumDouble :: (Enum a, Integral c) => (Double, a) -> (CDouble, c)
fromEnumDouble :: forall a c. (Enum a, Integral c) => (Double, a) -> (CDouble, c)
fromEnumDouble (Double
x, a
u) = (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x, Int -> c
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> c) -> Int -> c
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Enum a => a -> Int
fromEnum a
u)

toEnumDouble :: (Enum a, Integral c) => (CDouble, c) -> (Double, a)
toEnumDouble :: forall a c. (Enum a, Integral c) => (CDouble, c) -> (Double, a)
toEnumDouble (CDouble
x, c
u) = (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x, Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ c -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral c
u)

foreign import ccall safe "ql.h qlMinYear" qlMinYear :: CInt
foreign import ccall safe "ql.h qlMinMonth" qlMinMonth :: CInt
foreign import ccall safe "ql.h qlMinDay" qlMinDay :: CInt
foreign import ccall safe "ql.h qlMinDateSerialNumber" qlMinDateSerialNumber :: CInt
foreign import ccall safe "ql.h qlMaxDateSerialNumber" qlMaxDateSerialNumber :: CInt

-- |Julian day of the QuantLib zero date
qlStart :: CInt
qlStart :: CInt
qlStart = CInt
minDateJulianDays CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
qlMinDateSerialNumber
  where minDateJulianDays :: CInt
minDateJulianDays = Day -> CInt
toModifiedJulianDay' (Day -> CInt) -> Day -> CInt
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian (CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
qlMinYear) (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
qlMinMonth) (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
qlMinDay)

toModifiedJulianDay' :: Day -> CInt
toModifiedJulianDay' :: Day -> CInt
toModifiedJulianDay' = Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> CInt) -> (Day -> Integer) -> Day -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Integer
toModifiedJulianDay

fromSerial :: CInt -> Day
fromSerial :: CInt -> Day
fromSerial CInt
x = Integer -> Day
ModifiedJulianDay (Integer -> Day) -> Integer -> Day
forall a b. (a -> b) -> a -> b
$ CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt
x CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
qlStart)

dayIsValid :: Day -> Bool
dayIsValid :: Day -> Bool
dayIsValid Day
x = CInt
s CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
>= CInt
qlMinDateSerialNumber Bool -> Bool -> Bool
&& CInt
s CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
qlMaxDateSerialNumber
  where s :: CInt
s = Day -> CInt
toModifiedJulianDay' Day
x CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
qlStart

toSerial :: Day -> IO CInt
toSerial :: Day -> IO CInt
toSerial Day
x | Day -> Bool
dayIsValid Day
x = CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> IO CInt) -> CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ Day -> CInt
toModifiedJulianDay' Day
x CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
qlStart
           | Bool
otherwise = Error -> IO CInt
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (Error -> IO CInt) -> Error -> IO CInt
forall a b. (a -> b) -> a -> b
$ Day -> Error
DateConversion Day
x

withDay :: Day -> (CInt -> IO a) -> IO a
withDay :: forall a. Day -> (CInt -> IO a) -> IO a
withDay Day
x CInt -> IO a
f = Day -> IO CInt
toSerial Day
x IO CInt -> (CInt -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO a
f

toDay :: CInt -> Day
toDay :: CInt -> Day
toDay = CInt -> Day
fromSerial

withMaybeDay :: Maybe Day -> (CInt -> IO a) -> IO a
withMaybeDay :: forall a. Maybe Day -> (CInt -> IO a) -> IO a
withMaybeDay Maybe Day
x CInt -> IO a
f = IO a -> (Day -> IO a) -> Maybe Day -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CInt -> IO a
f CInt
0) (Day -> (CInt -> IO a) -> IO a
forall a. Day -> (CInt -> IO a) -> IO a
`withDay` CInt -> IO a
f) Maybe Day
x

-- |Unlike the -1 sentinel used by 'fromMaybeBool'/'fromMaybeEnum'/'toMaybeBool', the
-- absent-date sentinel is 0: QuantLib serial 0 is not a representable date (serials
-- start at 'qlMinDateSerialNumber'), so it is free to mean "no date". This matches
-- 'withMaybeDay', which passes 0 in the other direction.
toMaybeDay :: CInt -> Maybe Day
toMaybeDay :: CInt -> Maybe Day
toMaybeDay CInt
0 = Maybe Day
forall a. Maybe a
Nothing
toMaybeDay CInt
x = Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ CInt -> Day
fromSerial CInt
x

-- |earliest allowed date in QuantLib
minDate :: Day
minDate :: Day
minDate = CInt -> Day
fromSerial CInt
qlMinDateSerialNumber

-- |latest date allowed in QuantLib
maxDate :: Day
maxDate :: Day
maxDate = CInt -> Day
fromSerial CInt
qlMaxDateSerialNumber

data Matrix a = Matrix {forall a. Matrix a -> Word
matrixRows::Word, forall a. Matrix a -> Word
matrixColumns::Word, forall a. Matrix a -> [a]
matrixData::[a]}
  deriving (Matrix a -> Matrix a -> Bool
(Matrix a -> Matrix a -> Bool)
-> (Matrix a -> Matrix a -> Bool) -> Eq (Matrix a)
forall a. Eq a => Matrix a -> Matrix a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Matrix a -> Matrix a -> Bool
== :: Matrix a -> Matrix a -> Bool
$c/= :: forall a. Eq a => Matrix a -> Matrix a -> Bool
/= :: Matrix a -> Matrix a -> Bool
Eq, Int -> Matrix a -> ShowS
[Matrix a] -> ShowS
Matrix a -> String
(Int -> Matrix a -> ShowS)
-> (Matrix a -> String) -> ([Matrix a] -> ShowS) -> Show (Matrix a)
forall a. Show a => Int -> Matrix a -> ShowS
forall a. Show a => [Matrix a] -> ShowS
forall a. Show a => Matrix a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Matrix a -> ShowS
showsPrec :: Int -> Matrix a -> ShowS
$cshow :: forall a. Show a => Matrix a -> String
show :: Matrix a -> String
$cshowList :: forall a. Show a => [Matrix a] -> ShowS
showList :: [Matrix a] -> ShowS
Show)

-- |Row-major numeric matrix backed by contiguous storage.  Use this for
-- large dense grids such as regression and volatility-surface data; small
-- process/correlation matrices remain boxed 'Matrix' values; object
-- matrices retain 'Matrix' because their elements need continuation-based FFI
-- marshalling rather than a raw contiguous pointer.
--
-- This representation interoperates directly with @hmatrix@ without making
-- @hasquant@ depend on it: @Numeric.LinearAlgebra.reshape cols
-- realMatrixData@ makes a row-major hmatrix matrix view with no element copy.
-- The reverse conversion through @flatten@ is zero-copy only for a contiguous
-- row-major hmatrix matrix; BLAS-produced or sliced matrices can require a
-- reorder/copy.
data RealMatrix = RealMatrix
  { RealMatrix -> Word
realMatrixRows :: Word
  , RealMatrix -> Word
realMatrixColumns :: Word
  , RealMatrix -> Vector Double
realMatrixData :: RealVector
  }
  deriving (RealMatrix -> RealMatrix -> Bool
(RealMatrix -> RealMatrix -> Bool)
-> (RealMatrix -> RealMatrix -> Bool) -> Eq RealMatrix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RealMatrix -> RealMatrix -> Bool
== :: RealMatrix -> RealMatrix -> Bool
$c/= :: RealMatrix -> RealMatrix -> Bool
/= :: RealMatrix -> RealMatrix -> Bool
Eq, Int -> RealMatrix -> ShowS
[RealMatrix] -> ShowS
RealMatrix -> String
(Int -> RealMatrix -> ShowS)
-> (RealMatrix -> String)
-> ([RealMatrix] -> ShowS)
-> Show RealMatrix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RealMatrix -> ShowS
showsPrec :: Int -> RealMatrix -> ShowS
$cshow :: RealMatrix -> String
show :: RealMatrix -> String
$cshowList :: [RealMatrix] -> ShowS
showList :: [RealMatrix] -> ShowS
Show)

-- |Construct a list-backed numeric matrix for small-dimensional APIs such as process
-- correlation and diffusion matrices. Returns a boxed 'Matrix' 'Double', /not/ a
-- 'RealMatrix' -- despite the shared @RealMatrix@ spelling this is not the pair of
-- 'realMatrixFromVector', which is the constructor for the contiguous 'RealMatrix' type.
-- Reach for this one when the dimensions are small and fixed (a correlation or diffusion
-- matrix), and for 'realMatrixFromVector' for large dense numerical grids such as
-- volatility surfaces and multi-asset LSM data.
boxedRealMatrix :: Word -> Word -> [Double] -> Either String (Matrix Double)
boxedRealMatrix :: Word -> Word -> [Double] -> Either String (Matrix Double)
boxedRealMatrix = Word -> Word -> [Double] -> Either String (Matrix Double)
forall a. Word -> Word -> [a] -> Either String (Matrix a)
objectMatrix

-- |Construct a row-major numeric matrix backed by contiguous storage. This is the
-- constructor for 'RealMatrix'; for a small correlation\/diffusion matrix use
-- 'boxedRealMatrix', which yields a boxed 'Matrix' 'Double' instead.
realMatrixFromVector :: Word -> Word -> RealVector -> Either String RealMatrix
realMatrixFromVector :: Word -> Word -> Vector Double -> Either String RealMatrix
realMatrixFromVector Word
rows Word
cols Vector Double
d
  | Word -> Word -> Int -> Bool
matrixDimensionsMatch Word
rows Word
cols (Vector Double -> Int
forall a. Storable a => Vector a -> Int
V.length Vector Double
d) = RealMatrix -> Either String RealMatrix
forall a b. b -> Either a b
Right (RealMatrix -> Either String RealMatrix)
-> RealMatrix -> Either String RealMatrix
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Vector Double -> RealMatrix
RealMatrix Word
rows Word
cols Vector Double
d
  | Bool
otherwise = String -> Either String RealMatrix
forall a b. a -> Either a b
Left (String -> Either String RealMatrix)
-> String -> Either String RealMatrix
forall a b. (a -> b) -> a -> b
$ String
"Data length " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Vector Double -> Int
forall a. Storable a => Vector a -> Int
V.length Vector Double
d)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not match dimensions " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
rows String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
cols

objectMatrix :: Word -> Word -> [a] -> Either String (Matrix a)
objectMatrix :: forall a. Word -> Word -> [a] -> Either String (Matrix a)
objectMatrix Word
rows Word
cols [a]
d
  | Word -> Word -> Int -> Bool
matrixDimensionsMatch Word
rows Word
cols ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
d) = Matrix a -> Either String (Matrix a)
forall a b. b -> Either a b
Right (Matrix a -> Either String (Matrix a))
-> Matrix a -> Either String (Matrix a)
forall a b. (a -> b) -> a -> b
$ Word -> Word -> [a] -> Matrix a
forall a. Word -> Word -> [a] -> Matrix a
Matrix Word
rows Word
cols [a]
d
  | Bool
otherwise = String -> Either String (Matrix a)
forall a b. a -> Either a b
Left (String -> Either String (Matrix a))
-> String -> Either String (Matrix a)
forall a b. (a -> b) -> a -> b
$ String
"Data length " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
d)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not match dimensions " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
rows String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
cols

-- |Checks a matrix shape without overflowing the public 'Word' dimensions.
matrixDimensionsMatch :: Word -> Word -> Int -> Bool
matrixDimensionsMatch :: Word -> Word -> Int -> Bool
matrixDimensionsMatch Word
rows Word
cols Int
dataLength =
  Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
rows Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
cols Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
dataLength

-- just a generic implementation to help when it's difficult to have Enum declaration due to complex module deps
fromEnumC :: (Enum a, Integral b) => a -> b
fromEnumC :: forall a b. (Enum a, Integral b) => a -> b
fromEnumC = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> (a -> Int) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum

-- output-direction counterpart to 'fromEnumC', for a {#fun#} returning a bare enum value
-- (not through a pointer out-param, see 'peekEnum' for that case) across the same module-dep boundary
toEnumC :: (Enum a, Integral b) => b -> a
toEnumC :: forall a b. (Enum a, Integral b) => b -> a
toEnumC = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (b -> Int) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

uncurryNested :: (a -> b -> c -> d) -> (a, (b, c)) -> d
uncurryNested :: forall a b c d. (a -> b -> c -> d) -> (a, (b, c)) -> d
uncurryNested a -> b -> c -> d
f (a
x, (b
y, c
z)) = a -> b -> c -> d
f a
x b
y c
z

-- |'Prelude' only goes up to 'zipWith3'; this fills the gap for unpacking a C-side
-- structure-of-parallel-arrays result into one Haskell record/tuple per element.
zipWith6 :: (a -> b -> c -> d -> e -> f -> g) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
zipWith6 :: forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
zipWith6 a -> b -> c -> d -> e -> f -> g
f (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
g:[f]
gs) = a -> b -> c -> d -> e -> f -> g
f a
a b
b c
c d
d e
e f
g g -> [g] -> [g]
forall a. a -> [a] -> [a]
: (a -> b -> c -> d -> e -> f -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
zipWith6 a -> b -> c -> d -> e -> f -> g
f [a]
as [b]
bs [c]
cs [d]
ds [e]
es [f]
gs
zipWith6 a -> b -> c -> d -> e -> f -> g
_ [a]
_ [b]
_ [c]
_ [d]
_ [e]
_ [f]
_ = []

-- vim: set ff=unix ts=8 sts=2 sw=2 et: