packages feed

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"