moonlight-triangulation-1.4.0.2: ffi/abi/Moonlight/Triangulation/Foreign/Contract/Render.hs
module Moonlight.Triangulation.Foreign.Contract.Render
( GeneratedFile (..)
, generatedFiles
, renderCHeader
, renderDefinitionFile
, renderHaskellExports
, renderPythonRaw
, renderRustRaw
, renderTypeScriptWire
, renderTypeScriptRaw
) where
import Data.Char (toLower, toUpper)
import Data.List (intercalate)
import Data.Maybe (mapMaybe)
import Data.Word (Word32)
import Moonlight.Triangulation.Foreign.Contract
data GeneratedFile = GeneratedFile
{ generatedFilePath :: !FilePath
, generatedFileContents :: !String
}
deriving stock (Eq, Show)
generatedFiles :: [GeneratedFile]
generatedFiles =
[ GeneratedFile "ffi/include/moonlight_triangulation.h" renderCHeader
, GeneratedFile "ffi/cbits/moonlight-triangulation.def" renderDefinitionFile
, GeneratedFile "ffi/exports/Moonlight/Triangulation/Foreign/Exports.hs" renderHaskellExports
, GeneratedFile "ffi/bindings/typescript/src/wire.generated.ts" renderTypeScriptWire
, GeneratedFile "ffi/bindings/typescript/src/internal/native.generated.ts" renderTypeScriptRaw
, GeneratedFile "ffi/bindings/python/src/moonlight_triangulation/_native_generated.py" renderPythonRaw
, GeneratedFile "ffi/bindings/rust/src/raw_generated.rs" renderRustRaw
]
generatedNotice :: String -> String
generatedNotice comment =
comment
<> " Generated from Moonlight.Triangulation.Foreign.Contract.\n"
<> comment
<> " Run moonlight-triangulation-ffi-contract write; do not edit this file.\n\n"
renderCHeader :: String
renderCHeader =
generatedNotice "//"
<> unlines
[ "#ifndef MOONLIGHT_TRIANGULATION_H"
, "#define MOONLIGHT_TRIANGULATION_H"
, ""
, "#include <stddef.h>"
, "#include <stdint.h>"
, ""
, "#if defined(_WIN32)"
, "#define ML_API __declspec(dllexport)"
, "#else"
, "#define ML_API __attribute__((visibility(\"default\")))"
, "#endif"
, ""
, "#ifdef __cplusplus"
, "extern \"C\" {"
, "#endif"
, ""
, "#define ML_ABI_VERSION " <> show abiVersion <> "u"
, ""
, concatMap renderCOpaqueHandle allAbiHandles
, "typedef uint32_t ml_status;"
, "typedef uint32_t ml_obstruction_code;"
, "typedef uint32_t ml_coordinate_error;"
, "typedef uint32_t ml_region_location;"
, "typedef uint32_t ml_minkowski_operation;"
, ""
]
<> renderCEnum (fmap (wireEntry abiStatusSymbol abiStatusId) allAbiStatuses)
<> renderCEnum (fmap (wireEntry obstructionCodeSymbol obstructionCodeId) allObstructionCodes)
<> renderCEnum (fmap (wireEntry coordinateErrorCodeSymbol coordinateErrorCodeId) allCoordinateErrorCodes)
<> renderCEnum (fmap (wireEntry regionLocationCodeSymbol regionLocationCodeId) allRegionLocationCodes)
<> renderCEnum (fmap (wireEntry minkowskiOperationCodeSymbol minkowskiOperationCodeId) allMinkowskiOperationCodes)
<> concatMap renderCStruct allAbiStructs
<> concatMap renderCFunction allAbiFunctions
<> unlines
[ ""
, "#ifdef __cplusplus"
, "}"
, "#endif"
, ""
, "#endif"
]
wireEntry :: (value -> String) -> (value -> Word32) -> value -> (String, Word32)
wireEntry symbol identifier value = (symbol value, identifier value)
renderCEnum :: [(String, Word32)] -> String
renderCEnum entries =
"enum {\n"
<> intercalate ",\n" (fmap (\(symbol, identifier) -> " " <> symbol <> " = " <> show identifier) entries)
<> "\n};\n\n"
renderCOpaqueHandle :: AbiHandle -> String
renderCOpaqueHandle handle =
"typedef struct " <> abiHandleSymbol handle <> " " <> abiHandleSymbol handle <> ";\n"
renderCStruct :: AbiStruct -> String
renderCStruct structure =
"typedef struct "
<> abiStructSymbol structure
<> " {\n"
<> concatMap renderField (abiStructFields structure)
<> "} "
<> abiStructSymbol structure
<> ";\n\n"
where
renderField (AbiField name fieldType) =
" " <> cFieldType fieldType <> " " <> name <> cFieldSuffix fieldType <> ";\n"
renderCFunction :: AbiFunction -> String
renderCFunction function =
"ML_API "
<> cResultType (abiFunctionResult function)
<> " "
<> abiFunctionSymbol function
<> "("
<> renderParameters
<> ");\n"
where
parameters = abiFunctionParameters function
renderParameters =
if null parameters
then "void"
else intercalate ", " (fmap renderParameter parameters)
renderParameter (AbiParameter name kind) = cParameterType kind <> " " <> name
cFieldType :: AbiFieldType -> String
cFieldType fieldType =
case fieldType of
AbiFieldUInt32 -> "uint32_t"
AbiFieldUInt64 -> "uint64_t"
AbiFieldDouble -> "double"
AbiFieldCharArray _ -> "char"
cFieldSuffix :: AbiFieldType -> String
cFieldSuffix fieldType =
case fieldType of
AbiFieldCharArray lengthInBytes -> "[" <> show lengthInBytes <> "]"
_ -> ""
cParameterType :: AbiParameterKind -> String
cParameterType kind =
case kind of
AbiValueSize -> "size_t"
AbiValueDouble -> "double"
AbiHandleInput handle -> "const " <> abiHandleSymbol handle <> " *"
AbiHandleRelease handle -> abiHandleSymbol handle <> " *"
AbiHandleOutput handle -> abiHandleSymbol handle <> " **"
AbiBufferInputDouble -> "const double *"
AbiBufferInputSize -> "const size_t *"
AbiBufferOutputChar -> "char *"
AbiBufferOutputDouble -> "double *"
AbiBufferOutputUInt32 -> "uint32_t *"
AbiBufferOutputSize -> "size_t *"
AbiScalarOutputRegionLocation -> "ml_region_location *"
AbiScalarOutputInt64 -> "int64_t *"
AbiScalarOutputSize -> "size_t *"
AbiScalarOutputDouble -> "double *"
AbiStructOutput structure -> abiStructSymbol structure <> " *"
cResultType :: AbiResult -> String
cResultType result =
case result of
AbiResultVoid -> "void"
AbiResultUInt32 -> "uint32_t"
AbiResultStatus -> "ml_status"
renderDefinitionFile :: String
renderDefinitionFile =
generatedNotice ";"
<> "LIBRARY moonlight-triangulation-c\nEXPORTS\n"
<> concatMap (\function -> " " <> abiFunctionSymbol function <> "\n") allAbiFunctions
renderHaskellExports :: String
renderHaskellExports =
generatedNotice "--"
<> unlines
[ "{-# LANGUAGE ForeignFunctionInterface #-}"
, "{-# OPTIONS_GHC -Wno-missing-signatures #-}"
, ""
, "module Moonlight.Triangulation.Foreign.Exports where"
, ""
, "import Data.Int (Int64)"
, "import Data.Word (Word32)"
, "import Foreign.C.Types (CChar, CDouble (..), CSize (..), CUInt (..))"
, "import Foreign.Ptr (Ptr)"
, "import Moonlight.Triangulation.Foreign.Contract"
, " ( CMesh"
, " , CMinkowskiReceipt"
, " , CObstruction"
, " , CRegion"
, " , CStructuringElement"
, " )"
, "import qualified Moonlight.Triangulation.Foreign.Mesh as Mesh"
, "import qualified Moonlight.Triangulation.Foreign.Morphology as Morphology"
, "import qualified Moonlight.Triangulation.Foreign.Region as Region"
, ""
]
<> concatMap renderHaskellAlias implementedFunctions
<> "\n"
<> concatMap renderHaskellExport implementedFunctions
where
implementedFunctions :: [(AbiFunction, String, AbiFunctionFamily)]
implementedFunctions = mapMaybe implemented allAbiFunctions
implemented :: AbiFunction -> Maybe (AbiFunction, String, AbiFunctionFamily)
implemented function =
case abiFunctionImplementation function of
AbiFunctionRuntime -> Nothing
AbiFunctionHaskell family haskellName -> Just (function, haskellName, family)
renderHaskellAlias :: (AbiFunction, String, AbiFunctionFamily) -> String
renderHaskellAlias (_, haskellName, family) =
haskellName <> " = " <> familyQualifier family <> "." <> haskellName <> "\n"
renderHaskellExport :: (AbiFunction, String, AbiFunctionFamily) -> String
renderHaskellExport (function, haskellName, _) =
"foreign export ccall \""
<> abiFunctionSymbol function
<> "\" "
<> haskellName
<> " :: "
<> haskellFunctionType function
<> "\n"
familyQualifier :: AbiFunctionFamily -> String
familyQualifier family =
case family of
AbiFunctionMesh -> "Mesh"
AbiFunctionRegion -> "Region"
AbiFunctionMorphology -> "Morphology"
renderTypeScriptWire :: String
renderTypeScriptWire =
generatedNotice "//"
<> intercalate
"\n"
[ renderTypeScriptVocabulary "AbiStatus" "ML_STATUS_" abiStatusSymbol abiStatusId allAbiStatuses
, renderTypeScriptVocabulary "ObstructionCode" "ML_OBSTRUCTION_" obstructionCodeSymbol obstructionCodeId allObstructionCodes
, renderTypeScriptVocabulary "CoordinateError" "ML_COORDINATE_ERROR_" coordinateErrorCodeSymbol coordinateErrorCodeId allCoordinateErrorCodes
, renderTypeScriptVocabulary "RegionLocation" "ML_REGION_" regionLocationCodeSymbol regionLocationCodeId allRegionLocationCodes
, renderTypeScriptVocabulary "MinkowskiOperation" "ML_MINKOWSKI_" minkowskiOperationCodeSymbol minkowskiOperationCodeId allMinkowskiOperationCodes
]
renderTypeScriptVocabulary
:: String
-> String
-> (value -> String)
-> (value -> Word32)
-> [value]
-> String
renderTypeScriptVocabulary typeName prefix symbol identifier values =
"export const "
<> typeName
<> " = {\n"
<> concatMap renderValue values
<> "} as const;\n"
<> "export type "
<> typeName
<> " = (typeof "
<> typeName
<> ")[keyof typeof "
<> typeName
<> "];\n"
<> "const "
<> lowerInitial typeName
<> "ByWire: Readonly<Record<number, "
<> typeName
<> ">> = {\n"
<> concatMap renderWireEntry values
<> "};\n"
<> "export function decode"
<> typeName
<> "(value: number): "
<> typeName
<> " | undefined {\n"
<> " return "
<> lowerInitial typeName
<> "ByWire[value];\n"
<> "}\n"
where
renderValue value =
" " <> wireKey prefix (symbol value) <> ": \"" <> wireValue prefix (symbol value) <> "\",\n"
renderWireEntry value =
" " <> show (identifier value) <> ": " <> typeName <> "." <> wireKey prefix (symbol value) <> ",\n"
wireKey :: String -> String -> String
wireKey prefix = concatMap capitalize . underscoreWords . drop (length prefix)
wireValue :: String -> String -> String
wireValue prefix = intercalate "-" . fmap (fmap toLower) . underscoreWords . drop (length prefix)
underscoreWords :: String -> [String]
underscoreWords value =
case break (== '_') value of
(word, []) -> [word]
(word, _ : rest) -> word : underscoreWords rest
capitalize :: String -> String
capitalize value =
case value of
[] -> []
firstCharacter : rest -> toUpper firstCharacter : fmap toLower rest
lowerInitial :: String -> String
lowerInitial value =
case value of
[] -> []
firstCharacter : rest -> toLower firstCharacter : rest
haskellFunctionType :: AbiFunction -> String
haskellFunctionType function =
intercalate " -> " (fmap (haskellParameterType . abiParameterKind) (abiFunctionParameters function) <> [haskellResultType (abiFunctionResult function)])
haskellParameterType :: AbiParameterKind -> String
haskellParameterType kind =
case kind of
AbiValueSize -> "CSize"
AbiValueDouble -> "CDouble"
AbiHandleInput handle -> "Ptr " <> haskellHandleName handle
AbiHandleRelease handle -> "Ptr " <> haskellHandleName handle
AbiHandleOutput handle -> "Ptr (Ptr " <> haskellHandleName handle <> ")"
AbiBufferInputDouble -> "Ptr CDouble"
AbiBufferInputSize -> "Ptr CSize"
AbiBufferOutputChar -> "Ptr CChar"
AbiBufferOutputDouble -> "Ptr CDouble"
AbiBufferOutputUInt32 -> "Ptr Word32"
AbiBufferOutputSize -> "Ptr CSize"
AbiScalarOutputRegionLocation -> "Ptr CUInt"
AbiScalarOutputInt64 -> "Ptr Int64"
AbiScalarOutputSize -> "Ptr CSize"
AbiScalarOutputDouble -> "Ptr CDouble"
AbiStructOutput structure -> "Ptr " <> haskellStructName structure
haskellResultType :: AbiResult -> String
haskellResultType result =
case result of
AbiResultVoid -> "IO ()"
AbiResultUInt32 -> "IO CUInt"
AbiResultStatus -> "IO CUInt"
haskellHandleName :: AbiHandle -> String
haskellHandleName handle =
case handle of
AbiMesh -> "CMesh"
AbiRegion -> "CRegion"
AbiStructuringElement -> "CStructuringElement"
haskellStructName :: AbiStruct -> String
haskellStructName structure =
case structure of
AbiStructObstruction -> "CObstruction"
AbiStructMinkowskiReceipt -> "CMinkowskiReceipt"
renderTypeScriptRaw :: String
renderTypeScriptRaw =
generatedNotice "//"
<> "import koffi from \"koffi\";\n\n"
<> "export const ABI_VERSION = " <> show abiVersion <> ";\n"
<> renderTypeScriptConstants abiStatusSymbol abiStatusId allAbiStatuses
<> renderTypeScriptConstants obstructionCodeSymbol obstructionCodeId allObstructionCodes
<> renderTypeScriptConstants coordinateErrorCodeSymbol coordinateErrorCodeId allCoordinateErrorCodes
<> renderTypeScriptConstants regionLocationCodeSymbol regionLocationCodeId allRegionLocationCodes
<> renderTypeScriptConstants minkowskiOperationCodeSymbol minkowskiOperationCodeId allMinkowskiOperationCodes
<> "\nexport type NativeHandle = object;\n"
<> "export type NativeInteger = number | bigint;\n"
<> "export type HandleOutput = Array<NativeHandle | null>;\n\n"
<> renderTypeScriptStruct "NativeObstruction" AbiStructObstruction
<> renderTypeScriptStruct "NativeMinkowskiReceipt" AbiStructMinkowskiReceipt
<> "export interface NativeApi {\n"
<> concatMap renderTypeScriptFunctionType allAbiFunctions
<> "}\n\n"
<> unlines
[ "export function loadNativeApi(libraryPath: string): NativeApi {"
, " const library = koffi.load(libraryPath);"
, concatMap renderTypeScriptKoffiHandleDeclarations allAbiHandles
, renderTypeScriptKoffiStruct "obstruction" AbiStructObstruction
, renderTypeScriptKoffiStruct "receipt" AbiStructMinkowskiReceipt
, " const obstructionOutput = koffi.out(koffi.pointer(obstruction));"
, " const receiptOutput = koffi.out(koffi.pointer(receipt));"
, " const sizeOutput = koffi.out(koffi.pointer(\"size_t\"));"
, " const uint32Output = koffi.out(koffi.pointer(\"uint32_t\"));"
, " const int64Output = koffi.out(koffi.pointer(\"int64_t\"));"
, " const doubleOutput = koffi.out(koffi.pointer(\"double\"));"
, " const sizeArray = koffi.pointer(\"size_t\");"
, " return {"
]
<> concatMap renderTypeScriptFunctionBinding allAbiFunctions
<> " };\n}\n"
renderTypeScriptConstants :: (value -> String) -> (value -> Word32) -> [value] -> String
renderTypeScriptConstants symbol identifier =
concatMap (\value -> "export const " <> symbol value <> " = " <> show (identifier value) <> ";\n")
renderTypeScriptStruct :: String -> AbiStruct -> String
renderTypeScriptStruct name structure =
"export interface "
<> name
<> " {\n"
<> concatMap renderField (abiStructFields structure)
<> "}\n\n"
where
renderField (AbiField fieldName fieldType) =
" " <> fieldName <> "?: " <> typeScriptFieldType fieldType <> ";\n"
typeScriptFieldType :: AbiFieldType -> String
typeScriptFieldType fieldType =
case fieldType of
AbiFieldUInt32 -> "number"
AbiFieldUInt64 -> "NativeInteger"
AbiFieldDouble -> "number"
AbiFieldCharArray _ -> "string | readonly number[]"
renderTypeScriptFunctionType :: AbiFunction -> String
renderTypeScriptFunctionType function =
" readonly "
<> abiFunctionSymbol function
<> ": ("
<> intercalate ", " (fmap renderParameter (abiFunctionParameters function))
<> ") => "
<> typeScriptResultType (abiFunctionResult function)
<> ";\n"
where
renderParameter (AbiParameter name kind) = name <> ": " <> typeScriptParameterType kind
typeScriptParameterType :: AbiParameterKind -> String
typeScriptParameterType kind =
case kind of
AbiValueSize -> "number"
AbiValueDouble -> "number"
AbiHandleInput _ -> "NativeHandle"
AbiHandleRelease _ -> "NativeHandle"
AbiHandleOutput _ -> "HandleOutput"
AbiBufferInputDouble -> "Float64Array"
AbiBufferInputSize -> "BigUint64Array"
AbiBufferOutputChar -> "Buffer"
AbiBufferOutputDouble -> "Float64Array"
AbiBufferOutputUInt32 -> "Uint32Array"
AbiBufferOutputSize -> "BigUint64Array"
AbiScalarOutputRegionLocation -> "number[]"
AbiScalarOutputInt64 -> "NativeInteger[]"
AbiScalarOutputSize -> "NativeInteger[]"
AbiScalarOutputDouble -> "number[]"
AbiStructOutput AbiStructObstruction -> "NativeObstruction"
AbiStructOutput AbiStructMinkowskiReceipt -> "NativeMinkowskiReceipt"
typeScriptResultType :: AbiResult -> String
typeScriptResultType result =
case result of
AbiResultVoid -> "void"
AbiResultUInt32 -> "number"
AbiResultStatus -> "number"
renderTypeScriptKoffiStruct :: String -> AbiStruct -> String
renderTypeScriptKoffiStruct variableName structure =
" const "
<> variableName
<> " = koffi.struct({\n"
<> concatMap renderField (abiStructFields structure)
<> " });"
where
renderField (AbiField name fieldType) =
" " <> name <> ": " <> typeScriptKoffiFieldType fieldType <> ",\n"
typeScriptKoffiFieldType :: AbiFieldType -> String
typeScriptKoffiFieldType fieldType =
case fieldType of
AbiFieldUInt32 -> "\"uint32_t\""
AbiFieldUInt64 -> "\"uint64_t\""
AbiFieldDouble -> "\"double\""
AbiFieldCharArray lengthInBytes -> "koffi.array(\"char\", " <> show lengthInBytes <> ")"
renderTypeScriptFunctionBinding :: AbiFunction -> String
renderTypeScriptFunctionBinding function =
" "
<> abiFunctionSymbol function
<> ": library.func(\""
<> abiFunctionSymbol function
<> "\", \""
<> typeScriptKoffiResultType (abiFunctionResult function)
<> "\", ["
<> intercalate ", " (fmap (typeScriptKoffiParameterType . abiParameterKind) (abiFunctionParameters function))
<> "]),\n"
typeScriptKoffiResultType :: AbiResult -> String
typeScriptKoffiResultType result =
case result of
AbiResultVoid -> "void"
AbiResultUInt32 -> "uint32_t"
AbiResultStatus -> "uint32_t"
typeScriptKoffiParameterType :: AbiParameterKind -> String
typeScriptKoffiParameterType kind =
case kind of
AbiValueSize -> "\"size_t\""
AbiValueDouble -> "\"double\""
AbiHandleInput handle -> typeScriptHandleVariable handle <> "Pointer"
AbiHandleRelease handle -> typeScriptHandleVariable handle <> "Pointer"
AbiHandleOutput handle -> typeScriptHandleVariable handle <> "Output"
AbiBufferInputDouble -> "koffi.pointer(\"double\")"
AbiBufferInputSize -> "sizeArray"
AbiBufferOutputChar -> "koffi.out(koffi.pointer(\"char\"))"
AbiBufferOutputDouble -> "koffi.out(koffi.pointer(\"double\"))"
AbiBufferOutputUInt32 -> "koffi.out(koffi.pointer(\"uint32_t\"))"
AbiBufferOutputSize -> "koffi.out(sizeArray)"
AbiScalarOutputRegionLocation -> "uint32Output"
AbiScalarOutputInt64 -> "int64Output"
AbiScalarOutputSize -> "sizeOutput"
AbiScalarOutputDouble -> "doubleOutput"
AbiStructOutput AbiStructObstruction -> "obstructionOutput"
AbiStructOutput AbiStructMinkowskiReceipt -> "receiptOutput"
typeScriptHandleVariable :: AbiHandle -> String
typeScriptHandleVariable handle =
case handle of
AbiMesh -> "mesh"
AbiRegion -> "region"
AbiStructuringElement -> "structuringElement"
renderTypeScriptKoffiHandleDeclarations :: AbiHandle -> String
renderTypeScriptKoffiHandleDeclarations handle =
let variableName = typeScriptHandleVariable handle
in unlines
[ " const " <> variableName <> " = koffi.opaque();"
, " const " <> variableName <> "Pointer = koffi.pointer(" <> variableName <> ");"
, " const " <> variableName <> "Output = koffi.out(koffi.pointer(" <> variableName <> ", 2));"
]
renderPythonRaw :: String
renderPythonRaw =
generatedNotice "#"
<> unlines
[ "from __future__ import annotations"
, ""
, "import ctypes"
, "from collections.abc import Sequence"
, "from pathlib import Path"
, "from typing import Final"
, ""
, "ABI_VERSION: Final = " <> show abiVersion
]
<> renderPythonConstants abiStatusSymbol abiStatusId allAbiStatuses
<> renderPythonConstants obstructionCodeSymbol obstructionCodeId allObstructionCodes
<> renderPythonConstants coordinateErrorCodeSymbol coordinateErrorCodeId allCoordinateErrorCodes
<> renderPythonConstants regionLocationCodeSymbol regionLocationCodeId allRegionLocationCodes
<> renderPythonConstants minkowskiOperationCodeSymbol minkowskiOperationCodeId allMinkowskiOperationCodes
<> "\n"
<> renderPythonStruct "_Obstruction" AbiStructObstruction
<> renderPythonStruct "_NativeMinkowskiReceipt" AbiStructMinkowskiReceipt
<> unlines
[ "class _NativeApi:"
, " def __init__(self, library_path: Path) -> None:"
, " library = ctypes.CDLL(str(library_path))"
]
<> concatMap renderPythonConfiguration allAbiFunctions
<> unlines
[ " self.library = library"
, ""
, ""
, "def _configure("
, " library: ctypes.CDLL,"
, " name: str,"
, " parameters: Sequence[object],"
, " result: object = ctypes.c_uint32,"
, ") -> None:"
, " function = getattr(library, name)"
, " setattr(function, \"argtypes\", list(parameters))"
, " setattr(function, \"restype\", result)"
]
renderPythonConstants :: (value -> String) -> (value -> Word32) -> [value] -> String
renderPythonConstants symbol identifier =
concatMap (\value -> symbol value <> ": Final = " <> show (identifier value) <> "\n")
renderPythonStruct :: String -> AbiStruct -> String
renderPythonStruct name structure =
"class "
<> name
<> "(ctypes.Structure):\n"
<> " _fields_ = [\n"
<> concatMap renderField (abiStructFields structure)
<> " ]\n\n\n"
where
renderField (AbiField fieldName fieldType) =
" (\"" <> fieldName <> "\", " <> pythonFieldType fieldType <> "),\n"
pythonFieldType :: AbiFieldType -> String
pythonFieldType fieldType =
case fieldType of
AbiFieldUInt32 -> "ctypes.c_uint32"
AbiFieldUInt64 -> "ctypes.c_uint64"
AbiFieldDouble -> "ctypes.c_double"
AbiFieldCharArray lengthInBytes -> "ctypes.c_char * " <> show lengthInBytes
renderPythonConfiguration :: AbiFunction -> String
renderPythonConfiguration function =
" _configure(library, \""
<> abiFunctionSymbol function
<> "\", "
<> pythonTuple (fmap (pythonParameterType . abiParameterKind) (abiFunctionParameters function))
<> ", "
<> pythonResultType (abiFunctionResult function)
<> ")\n"
pythonTuple :: [String] -> String
pythonTuple values =
case values of
[] -> "()"
[value] -> "(" <> value <> ",)"
_ -> "(" <> intercalate ", " values <> ")"
pythonParameterType :: AbiParameterKind -> String
pythonParameterType kind =
case kind of
AbiValueSize -> "ctypes.c_size_t"
AbiValueDouble -> "ctypes.c_double"
AbiHandleInput _ -> "ctypes.c_void_p"
AbiHandleRelease _ -> "ctypes.c_void_p"
AbiHandleOutput _ -> "ctypes.POINTER(ctypes.c_void_p)"
AbiBufferInputDouble -> "ctypes.POINTER(ctypes.c_double)"
AbiBufferInputSize -> "ctypes.POINTER(ctypes.c_size_t)"
AbiBufferOutputChar -> "ctypes.POINTER(ctypes.c_char)"
AbiBufferOutputDouble -> "ctypes.POINTER(ctypes.c_double)"
AbiBufferOutputUInt32 -> "ctypes.POINTER(ctypes.c_uint32)"
AbiBufferOutputSize -> "ctypes.POINTER(ctypes.c_size_t)"
AbiScalarOutputRegionLocation -> "ctypes.POINTER(ctypes.c_uint32)"
AbiScalarOutputInt64 -> "ctypes.POINTER(ctypes.c_int64)"
AbiScalarOutputSize -> "ctypes.POINTER(ctypes.c_size_t)"
AbiScalarOutputDouble -> "ctypes.POINTER(ctypes.c_double)"
AbiStructOutput AbiStructObstruction -> "ctypes.POINTER(_Obstruction)"
AbiStructOutput AbiStructMinkowskiReceipt -> "ctypes.POINTER(_NativeMinkowskiReceipt)"
pythonResultType :: AbiResult -> String
pythonResultType result =
case result of
AbiResultVoid -> "None"
AbiResultUInt32 -> "ctypes.c_uint32"
AbiResultStatus -> "ctypes.c_uint32"
renderRustRaw :: String
renderRustRaw =
generatedNotice "//"
<> "// This private module is the complete wire projection; wrappers consume a subset.\n"
<> "#![allow(dead_code)]\n\n"
<> "use std::ffi::{c_char, c_double, c_uint};\n\n"
<> "pub(crate) const ABI_VERSION: u32 = " <> show abiVersion <> ";\n"
<> renderRustConstants abiStatusSymbol abiStatusId allAbiStatuses
<> renderRustConstants obstructionCodeSymbol obstructionCodeId allObstructionCodes
<> renderRustConstants coordinateErrorCodeSymbol coordinateErrorCodeId allCoordinateErrorCodes
<> renderRustConstants regionLocationCodeSymbol regionLocationCodeId allRegionLocationCodes
<> renderRustConstants minkowskiOperationCodeSymbol minkowskiOperationCodeId allMinkowskiOperationCodes
<> "\n"
<> concatMap renderRustHandle allAbiHandles
<> renderRustStruct "NativeObstruction" AbiStructObstruction
<> renderRustStruct "NativeMinkowskiReceipt" AbiStructMinkowskiReceipt
<> "#[link(name = \"moonlight-triangulation-c\")]\nunsafe extern \"C\" {\n"
<> concatMap renderRustFunction allAbiFunctions
<> "}\n"
renderRustConstants :: (value -> String) -> (value -> Word32) -> [value] -> String
renderRustConstants symbol identifier =
concatMap (\value -> "pub(crate) const " <> symbol value <> ": u32 = " <> show (identifier value) <> ";\n")
renderRustHandle :: AbiHandle -> String
renderRustHandle handle =
"#[repr(C)]\npub(crate) struct "
<> rustHandleName handle
<> " {\n _private: [u8; 0],\n}\n\n"
renderRustStruct :: String -> AbiStruct -> String
renderRustStruct name structure =
"#[repr(C)]\npub(crate) struct "
<> name
<> " {\n"
<> concatMap renderField (abiStructFields structure)
<> "}\n\n"
<> "impl Default for "
<> name
<> " {\n"
<> " fn default() -> Self {\n"
<> " Self {\n"
<> concatMap renderDefaultField (abiStructFields structure)
<> " }\n"
<> " }\n"
<> "}\n\n"
where
renderField (AbiField fieldName fieldType) =
" pub(crate) " <> fieldName <> ": " <> rustFieldType fieldType <> ",\n"
renderDefaultField (AbiField fieldName fieldType) =
" " <> fieldName <> ": " <> rustFieldDefault fieldType <> ",\n"
rustFieldType :: AbiFieldType -> String
rustFieldType fieldType =
case fieldType of
AbiFieldUInt32 -> "u32"
AbiFieldUInt64 -> "u64"
AbiFieldDouble -> "f64"
AbiFieldCharArray lengthInBytes -> "[c_char; " <> show lengthInBytes <> "]"
rustFieldDefault :: AbiFieldType -> String
rustFieldDefault fieldType =
case fieldType of
AbiFieldUInt32 -> "0"
AbiFieldUInt64 -> "0"
AbiFieldDouble -> "0.0"
AbiFieldCharArray lengthInBytes -> "[0; " <> show lengthInBytes <> "]"
renderRustFunction :: AbiFunction -> String
renderRustFunction function =
case abiFunctionParameters function of
[] -> declarationPrefix <> "()" <> resultSuffix <> ";\n"
[parameter] -> declarationPrefix <> "(" <> renderParameter parameter <> ")" <> resultSuffix <> ";\n"
parameters ->
declarationPrefix
<> "(\n"
<> concatMap (\parameter -> " " <> renderParameter parameter <> ",\n") parameters
<> " )"
<> resultSuffix
<> ";\n"
where
declarationPrefix = " pub(crate) fn " <> abiFunctionSymbol function
resultSuffix = rustResultSuffix (abiFunctionResult function)
renderParameter (AbiParameter name kind) = name <> ": " <> rustParameterType kind
rustParameterType :: AbiParameterKind -> String
rustParameterType kind =
case kind of
AbiValueSize -> "usize"
AbiValueDouble -> "c_double"
AbiHandleInput handle -> "*const " <> rustHandleName handle
AbiHandleRelease handle -> "*mut " <> rustHandleName handle
AbiHandleOutput handle -> "*mut *mut " <> rustHandleName handle
AbiBufferInputDouble -> "*const c_double"
AbiBufferInputSize -> "*const usize"
AbiBufferOutputChar -> "*mut c_char"
AbiBufferOutputDouble -> "*mut c_double"
AbiBufferOutputUInt32 -> "*mut u32"
AbiBufferOutputSize -> "*mut usize"
AbiScalarOutputRegionLocation -> "*mut u32"
AbiScalarOutputInt64 -> "*mut i64"
AbiScalarOutputSize -> "*mut usize"
AbiScalarOutputDouble -> "*mut c_double"
AbiStructOutput AbiStructObstruction -> "*mut NativeObstruction"
AbiStructOutput AbiStructMinkowskiReceipt -> "*mut NativeMinkowskiReceipt"
rustResultSuffix :: AbiResult -> String
rustResultSuffix result =
case result of
AbiResultVoid -> ""
AbiResultUInt32 -> " -> c_uint"
AbiResultStatus -> " -> c_uint"
rustHandleName :: AbiHandle -> String
rustHandleName handle =
case handle of
AbiMesh -> "NativeMesh"
AbiRegion -> "NativeRegion"
AbiStructuringElement -> "NativeStructuringElement"