39 lines
1.4 KiB
Haskell
39 lines
1.4 KiB
Haskell
|
module Interop.Exports (
|
||
|
|
hsComputeStats,
|
||
|
|
hsFreeString,
|
||
|
|
hsMakeMessage,
|
||
|
|
) where
|
||
|
|
|
||
|
|
import Foreign.C.String (CString, newCString, peekCString)
|
||
|
|
import Foreign.C.Types (CInt (..))
|
||
|
|
import Foreign.Marshal.Alloc (free)
|
||
|
|
import Foreign.Ptr (Ptr, nullPtr)
|
||
|
|
import Foreign.Storable (poke)
|
||
|
|
import Interop.Shared (SharedStats, calculateSummary, formatHaskellMessage, summaryToSharedStats)
|
||
|
|
|
||
|
|
hsComputeStats :: CInt -> CInt -> Ptr SharedStats -> IO CInt
|
||
|
|
hsComputeStats left right outStats
|
||
|
|
| outStats == nullPtr = pure 1
|
||
|
|
| otherwise = do
|
||
|
|
poke outStats $
|
||
|
|
summaryToSharedStats $
|
||
|
|
calculateSummary (fromIntegral left) (fromIntegral right)
|
||
|
|
pure 0
|
||
|
|
|
||
|
|
hsMakeMessage :: CString -> CInt -> CInt -> IO CString
|
||
|
|
hsMakeMessage namePtr left right
|
||
|
|
| namePtr == nullPtr = newCString "Haskell received a null name pointer"
|
||
|
|
| otherwise = do
|
||
|
|
name <- peekCString namePtr
|
||
|
|
let summary = calculateSummary (fromIntegral left) (fromIntegral right)
|
||
|
|
newCString (formatHaskellMessage name summary)
|
||
|
|
|
||
|
|
hsFreeString :: CString -> IO ()
|
||
|
|
hsFreeString ptr
|
||
|
|
| ptr == nullPtr = pure ()
|
||
|
|
| otherwise = free ptr
|
||
|
|
|
||
|
|
foreign export ccall "hs_compute_stats" hsComputeStats :: CInt -> CInt -> Ptr SharedStats -> IO CInt
|
||
|
|
foreign export ccall "hs_make_message" hsMakeMessage :: CString -> CInt -> CInt -> IO CString
|
||
|
|
foreign export ccall "hs_free_string" hsFreeString :: CString -> IO ()
|